Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch novem Through [6ca5f2d8bf] Excluding Merge-Ins
This is equivalent to a diff from 01243c07ff to 6ca5f2d8bf
|
2016-11-12
| ||
| 11:20 | Merge tzdata2016i from IETF check-in: 3a3a592ef9 user: venkat tags: novem | |
| 11:19 | Merge tzdata2016i from IETF check-in: cbce1a9dea user: venkat tags: trunk | |
|
2016-11-11
| ||
| 15:18 | merge trunk check-in: 6ca5f2d8bf user: jan.nijtmans tags: novem | |
| 14:53 | Fix harmless gcc warning message: using "unsigned" doesn't serve any purpose, actually. check-in: 01243c07ff user: jan.nijtmans tags: trunk | |
| 10:58 | Fix [79614fb8b61983ac8ef30ea8752c310465798fc7|79614fb8b6]: "glob", "encoding system" and encoding-fr... check-in: 1867fdf95b user: jan.nijtmans tags: trunk | |
|
2016-11-10
| ||
| 15:13 | merge trunk check-in: 8d4c5a08c5 user: jan.nijtmans tags: novem | |
Changes to .project.
1 2 | <?xml version="1.0" encoding="UTF-8"?> <projectDescription> | | | 1 2 3 4 5 6 7 8 9 10 | <?xml version="1.0" encoding="UTF-8"?> <projectDescription> <name>tcl9.0</name> <comment></comment> <projects> </projects> <buildSpec> </buildSpec> <natures> </natures> |
| ︙ | ︙ |
Changes to ChangeLog.
| ︙ | ︙ | |||
472 473 474 475 476 477 478 | * library/http/http.tcl (http::geturl): [Bug 2911139]: Do not do vwait for connect to avoid reentrancy problems (except when operating without a -command option). Internally, this means that all sockets created by the http package will always be operated in asynchronous mode. | < < < < < < < | 472 473 474 475 476 477 478 479 480 481 482 483 484 485 | * library/http/http.tcl (http::geturl): [Bug 2911139]: Do not do vwait for connect to avoid reentrancy problems (except when operating without a -command option). Internally, this means that all sockets created by the http package will always be operated in asynchronous mode. 2013-01-18 Jan Nijtmans <nijtmans@users.sf.net> * generic/tclPort.h: [Bug 3598300]: unix: tcl.h does not include sys/stat.h 2013-01-17 Donal K. Fellows <dkf@users.sf.net> |
| ︙ | ︙ | |||
521 522 523 524 525 526 527 | still run in Tcl 8.6. 2013-01-13 Alexandre Ferrieux <ferrieux@users.sourceforge.net> * doc/fileevent.n: [Bug 3436609]: Clarify readable fileevent "false positives" in the case of multibyte encodings/transforms. | < < < < < < < < < < < < | 514 515 516 517 518 519 520 521 522 523 524 525 526 527 | still run in Tcl 8.6. 2013-01-13 Alexandre Ferrieux <ferrieux@users.sourceforge.net> * doc/fileevent.n: [Bug 3436609]: Clarify readable fileevent "false positives" in the case of multibyte encodings/transforms. 2013-01-09 Jan Nijtmans <nijtmans@users.sf.net> * library/http/http.tcl: [Bug 3599395]: http assumes status line is a proper Tcl list. 2013-01-08 Jan Nijtmans <nijtmans@users.sf.net> |
| ︙ | ︙ | |||
555 556 557 558 559 560 561 | Tcl_AppendResult, not any other function. This puts least restrictions on eventual Tcl 9 stubs re-organization, and it works on the widest range of Tcl versions. 2013-01-06 Jan Nijtmans <nijtmans@users.sf.net> * library/http/http.tcl: Don't depend on Spencer-specific regexp | | > | 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 | Tcl_AppendResult, not any other function. This puts least restrictions on eventual Tcl 9 stubs re-organization, and it works on the widest range of Tcl versions. 2013-01-06 Jan Nijtmans <nijtmans@users.sf.net> * library/http/http.tcl: Don't depend on Spencer-specific regexp * tests/env.test: syntax (/u and /U) any more. * tests/exec.test: * tests/reg.test: Bump http package to 2.8.6. 2013-01-04 Donal K. Fellows <dkf@users.sf.net> * generic/tclEnsemble.c (CompileBasicNArgCommand): Added very simple compiler (which just compiles to a normal invoke of the implementation command) for many ensemble subcommands where we can prove that there |
| ︙ | ︙ | |||
681 682 683 684 685 686 687 | * generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT when there are unflushed nonblocking channels. Thanks Miguel for spotting. 2012-12-07 Jan Nijtmans <nijtmans@users.sf.net> | | | | 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 |
* generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT
when there are unflushed nonblocking channels. Thanks Miguel for
spotting.
2012-12-07 Jan Nijtmans <nijtmans@users.sf.net>
* unix/dltest/pkgb.c: Turn pkgb.so into a Tcl8 interoperability test
library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 8 should
either result in an error-message, either succeed, but never crash.
2012-11-28 Donal K. Fellows <dkf@users.sf.net>
* generic/tclZlib.c (ZlibStreamSubcmd): [Bug 3590483]: Use a mechanism
for complex option resolution that has fewer problems with more
finicky compilers.
|
| ︙ | ︙ | |||
8839 8840 8841 8842 8843 8844 8845 | * unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 878333]: Force the use of the compatibility version of mkstemp() on IRIX. * unix/configure.in, unix/Makefile.in (mkstemp.o): * compat/mkstemp.c (new file): [Bug 741967]: Added a compatibility implementation of the mkstemp() function, which is apparently needed on some platforms. | | | | | | | | | | | | > | 8821 8822 8823 8824 8825 8826 8827 8828 8829 8830 8831 8832 8833 8834 8835 8836 8837 8838 8839 |
* unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 878333]: Force the use of the
compatibility version of mkstemp() on IRIX.
* unix/configure.in, unix/Makefile.in (mkstemp.o):
* compat/mkstemp.c (new file): [Bug 741967]: Added a compatibility
implementation of the mkstemp() function, which is apparently needed
on some platforms.
******************************************************************
*** CHANGELOG ENTRIES FOR 2008 IN "ChangeLog.2008" ***
*** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007" ***
*** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005" ***
*** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" ***
*** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" ***
*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" ***
*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" ***
*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" ***
*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
******************************************************************
|
Changes to README.
1 | README: Tcl | | | 1 2 3 4 5 6 7 8 9 |
README: Tcl
This is the Tcl 9.0a0 source distribution.
http://sourceforge.net/projects/tcl/files/Tcl/
You can get any source release of Tcl from the URL above.
Contents
--------
1. Introduction
2. Documentation
|
| ︙ | ︙ | |||
45 46 47 48 49 50 51 | "license.terms" for complete information. 2. Documentation ---------------- Extensive documentation is available at our website. The home page for this release, including new features, is | | | | | 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 | "license.terms" for complete information. 2. Documentation ---------------- Extensive documentation is available at our website. The home page for this release, including new features, is http://www.tcl.tk/software/tcltk/9.0.html Detailed release notes can be found at the file distributions page by clicking on the relevant version. http://sourceforge.net/projects/tcl/files/Tcl/ Information about Tcl itself can be found at http://www.tcl.tk/about/ There have been many Tcl books on the market. Many are mentioned in the Wiki: http://wiki.tcl.tk/_/ref?N=25206 To view the complete set of reference manual entries for Tcl 9.0 online, visit the URL: http://www.tcl.tk/man/tcl9.0/ 2a. 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 |
| ︙ | ︙ |
Deleted compat/float.h.
|
| < < < < < < < < < < < < < < |
Changes to doc/AddErrInfo.3.
1 2 3 4 5 6 7 8 9 10 11 | '\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-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_AddErrorInfo 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 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | '\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-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_AddErrorInfo 3 8.5 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp Tcl_Obj * \fBTcl_GetReturnOptions\fR(\fIinterp, code\fR) .sp int \fBTcl_SetReturnOptions\fR(\fIinterp, options\fR) .sp \fBTcl_AddErrorInfo\fR(\fIinterp, message\fR) .sp \fBTcl_AppendObjToErrorInfo\fR(\fIinterp, objPtr\fR) .sp \fBTcl_SetObjErrorCode\fR(\fIinterp, errorObjPtr\fR) .sp \fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *) NULL\fR) .sp \fBTcl_SetErrorCodeVA\fR(\fIinterp, argList\fR) .sp \fBTcl_GetErrorLine\fR(\fIinterp\fR) |
| ︙ | ︙ | |||
48 49 50 51 52 53 54 | .AP int code The code returned from script evaluation. .AP Tcl_Obj *options A dictionary of return options. .AP char *message in For \fBTcl_AddErrorInfo\fR, this is a conventional C string to append to the \fB\-errorinfo\fR return option. | < < < < < | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | .AP int code The code returned from script evaluation. .AP Tcl_Obj *options A dictionary of return options. .AP char *message in For \fBTcl_AddErrorInfo\fR, this is a conventional C string to append to the \fB\-errorinfo\fR return option. .AP Tcl_Obj *objPtr in A message to be appended to the \fB\-errorinfo\fR return option in the form of a Tcl_Obj value. .AP int length in The number of bytes to copy from \fImessage\fR when appending to the \fB\-errorinfo\fR return option. If negative, all bytes up to the first null byte are used. |
| ︙ | ︙ | |||
218 219 220 221 222 223 224 | a useful part of the \fImessage\fR passed to \fBTcl_AddErrorInfo\fR. .PP \fBTcl_AppendObjToErrorInfo\fR is an alternative interface to the same functionality as \fBTcl_AddErrorInfo\fR. \fBTcl_AppendObjToErrorInfo\fR is called when the string value to be appended to the \fB\-errorinfo\fR option is available as a \fBTcl_Obj\fR instead of as a \fBchar\fR array. .PP | < < < < < < < < < | 211 212 213 214 215 216 217 218 219 220 221 222 223 224 | a useful part of the \fImessage\fR passed to \fBTcl_AddErrorInfo\fR. .PP \fBTcl_AppendObjToErrorInfo\fR is an alternative interface to the same functionality as \fBTcl_AddErrorInfo\fR. \fBTcl_AppendObjToErrorInfo\fR is called when the string value to be appended to the \fB\-errorinfo\fR option is available as a \fBTcl_Obj\fR instead of as a \fBchar\fR array. .PP The procedure \fBTcl_SetObjErrorCode\fR is used to set the \fB\-errorcode\fR return option to the list value \fIerrorObjPtr\fR built up by the caller. \fBTcl_SetObjErrorCode\fR is typically invoked just before returning an error. If an error is returned without calling \fBTcl_SetObjErrorCode\fR or \fBTcl_SetErrorCode\fR the Tcl interpreter automatically sets |
| ︙ | ︙ |
Changes to doc/AllowExc.3.
| ︙ | ︙ | |||
25 26 27 28 29 30 31 | .PP If a script is evaluated at top-level (i.e. no other scripts are pending evaluation when the script is invoked), and if the script terminates with a completion code other than \fBTCL_OK\fR, \fBTCL_ERROR\fR or \fBTCL_RETURN\fR, then Tcl normally converts this into a \fBTCL_ERROR\fR return with an appropriate message. The particular script evaluation procedures of Tcl that act in the manner are | | < < | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | .PP If a script is evaluated at top-level (i.e. no other scripts are pending evaluation when the script is invoked), and if the script terminates with a completion code other than \fBTCL_OK\fR, \fBTCL_ERROR\fR or \fBTCL_RETURN\fR, then Tcl normally converts this into a \fBTCL_ERROR\fR return with an appropriate message. The particular script evaluation procedures of Tcl that act in the manner are \fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR. .PP However, if \fBTcl_AllowExceptions\fR is invoked immediately before calling one of those a procedures, then arbitrary completion codes are permitted from the script, and they are returned without modification. This is useful in cases where the caller can deal with exceptions such as \fBTCL_BREAK\fR or \fBTCL_CONTINUE\fR in a meaningful way. |
| ︙ | ︙ |
Deleted doc/Backslash.3.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to doc/CrtInterp.3.
| ︙ | ︙ | |||
104 105 106 107 108 109 110 | extension consisting of new Tcl commands, no special code is needed to protect interpreters received as arguments. This covers the majority of all uses. .TP \fBInterpreter Creation And Deletion\fR . When a new interpreter is created and used in a call to \fBTcl_Eval\fR, | < | | | | | | | > | | < | | | | | | | | | | 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 | extension consisting of new Tcl commands, no special code is needed to protect interpreters received as arguments. This covers the majority of all uses. .TP \fBInterpreter Creation And Deletion\fR . When a new interpreter is created and used in a call to \fBTcl_Eval\fR, \fBTcl_SetVar\fR, or \fBTcl_GetVar\fR, a pair of calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around all uses of the interpreter. Remember that it is unsafe to use the interpreter once \fBTcl_Release\fR has been called. To ensure that the interpreter is properly deleted when it is no longer needed, call \fBTcl_InterpDeleted\fR to test if some other code already called \fBTcl_DeleteInterp\fR; if not, call \fBTcl_DeleteInterp\fR before calling \fBTcl_Release\fR in your own code. .TP \fBRetrieving An Interpreter From A Data Structure\fR . When an interpreter is retrieved from a data structure (e.g. the client data of a callback) for use in one of the evaluation functions (\fBTcl_Eval\fR, \fBTcl_EvalObjv\fR etc.) or variable access functions (\fBTcl_SetVar\fR, \fBTcl_GetVar\fR, \fBTcl_SetVar2Ex\fR, etc.), a pair of calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around all uses of the interpreter; it is unsafe to reuse the interpreter once \fBTcl_Release\fR has been called. If an interpreter is stored inside a callback data structure, an appropriate deletion cleanup mechanism should be set up by the code that creates the data structure so that the interpreter is removed from the data structure (e.g. by setting the field to NULL) when the interpreter is deleted. Otherwise, you may be using an interpreter that has been freed and whose memory may already have been reused. .PP All uses of interpreters in Tcl and Tk have already been protected. Extension writers should ensure that their code also properly protects any additional interpreters used, as described above. .PP .VS 8.6 Note that the protection mechanisms do not work well with conventional garbage |
| ︙ | ︙ |
Deleted doc/CrtMathFnc.3.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to doc/DString.3.
1 2 3 4 5 6 7 8 9 10 11 | '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 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_DString 3 7.4 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 19 | '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 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_DString 3 7.4 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp \fBTcl_DStringInit\fR(\fIdsPtr\fR) .sp char * |
| ︙ | ︙ | |||
30 31 32 33 34 35 36 | \fBTcl_DStringLength\fR(\fIdsPtr\fR) .sp char * \fBTcl_DStringValue\fR(\fIdsPtr\fR) .sp \fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR) .sp | < < | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | \fBTcl_DStringLength\fR(\fIdsPtr\fR) .sp char * \fBTcl_DStringValue\fR(\fIdsPtr\fR) .sp \fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR) .sp \fBTcl_DStringFree\fR(\fIdsPtr\fR) .sp \fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR) .sp \fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR) .SH ARGUMENTS .AS Tcl_DString newLength in/out |
| ︙ | ︙ | |||
124 125 126 127 128 129 130 | However, \fBTcl_DStringSetLength\fR will not initialize the new space except to provide a terminating null character; it is up to the caller to fill in the new space. \fBTcl_DStringSetLength\fR does not free up the string's storage space even if the string is truncated to zero length, so \fBTcl_DStringFree\fR will still need to be called. .PP | < < < < | 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | However, \fBTcl_DStringSetLength\fR will not initialize the new space except to provide a terminating null character; it is up to the caller to fill in the new space. \fBTcl_DStringSetLength\fR does not free up the string's storage space even if the string is truncated to zero length, so \fBTcl_DStringFree\fR will still need to be called. .PP \fBTcl_DStringFree\fR should be called when you are finished using the string. It frees up any memory that was allocated for the string and reinitializes the string's value to an empty string. .PP \fBTcl_DStringResult\fR sets the result of \fIinterp\fR to the value of the dynamic string given by \fIdsPtr\fR. It does this by moving a pointer from \fIdsPtr\fR to the interpreter's result. |
| ︙ | ︙ |
Changes to doc/Encoding.3.
1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 1997-1998 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_GetEncoding 3 "8.1" 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) 1997-1998 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_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp Tcl_Encoding \fBTcl_GetEncoding\fR(\fIinterp, name\fR) .sp |
| ︙ | ︙ | |||
58 59 60 61 62 63 64 | \fBTcl_CreateEncoding\fR(\fItypePtr\fR) .sp Tcl_Obj * \fBTcl_GetEncodingSearchPath\fR() .sp int \fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR) | < < < < < < | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | \fBTcl_CreateEncoding\fR(\fItypePtr\fR) .sp Tcl_Obj * \fBTcl_GetEncodingSearchPath\fR() .sp int \fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR) .SH ARGUMENTS .AS "const Tcl_EncodingType" *dstWrotePtr in/out .AP Tcl_Interp *interp in Interpreter to use for error reporting, or NULL if no error reporting is desired. .AP "const char" *name in Name of encoding to load. |
| ︙ | ︙ | |||
287 288 289 290 291 292 293 | the environment suitable for the platform. It accepts \fIbufPtr\fR, a pointer to an uninitialized or freed \fBTcl_DString\fR and writes the encoding name to it. The \fBTcl_DStringValue\fR is returned. .PP \fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list consisting of the names of all the encodings that are currently defined or can be dynamically loaded, searching the encoding path specified by | | | 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 | the environment suitable for the platform. It accepts \fIbufPtr\fR, a pointer to an uninitialized or freed \fBTcl_DString\fR and writes the encoding name to it. The \fBTcl_DStringValue\fR is returned. .PP \fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list consisting of the names of all the encodings that are currently defined or can be dynamically loaded, searching the encoding path specified by \fBTcl_SetEncodingSearchPath\fR. This procedure does not ensure that the dynamically-loadable encoding files contain valid data, but merely that they exist. .PP \fBTcl_CreateEncoding\fR defines a new encoding and registers the C procedures that are called back to convert between the encoding and UTF-8. Encodings created by \fBTcl_CreateEncoding\fR are thereafter visible in the database used by \fBTcl_GetEncoding\fR. Just as with the |
| ︙ | ︙ | |||
402 403 404 405 406 407 408 | \fBTcl_SetEncodingSearchPath\fR stores \fIsearchPath\fR and returns \fBTCL_OK\fR, unless \fIsearchPath\fR is not a valid Tcl list, which causes \fBTCL_ERROR\fR to be returned. The elements of \fIsearchPath\fR are not verified as existing readable filesystem directories. When searching for encoding data files takes place, and non-existent or non-readable filesystem directories on the \fIsearchPath\fR are silently ignored. | < < < < < < < < < | 396 397 398 399 400 401 402 403 404 405 406 407 408 409 | \fBTcl_SetEncodingSearchPath\fR stores \fIsearchPath\fR and returns \fBTCL_OK\fR, unless \fIsearchPath\fR is not a valid Tcl list, which causes \fBTCL_ERROR\fR to be returned. The elements of \fIsearchPath\fR are not verified as existing readable filesystem directories. When searching for encoding data files takes place, and non-existent or non-readable filesystem directories on the \fIsearchPath\fR are silently ignored. .SH "ENCODING FILES" Space would prohibit precompiling into Tcl every possible encoding algorithm, so many encodings are stored on disk as dynamically-loadable encoding files. This behavior also allows the user to create additional encoding files that can be loaded using the same mechanism. These encoding files contain information about the tables and/or escape sequences used to map between an external encoding and Unicode. The |
| ︙ | ︙ |
Changes to doc/Eval.3.
1 2 3 4 5 6 7 8 9 10 11 12 | '\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-1997 Sun Microsystems, Inc. '\" Copyright (c) 2000 Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_Eval 3 8.1 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 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | '\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-1997 Sun Microsystems, Inc. '\" Copyright (c) 2000 Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_EvalObjEx, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx \- execute Tcl scripts .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp int \fBTcl_EvalObjEx\fR(\fIinterp, objPtr, flags\fR) .sp int \fBTcl_EvalObjv\fR(\fIinterp, objc, objv, flags\fR) .sp int \fBTcl_Eval\fR(\fIinterp, script\fR) .sp int \fBTcl_EvalEx\fR(\fIinterp, script, numBytes, flags\fR) .SH ARGUMENTS .AS Tcl_Interp **termPtr .AP Tcl_Interp *interp in Interpreter in which to execute the script. The interpreter's result is modified to hold the result or error message from the script. .AP Tcl_Obj *objPtr in A Tcl value containing the script to execute. |
| ︙ | ︙ | |||
89 90 91 92 93 94 95 | described here) is a Tcl completion code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .PP | < < < < < < < < < < < < < < < < | < < < < | < | < < < < < < < < < < < < < < < < < < < | 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 | described here) is a Tcl completion code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .PP \fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a script. The \fIobjc\fR and \fIobjv\fR arguments contain the values of the words for the Tcl command, one word in each value in \fIobjv\fR. \fBTcl_EvalObjv\fR evaluates the command and returns a completion code and result just like \fBTcl_EvalObjEx\fR. The caller of \fBTcl_EvalObjv\fR has to manage the reference count of the elements of \fIobjv\fR, insuring that the values are valid until \fBTcl_EvalObjv\fR returns. .PP \fBTcl_Eval\fR is similar to \fBTcl_EvalObjEx\fR except that the script to be executed is supplied as a string instead of a value and no compilation occurs. The string should be a proper UTF-8 string as converted by \fBTcl_ExternalToUtfDString\fR or \fBTcl_ExternalToUtf\fR when it is known to possibly contain upper ASCII characters whose possible combinations might be a UTF-8 special code. The string is parsed and executed directly (using \fBTcl_EvalObjv\fR) instead of compiling it and executing the bytecodes. In situations where it is known that the script will never be executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR. \fBTcl_Eval\fR returns a completion code and result just like \fBTcl_EvalObjEx\fR. .PP \fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes additional arguments \fInumBytes\fR and \fIflags\fR. \fBTcl_EvalEx\fR is generally preferred over \fBTcl_Eval\fR. .SH "FLAG BITS" .PP Any ORed combination of the following values may be used for the \fIflags\fR argument to procedures such as \fBTcl_EvalObjEx\fR: .TP 23 \fBTCL_EVAL_DIRECT\fR |
| ︙ | ︙ |
Changes to doc/GetInt.3.
| ︙ | ︙ | |||
57 58 59 60 61 62 63 | .QW \fB0x\fR then \fIsrc\fR is expected to be in hexadecimal form; otherwise, if the first such characters are .QW \fB0o\fR then \fIsrc\fR is expected to be in octal form; otherwise, if the first such characters are .QW \fB0b\fR | < < < | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | .QW \fB0x\fR then \fIsrc\fR is expected to be in hexadecimal form; otherwise, if the first such characters are .QW \fB0o\fR then \fIsrc\fR is expected to be in octal form; otherwise, if the first such characters are .QW \fB0b\fR then \fIsrc\fR is expected to be in binary form; otherwise, \fIsrc\fR is expected to be in decimal form. .PP \fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point number, which is: white space; a sign; a sequence of digits; a decimal point .QW \fB.\fR ; a sequence of digits; the letter |
| ︙ | ︙ |
Changes to doc/InitStubs.3.
| ︙ | ︙ | |||
59 60 61 62 63 64 65 | Call \fBTcl_InitStubs\fR in the extension before calling any other Tcl functions. .IP 2) 5 Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the \fB\-DUSE_TCL_STUBS\fR flag when compiling the extension. .IP 3) 5 Link the extension with the Tcl stubs library instead of the standard | | | | | 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | Call \fBTcl_InitStubs\fR in the extension before calling any other Tcl functions. .IP 2) 5 Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the \fB\-DUSE_TCL_STUBS\fR flag when compiling the extension. .IP 3) 5 Link the extension with the Tcl stubs library instead of the standard Tcl library. For example, to use the Tcl 9.0 ABI on Unix platforms, the library name is \fIlibtclstub9.0.a\fR; on Windows platforms, the library name is \fItclstub90.lib\fR. .PP If the extension also requires the Tk API, it must also call \fBTk_InitStubs\fR to initialize the Tk stubs interface and link with the Tk stubs libraries. See the \fBTk_InitStubs\fR page for more information. .SH DESCRIPTION \fBTcl_InitStubs\fR attempts to initialize the stub table pointers |
| ︙ | ︙ |
Changes to doc/Interp.3.
| ︙ | ︙ | |||
29 30 31 32 33 34 35 | structure. Callers of \fBTcl_CreateInterp\fR should use this pointer as an opaque token, suitable for nothing other than passing back to other routines in the Tcl interface. Accessing fields directly through the pointer as described below is no longer supported. The supported public routines \fBTcl_SetResult\fR, \fBTcl_GetResult\fR, \fBTcl_SetErrorLine\fR, \fBTcl_GetErrorLine\fR must be used instead. .PP | < < < < < < < < < < < < < | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | structure. Callers of \fBTcl_CreateInterp\fR should use this pointer as an opaque token, suitable for nothing other than passing back to other routines in the Tcl interface. Accessing fields directly through the pointer as described below is no longer supported. The supported public routines \fBTcl_SetResult\fR, \fBTcl_GetResult\fR, \fBTcl_SetErrorLine\fR, \fBTcl_GetErrorLine\fR must be used instead. .PP The \fIresult\fR and \fIfreeProc\fR fields are used to return results or error messages from commands. This information is returned by command procedures back to \fBTcl_Eval\fR, and by \fBTcl_Eval\fR back to its callers. The \fIresult\fR field points to the string that represents the result or error message, and the \fIfreeProc\fR field tells how to dispose of the storage for the string when it is not needed anymore. |
| ︙ | ︙ |
Changes to doc/ParseCmd.3.
1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 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_ParseCommand 3 8.3 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) 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_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp int \fBTcl_ParseCommand\fR(\fIinterp, start, numBytes, nested, parsePtr\fR) .sp |
| ︙ | ︙ | |||
29 30 31 32 33 34 35 | \fBTcl_ParseVarName\fR(\fIinterp, start, numBytes, parsePtr, append\fR) .sp const char * \fBTcl_ParseVar\fR(\fIinterp, start, termPtr\fR) .sp \fBTcl_FreeParse\fR(\fIusedParsePtr\fR) .sp | < < < | | < | | | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | \fBTcl_ParseVarName\fR(\fIinterp, start, numBytes, parsePtr, append\fR) .sp const char * \fBTcl_ParseVar\fR(\fIinterp, start, termPtr\fR) .sp \fBTcl_FreeParse\fR(\fIusedParsePtr\fR) .sp int \fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR) .SH ARGUMENTS .AS Tcl_Interp *usedParsePtr out .AP Tcl_Interp *interp out For procedures other than \fBTcl_FreeParse\fR and \fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors. For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating the script and also is used for error reporting; must not be NULL. .AP "const char" *start in Pointer to first character in string to parse. .AP int numBytes in Number of bytes in string to parse, not including any terminating null character. If less than 0 then the script consists of all characters following \fIstart\fR up to the first null character. .AP int nested in |
| ︙ | ︙ | |||
187 188 189 190 191 192 193 | resulting values. The return value from \fBTcl_EvalTokensStandard\fR is a Tcl completion code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. | < < < < < < < < < < | 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | resulting values. The return value from \fBTcl_EvalTokensStandard\fR is a Tcl completion code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .SH "TCL_PARSE STRUCTURE" .PP \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR return parse information in two data structures, Tcl_Parse and Tcl_Token: .PP .CS |
| ︙ | ︙ |
Changes to doc/RecEvalObj.3.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 | command but do not evaluate it. \fBTCL_EVAL_GLOBAL\fR means evaluate the command at global level instead of the current stack level. .BE .SH DESCRIPTION .PP \fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event | | < < | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | command but do not evaluate it. \fBTCL_EVAL_GLOBAL\fR means evaluate the command at global level instead of the current stack level. .BE .SH DESCRIPTION .PP \fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event on the history list and then execute it using \fBTcl_EvalObjEx\fR. It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR, as well as a result value containing additional information (a result value or error message) that can be retrieved using \fBTcl_GetObjResult\fR. If you do not want the command recorded on the history list then you should invoke \fBTcl_EvalObjEx\fR instead of \fBTcl_RecordAndEvalObj\fR. Normally \fBTcl_RecordAndEvalObj\fR is only called with top-level |
| ︙ | ︙ |
Changes to doc/RecordEval.3.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 | command but do not evaluate it. \fBTCL_EVAL_GLOBAL\fR means evaluate the command at global level instead of the current stack level. .BE .SH DESCRIPTION .PP \fBTcl_RecordAndEval\fR is invoked to record a command as an event | | < | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | command but do not evaluate it. \fBTCL_EVAL_GLOBAL\fR means evaluate the command at global level instead of the current stack level. .BE .SH DESCRIPTION .PP \fBTcl_RecordAndEval\fR is invoked to record a command as an event on the history list and then execute it using \fBTcl_Eval\fR. It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_Eval\fR and it leaves information in the interpreter's result. If you do not want the command recorded on the history list then you should invoke \fBTcl_Eval\fR instead of \fBTcl_RecordAndEval\fR. Normally \fBTcl_RecordAndEval\fR is only called with top-level commands typed by the user, since the purpose of history is to allow the user to re-issue recently-invoked commands. |
| ︙ | ︙ |
Changes to doc/SetRecLmt.3.
| ︙ | ︙ | |||
25 26 27 28 29 30 31 | New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR. .BE .SH DESCRIPTION .PP At any given time Tcl enforces a limit on the number of recursive calls that may be active for \fBTcl_Eval\fR and related procedures | | | | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR. .BE .SH DESCRIPTION .PP At any given time Tcl enforces a limit on the number of recursive calls that may be active for \fBTcl_Eval\fR and related procedures such as \fBTcl_EvalEx\fR. Any call to \fBTcl_EvalEx\fR that exceeds this depth is aborted with an error. By default the recursion limit is 1000. .PP \fBTcl_SetRecursionLimit\fR may be used to change the maximum allowable nesting depth for an interpreter. The \fIdepth\fR argument specifies a new limit for \fIinterp\fR, and \fBTcl_SetRecursionLimit\fR returns the old limit. |
| ︙ | ︙ |
Changes to doc/SetResult.3.
| ︙ | ︙ | |||
127 128 129 130 131 132 133 | and leaves the result in its normal empty initialized state. If the result is a value, its reference count is decremented and the result is left pointing to an unshared value representing an empty string. If the result is a dynamically allocated string, its memory is free*d and the result is left as a empty string. \fBTcl_ResetResult\fR also clears the error state managed by | < | | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | and leaves the result in its normal empty initialized state. If the result is a value, its reference count is decremented and the result is left pointing to an unshared value representing an empty string. If the result is a dynamically allocated string, its memory is free*d and the result is left as a empty string. \fBTcl_ResetResult\fR also clears the error state managed by \fBTcl_AddErrorInfo\fR and \fBTcl_SetErrorCode\fR. .PP \fBTcl_AppendResult\fR makes it easy to build up Tcl results in pieces. It takes each of its \fIresult\fR arguments and appends them in order to the current result associated with \fIinterp\fR. If the result is in its initialized empty state (e.g. a command procedure was just invoked or \fBTcl_ResetResult\fR was just called), then \fBTcl_AppendResult\fR sets the result to the concatenation of |
| ︙ | ︙ | |||
195 196 197 198 199 200 201 | It frees up the memory associated with \fIinterp\fR's result. It also sets \fIinterp->freeProc\fR to zero, but does not change \fIinterp->result\fR or clear error state. \fBTcl_FreeResult\fR is most commonly used when a procedure is about to replace one result value with another. .SS "DIRECT ACCESS TO INTERP->RESULT" .PP | | < | | | < < < < < | 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 | It frees up the memory associated with \fIinterp\fR's result. It also sets \fIinterp->freeProc\fR to zero, but does not change \fIinterp->result\fR or clear error state. \fBTcl_FreeResult\fR is most commonly used when a procedure is about to replace one result value with another. .SS "DIRECT ACCESS TO INTERP->RESULT" .PP It used to be legal for programs to directly read and write \fIinterp->result\fR to manipulate the interpreter result. The Tcl headers no longer permit this access, and C code still doing this must be updated to use supported routines \fBTcl_GetObjResult\fR, \fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR. .SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT" .PP \fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how the Tcl system is to manage the storage for the \fIresult\fR argument. If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called at a time when \fIinterp\fR holds a string result, they do whatever is necessary to dispose of the old string result |
| ︙ | ︙ |
Changes to doc/Utf.3.
| ︙ | ︙ | |||
98 99 100 101 102 103 104 | The length of the UTF-8 string in bytes (not UTF-8 characters). If negative, all bytes up to the first null byte are used. .AP int uniLength in The length of the Unicode string in characters. Must be greater than or equal to 0. .AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. | | | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | The length of the UTF-8 string in bytes (not UTF-8 characters). If negative, all bytes up to the first null byte are used. .AP int uniLength in The length of the Unicode string in characters. Must be greater than or equal to 0. .AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. .AP "size_t" numChars in The number of characters to compare. .AP "const char" *start in Pointer to the beginning of a UTF-8 string. .AP int index in The index of a character (not byte) in the UTF-8 string. .AP int *readPtr out If non-NULL, filled with the number of bytes in the backslash sequence, |
| ︙ | ︙ |
Deleted doc/case.n.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to doc/expr.n.
| ︙ | ︙ | |||
45 46 47 48 49 50 51 | .PP An expression consists of a combination of operands, operators, parentheses and commas, possibly with whitespace between any of these elements, which is ignored. An integer operand may be specified in decimal, binary (the first two characters are \fB0b\fR), octal (the first two characters are \fB0o\fR), or hexadecimal | | < < | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | .PP An expression consists of a combination of operands, operators, parentheses and commas, possibly with whitespace between any of these elements, which is ignored. An integer operand may be specified in decimal, binary (the first two characters are \fB0b\fR), octal (the first two characters are \fB0o\fR), or hexadecimal (the first two characters are \fB0x\fR) form. A floating-point number may be specified in any of several common decimal formats, and may use the decimal point \fB.\fR, \fBe\fR or \fBE\fR for scientific notation, and the sign characters \fB+\fR and \fB\-\fR. The following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16. The strings \fBInf\fR and \fBNaN\fR, in any combination of case, are also recognized as floating point |
| ︙ | ︙ |
Changes to doc/glob.n.
| ︙ | ︙ | |||
40 41 42 43 44 45 46 | .TP \fB\-join\fR . The remaining pattern arguments, after option processing, are treated as a single pattern obtained by joining the arguments with directory separators. .TP | < < < < < | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | .TP \fB\-join\fR . The remaining pattern arguments, after option processing, are treated as a single pattern obtained by joining the arguments with directory separators. .TP \fB\-path\fR \fIpathPrefix\fR . Search for files with the given \fIpathPrefix\fR where the rest of the name matches the given patterns. This allows searching for files with names similar to a given file (as opposed to a directory) even when the names contain glob-sensitive characters. This option may not be used in conjunction with |
| ︙ | ︙ |
Changes to doc/info.n.
| ︙ | ︙ | |||
352 353 354 355 356 357 358 | the global namespace if \fIpattern\fR starts with \fB::\fR) to match within; the matching pattern is taken to be the part after the last namespace separator. .TP \fBinfo script\fR ?\fIfilename\fR? . If a Tcl script file is currently being evaluated (i.e. there is a | | | 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 | the global namespace if \fIpattern\fR starts with \fB::\fR) to match within; the matching pattern is taken to be the part after the last namespace separator. .TP \fBinfo script\fR ?\fIfilename\fR? . If a Tcl script file is currently being evaluated (i.e. there is a call to \fBTcl_FSEvalFile\fR active or there is an active invocation of the \fBsource\fR command), then this command returns the name of the innermost file being processed. If \fIfilename\fR is specified, then the return value of this command will be modified for the duration of the active invocation to return that name. This is useful in virtual file system applications. Otherwise the command returns an empty string. .TP |
| ︙ | ︙ |
Changes to doc/mathfunc.n.
| ︙ | ︙ | |||
102 103 104 105 106 107 108 | \fBsin\fR \fBsinh\fR \fBsqrt\fR \fBsrand\fR \fBtan\fR \fBtanh\fR \fBwide\fR .DE .PP In addition to these predefined functions, applications may define additional functions by using \fBproc\fR (or any other method, such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define | | < < < | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | \fBsin\fR \fBsinh\fR \fBsqrt\fR \fBsrand\fR \fBtan\fR \fBtanh\fR \fBwide\fR .DE .PP In addition to these predefined functions, applications may define additional functions by using \fBproc\fR (or any other method, such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define new commands in the \fBtcl::mathfunc\fR namespace. .SS "DETAILED DEFINITIONS" .TP \fBabs \fIarg\fR . Returns the absolute value of \fIarg\fR. \fIArg\fR may be either integer or floating-point, and the result is returned in the same form. .TP |
| ︙ | ︙ |
Changes to doc/scan.n.
| ︙ | ︙ | |||
220 221 222 223 224 225 226 | hexadecimal conversions with substring sizes: .PP .CS set string "#08D03F" \fBscan\fR $string "#%2x%2x%2x" r g b .CE .PP | | < < | | 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 |
hexadecimal conversions with substring sizes:
.PP
.CS
set string "#08D03F"
\fBscan\fR $string "#%2x%2x%2x" r g b
.CE
.PP
Parse a \fIHH:MM\fR time string:
.PP
.CS
set string "08:08"
if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} {
error "not a valid time string"
}
# We have to understand numeric ranges ourselves...
if {$minutes < 0 || $minutes > 59} {
error "invalid number of minutes"
}
|
| ︙ | ︙ |
Changes to doc/trace.n.
| ︙ | ︙ | |||
273 274 275 276 277 278 279 | While \fIcommandPrefix\fR is executing during a read or write trace, traces on the variable are temporarily disabled. This means that reads and writes invoked by \fIcommandPrefix\fR will occur directly, without invoking \fIcommandPrefix\fR (or any other traces) again. However, if \fIcommandPrefix\fR unsets the variable then unset traces will be invoked. .PP When an unset trace is invoked, the variable has already been deleted: | | < < < | 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | While \fIcommandPrefix\fR is executing during a read or write trace, traces on the variable are temporarily disabled. This means that reads and writes invoked by \fIcommandPrefix\fR will occur directly, without invoking \fIcommandPrefix\fR (or any other traces) again. However, if \fIcommandPrefix\fR unsets the variable then unset traces will be invoked. .PP When an unset trace is invoked, the variable has already been deleted: it will appear to be undefined with no traces. Traces are not disabled during unset traces, so if an unset trace command creates a new trace and accesses the variable, the trace will be invoked. Any errors in unset traces are ignored. .PP If there are multiple traces on a variable they are invoked in order of creation, most-recent first. If one trace returns an error, then no further traces are invoked for the variable. If an array element |
| ︙ | ︙ |
Changes to generic/regc_lex.c.
| ︙ | ︙ | |||
453 454 455 456 457 458 459 |
if (!(v->cflags®_ADVF)) {
RETV(PLAIN, c);
}
NOTE(REG_UNONPOSIX);
if (ATEOS()) {
FAILW(REG_EESCAPE);
}
| | | 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 |
if (!(v->cflags®_ADVF)) {
RETV(PLAIN, c);
}
NOTE(REG_UNONPOSIX);
if (ATEOS()) {
FAILW(REG_EESCAPE);
}
(void)lexescape(v);
switch (v->nexttype) { /* not all escapes okay here */
case PLAIN:
return 1;
break;
case CCLASS:
switch (v->nextvalue) {
case 'd':
|
| ︙ | ︙ | |||
712 713 714 715 716 717 718 |
if (!(v->cflags®_ADVF)) {/* only AREs have non-trivial escapes */
if (iscalnum(*v->now)) {
NOTE(REG_UBSALNUM);
NOTE(REG_UUNSPEC);
}
RETV(PLAIN, *v->now++);
}
| | | 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 |
if (!(v->cflags®_ADVF)) {/* only AREs have non-trivial escapes */
if (iscalnum(*v->now)) {
NOTE(REG_UBSALNUM);
NOTE(REG_UUNSPEC);
}
RETV(PLAIN, *v->now++);
}
(void)lexescape(v);
if (ISERR()) {
FAILW(REG_EESCAPE);
}
if (v->nexttype == CCLASS) {/* fudge at lexical level */
switch (v->nextvalue) {
case 'd': lexnest(v, backd, ENDOF(backd)); break;
case 'D': lexnest(v, backD, ENDOF(backD)); break;
|
| ︙ | ︙ | |||
1139 1140 1141 1142 1143 1144 1145 |
NOTE(REG_UNONPOSIX);
}
}
/*
- newline - return the chr for a newline
* This helps confine use of CHR to this source file.
| | | 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 |
NOTE(REG_UNONPOSIX);
}
}
/*
- newline - return the chr for a newline
* This helps confine use of CHR to this source file.
^ static chr newline(void);
*/
static chr
newline(void)
{
return CHR('\n');
}
|
| ︙ | ︙ |
Changes to generic/regc_locale.c.
| ︙ | ︙ | |||
1223 1224 1225 1226 1227 1228 1229 |
^ static int cmp(const chr *, const chr *, size_t);
*/
static int /* 0 for equal, nonzero for unequal */
cmp(
const chr *x, const chr *y, /* strings to compare */
size_t len) /* exact length of comparison */
{
| | | 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 |
^ static int cmp(const chr *, const chr *, size_t);
*/
static int /* 0 for equal, nonzero for unequal */
cmp(
const chr *x, const chr *y, /* strings to compare */
size_t len) /* exact length of comparison */
{
return memcmp((void*)(x), (void*)(y), len*sizeof(chr));
}
/*
- casecmp - case-independent chr-substring compare
* REG_ICASE backrefs need this. It should preferably be efficient.
* Note that it does not need to report anything except equal/unequal.
* Note also that the length is exact, and the comparison should not
|
| ︙ | ︙ |
Changes to generic/regc_nfa.c.
| ︙ | ︙ | |||
839 840 841 842 843 844 845 |
assert(oldState->nins == 0);
assert(oldState->ins == NULL);
}
/*
- copyins - copy in arcs of a state to another state
| | | 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 |
assert(oldState->nins == 0);
assert(oldState->ins == NULL);
}
/*
- copyins - copy in arcs of a state to another state
^ static void copyins(struct nfa *, struct state *, struct state *, int);
*/
static void
copyins(
struct nfa *nfa,
struct state *oldState,
struct state *newState)
{
|
| ︙ | ︙ | |||
1096 1097 1098 1099 1100 1101 1102 |
assert(oldState->nouts == 0);
assert(oldState->outs == NULL);
}
/*
- copyouts - copy out arcs of a state to another state
| | | 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 |
assert(oldState->nouts == 0);
assert(oldState->outs == NULL);
}
/*
- copyouts - copy out arcs of a state to another state
^ static void copyouts(struct nfa *, struct state *, struct state *, int);
*/
static void
copyouts(
struct nfa *nfa,
struct state *oldState,
struct state *newState)
{
|
| ︙ | ︙ |
Changes to generic/regcomp.c.
| ︙ | ︙ | |||
78 79 80 81 82 83 84 | static void lexnest(struct vars *, const chr *, const chr *); static void lexword(struct vars *); static int next(struct vars *); static int lexescape(struct vars *); static int lexdigits(struct vars *, int, int, int); static int brenext(struct vars *, pchr); static void skip(struct vars *); | | | 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 | static void lexnest(struct vars *, const chr *, const chr *); static void lexword(struct vars *); static int next(struct vars *); static int lexescape(struct vars *); static int lexdigits(struct vars *, int, int, int); static int brenext(struct vars *, pchr); static void skip(struct vars *); static chr newline(void); static chr chrnamed(struct vars *, const chr *, const chr *, pchr); /* === regc_color.c === */ static void initcm(struct vars *, struct colormap *); static void freecm(struct colormap *); static void cmtreefree(struct colormap *, union tree *, int); static color setcolor(struct colormap *, pchr, pcolor); static color maxcolor(struct colormap *); |
| ︙ | ︙ | |||
337 338 339 340 341 342 343 |
v->lacons = NULL;
v->nlacons = 0;
v->spaceused = 0;
re->re_magic = REMAGIC;
re->re_info = 0; /* bits get set during parse */
re->re_csize = sizeof(chr);
re->re_guts = NULL;
| | | | 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 |
v->lacons = NULL;
v->nlacons = 0;
v->spaceused = 0;
re->re_magic = REMAGIC;
re->re_info = 0; /* bits get set during parse */
re->re_csize = sizeof(chr);
re->re_guts = NULL;
re->re_fns = (void*)(&functions);
/*
* More complex setup, malloced things.
*/
re->re_guts = (void*)(MALLOC(sizeof(struct guts)));
if (re->re_guts == NULL) {
return freev(v, REG_ESPACE);
}
g = (struct guts *) re->re_guts;
g->tree = NULL;
initcm(v, &g->cmap);
v->cm = &g->cmap;
|
| ︙ | ︙ | |||
430 431 432 433 434 435 436 |
fprintf(debug, "\n\n\n========= SEARCH ==========\n");
}
/*
* Can sacrifice main NFA now, so use it as work area.
*/
| | | 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 |
fprintf(debug, "\n\n\n========= SEARCH ==========\n");
}
/*
* Can sacrifice main NFA now, so use it as work area.
*/
(void) optimize(v->nfa, debug);
CNOERR();
makesearch(v, v->nfa);
CNOERR();
compact(v->nfa, &g->search);
CNOERR();
/*
|
| ︙ | ︙ | |||
1916 1917 1918 1919 1920 1921 1922 |
struct vars *v,
struct subre *t,
FILE *f) /* for debug output */
{
assert(t != NULL && t->begin != NULL);
if (t->left != NULL) {
| | | | 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 |
struct vars *v,
struct subre *t,
FILE *f) /* for debug output */
{
assert(t != NULL && t->begin != NULL);
if (t->left != NULL) {
(void) nfatree(v, t->left, f);
}
if (t->right != NULL) {
(void) nfatree(v, t->right, f);
}
return nfanode(v, t, f);
}
/*
- nfanode - do one NFA for nfatree
|
| ︙ | ︙ |
Changes to generic/regcustom.h.
| ︙ | ︙ | |||
32 33 34 35 36 37 38 | #include "regex.h" /* * Overrides for regguts.h definitions, if any. */ | < | | | | 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | #include "regex.h" /* * Overrides for regguts.h definitions, if any. */ #define MALLOC(n) ((void*)(attemptckalloc(n))) #define FREE(p) ckfree((void*)(p)) #define REALLOC(p,n) ((void*)(attemptckrealloc((void*)(p),n))) /* * Do not insert extras between the "begin" and "end" lines - this chunk is * automatically extracted to be fitted into regex.h. */ /* --- begin --- */ |
| ︙ | ︙ |
Changes to generic/regexec.c.
| ︙ | ︙ | |||
40 41 42 43 44 45 46 |
};
struct sset { /* state set */
unsigned *states; /* pointer to bitvector */
unsigned hash; /* hash of bitvector */
#define HASH(bv, nw) (((nw) == 1) ? *(bv) : hash(bv, nw))
#define HIT(h,bv,ss,nw) ((ss)->hash == (h) && ((nw) == 1 || \
| | | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 |
};
struct sset { /* state set */
unsigned *states; /* pointer to bitvector */
unsigned hash; /* hash of bitvector */
#define HASH(bv, nw) (((nw) == 1) ? *(bv) : hash(bv, nw))
#define HIT(h,bv,ss,nw) ((ss)->hash == (h) && ((nw) == 1 || \
memcmp((void*)(bv), (void*)((ss)->states), (nw)*sizeof(unsigned)) == 0))
int flags;
#define STARTER 01 /* the initial state set */
#define POSTSTATE 02 /* includes the goal state */
#define LOCKED 04 /* locked in cache */
#define NOPROGRESS 010 /* zero-progress state set */
struct arcp ins; /* chain of inarcs pointing here */
chr *lastseen; /* last entered on arrival here */
|
| ︙ | ︙ | |||
264 265 266 267 268 269 270 |
/*
* Copy (portion of) match vector over if necessary.
*/
if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
zapallsubs(pmatch, nmatch);
n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
| | | 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 |
/*
* Copy (portion of) match vector over if necessary.
*/
if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
zapallsubs(pmatch, nmatch);
n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
memcpy((void*)(pmatch), (void*)(v->pmatch), n*sizeof(regmatch_t));
}
/*
* Clean up.
*/
if (v->pmatch != pmatch && v->pmatch != mat) {
|
| ︙ | ︙ |
Changes to generic/regguts.h.
| ︙ | ︙ | |||
45 46 47 48 49 50 51 | #ifndef NDEBUG #define NDEBUG /* no assertions */ #endif #endif /* !REG_DEBUG */ #include <assert.h> #endif | < < < < < < < < < < < < < < < < < < < < < < < < < < | | | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | #ifndef NDEBUG #define NDEBUG /* no assertions */ #endif #endif /* !REG_DEBUG */ #include <assert.h> #endif /* memory allocation */ #ifndef MALLOC #define MALLOC(n) malloc(n) #endif #ifndef REALLOC #define REALLOC(p, n) realloc((void*)(p), n) #endif #ifndef FREE #define FREE(p) free((void*)(p)) #endif /* want size of a char in bits, and max value in bounded quantifiers */ #ifndef _POSIX2_RE_DUP_MAX #define _POSIX2_RE_DUP_MAX 255 /* normally from <limits.h> */ #endif |
| ︙ | ︙ | |||
404 405 406 407 408 409 410 |
/*
* table of function pointers for generic manipulation functions. A regex_t's
* re_fns points to one of these.
*/
struct fns {
| | | | 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 407 408 409 |
/*
* table of function pointers for generic manipulation functions. A regex_t's
* re_fns points to one of these.
*/
struct fns {
void (*free)(regex_t *);
};
/*
* the insides of a regex_t, hidden behind a void *
*/
struct guts {
int magic;
#define GUTSMAGIC 0xfed9
int cflags; /* copy of compile flags */
long info; /* copy of re_info */
size_t nsub; /* copy of re_nsub */
struct subre *tree;
struct cnfa search; /* for fast preliminary search */
int ntree; /* number of subre's, plus one */
struct colormap cmap;
int (*compare) (const chr *, const chr *, size_t);
struct subre *lacons; /* lookahead-constraint vector */
int nlacons; /* size of lacons */
};
/*
* Magic for allocating a variable workspace. This default version is
* stack-hungry.
|
| ︙ | ︙ |
Changes to generic/tcl.decls.
| ︙ | ︙ | |||
14 15 16 17 18 19 20 21 22 | library tcl # Define the tcl interface with several sub interfaces: # tclPlat - platform specific public # tclInt - generic private # tclPlatInt - platform specific private interface tcl | > > | | | | 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 |
library tcl
# Define the tcl interface with several sub interfaces:
# tclPlat - platform specific public
# tclInt - generic private
# tclPlatInt - platform specific private
# tclOO - tclOO public
# tclOOInt - tclOO private
interface tcl
hooks {tclPlat tclInt tclIntPlat tclOO tclOOInt}
scspec TCLAPI
# Declare each of the functions in the public Tcl interface. Note that
# the an index should never be reused for a different function in order
# to preserve backwards compatibility.
declare 0 {
int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name,
const char *version, const void *clientData)
}
declare 1 {
const char *Tcl_PkgRequireEx(Tcl_Interp *interp,
const char *name, const char *version, int exact,
void *clientDataPtr)
}
declare 2 {
TCL_NORETURN void Tcl_Panic(const char *format, ...)
}
declare 3 {
|
| ︙ | ︙ | |||
148 149 150 151 152 153 154 |
declare 34 {
int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
declare 35 {
int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
double *doublePtr)
}
| > | | | < > | | 150 151 152 153 154 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 |
declare 34 {
int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
declare 35 {
int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
double *doublePtr)
}
# Removed in 9.0
#declare 36 {
# int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
# const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
#}
declare 37 {
int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
}
declare 38 {
int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr)
}
declare 39 {
int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
}
declare 40 {
const Tcl_ObjType *Tcl_GetObjType(const char *typeName)
}
declare 41 {
char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
declare 42 {
void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
}
|
| ︙ | ︙ | |||
249 250 251 252 253 254 255 |
}
declare 65 {
void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length)
}
declare 66 {
void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
}
| > | | | < > | 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 |
}
declare 65 {
void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length)
}
declare 66 {
void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
}
# Removed in 9.0:
#declare 67 {
# void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message,
# int length)
#}
declare 68 {
void Tcl_AllowExceptions(Tcl_Interp *interp)
}
declare 69 {
void Tcl_AppendElement(Tcl_Interp *interp, const char *element)
}
declare 70 {
|
| ︙ | ︙ | |||
281 282 283 284 285 286 287 |
}
declare 75 {
int Tcl_AsyncReady(void)
}
declare 76 {
void Tcl_BackgroundError(Tcl_Interp *interp)
}
| > | | < > | | | 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 |
}
declare 75 {
int Tcl_AsyncReady(void)
}
declare 76 {
void Tcl_BackgroundError(Tcl_Interp *interp)
}
# Removed in 9.0
#declare 77 {
# char Tcl_Backslash(const char *src, int *readPtr)
#}
declare 78 {
int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
const char *optionList)
}
declare 79 {
void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
ClientData clientData)
}
declare 80 {
void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData)
}
declare 81 {
int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 82 {
int Tcl_CommandComplete(const char *cmd)
}
declare 83 {
char *Tcl_Concat(int argc, const char *const *argv)
}
declare 84 {
int Tcl_ConvertElement(const char *src, char *dst, int flags)
}
declare 85 {
int Tcl_ConvertCountedElement(const char *src, int length, char *dst,
int flags)
}
declare 86 {
int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
Tcl_Interp *target, const char *targetCmd, int argc,
const char *const *argv)
}
declare 87 {
int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
Tcl_Interp *target, const char *targetCmd, int objc,
Tcl_Obj *const objv[])
}
declare 88 {
|
| ︙ | ︙ | |||
348 349 350 351 352 353 354 |
}
declare 93 {
void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 94 {
Tcl_Interp *Tcl_CreateInterp(void)
}
| | | | | < > | 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 |
}
declare 93 {
void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 94 {
Tcl_Interp *Tcl_CreateInterp(void)
}
#declare 95 {
# void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
# int numArgs, Tcl_ValueType *argTypes,
# Tcl_MathProc *proc, ClientData clientData)
#}
declare 96 {
Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
const char *cmdName,
Tcl_ObjCmdProc *proc, ClientData clientData,
Tcl_CmdDeleteProc *deleteProc)
}
declare 97 {
|
| ︙ | ︙ | |||
457 458 459 460 461 462 463 |
declare 125 {
void Tcl_DStringStartSublist(Tcl_DString *dsPtr)
}
declare 126 {
int Tcl_Eof(Tcl_Channel chan)
}
declare 127 {
| | | > | | < | > | | < > > | | < > | 462 463 464 465 466 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 |
declare 125 {
void Tcl_DStringStartSublist(Tcl_DString *dsPtr)
}
declare 126 {
int Tcl_Eof(Tcl_Channel chan)
}
declare 127 {
const char *Tcl_ErrnoId(void)
}
declare 128 {
const char *Tcl_ErrnoMsg(int err)
}
# Removed in 9.0:
#declare 129 {
# int Tcl_Eval(Tcl_Interp *interp, const char *script)
#}
# Removed in 9.0:
#declare 130 {
# int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
#}
# Removed in 9.0:
#declare 131 {
# int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
declare 132 {
void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
}
declare 133 {
TCL_NORETURN void Tcl_Exit(int status)
}
declare 134 {
|
| ︙ | ︙ | |||
510 511 512 513 514 515 516 |
}
declare 142 {
int Tcl_ExprString(Tcl_Interp *interp, const char *expr)
}
declare 143 {
void Tcl_Finalize(void)
}
| > | | < > | | | | 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 |
}
declare 142 {
int Tcl_ExprString(Tcl_Interp *interp, const char *expr)
}
declare 143 {
void Tcl_Finalize(void)
}
# Removed (from stubtable only) in 9.0:
#declare 144 {
# void Tcl_FindExecutable(const char *argv0)
#}
declare 145 {
Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
Tcl_HashSearch *searchPtr)
}
declare 146 {
int Tcl_Flush(Tcl_Channel chan)
}
declare 147 {
void Tcl_FreeResult(Tcl_Interp *interp)
}
declare 148 {
int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
int *argcPtr, const char ***argvPtr)
}
declare 149 {
int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
int *objcPtr, Tcl_Obj ***objv)
}
declare 150 {
ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name,
Tcl_InterpDeleteProc **procPtr)
}
declare 151 {
|
| ︙ | ︙ | |||
555 556 557 558 559 560 561 |
declare 154 {
ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan)
}
declare 155 {
int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 {
| | | | | | 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 |
declare 154 {
ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan)
}
declare 155 {
int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 {
const char *Tcl_GetChannelName(Tcl_Channel chan)
}
declare 157 {
int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
const char *optionName, Tcl_DString *dsPtr)
}
declare 158 {
const Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
}
declare 159 {
int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName,
Tcl_CmdInfo *infoPtr)
}
declare 160 {
const char *Tcl_GetCommandName(Tcl_Interp *interp,
Tcl_Command command)
}
declare 161 {
int Tcl_GetErrno(void)
}
declare 162 {
const char *Tcl_GetHostName(void)
}
declare 163 {
int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
}
declare 164 {
Tcl_Interp *Tcl_GetMaster(Tcl_Interp *interp)
}
|
| ︙ | ︙ | |||
619 620 621 622 623 624 625 |
declare 172 {
Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName)
}
declare 173 {
Tcl_Channel Tcl_GetStdChannel(int type)
}
declare 174 {
| | > | | | < > | > | | < > > | | < > | 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 |
declare 172 {
Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName)
}
declare 173 {
Tcl_Channel Tcl_GetStdChannel(int type)
}
declare 174 {
const char *Tcl_GetStringResult(Tcl_Interp *interp)
}
# Removed in 9.0
#declare 175 {
# const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
# int flags)
#}
declare 176 {
const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags)
}
# Removed in 9.0
#declare 177 {
# int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
#}
# Removed in 9.0
#declare 178 {
# int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
declare 179 {
int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName,
const char *hiddenCmdToken)
}
declare 180 {
int Tcl_Init(Tcl_Interp *interp)
}
|
| ︙ | ︙ | |||
659 660 661 662 663 664 665 |
int Tcl_InterpDeleted(Tcl_Interp *interp)
}
declare 185 {
int Tcl_IsSafe(Tcl_Interp *interp)
}
# Obsolete, use Tcl_FSJoinPath
declare 186 {
| | | 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 |
int Tcl_InterpDeleted(Tcl_Interp *interp)
}
declare 185 {
int Tcl_IsSafe(Tcl_Interp *interp)
}
# Obsolete, use Tcl_FSJoinPath
declare 186 {
char *Tcl_JoinPath(int argc, const char *const *argv,
Tcl_DString *resultPtr)
}
declare 187 {
int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr,
int type)
}
|
| ︙ | ︙ | |||
682 683 684 685 686 687 688 |
declare 190 {
int Tcl_MakeSafe(Tcl_Interp *interp)
}
declare 191 {
Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
}
declare 192 {
| | | | 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 |
declare 190 {
int Tcl_MakeSafe(Tcl_Interp *interp)
}
declare 191 {
Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
}
declare 192 {
char *Tcl_Merge(int argc, const char *const *argv)
}
declare 193 {
Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
}
declare 194 {
void Tcl_NotifyChannel(Tcl_Channel channel, int mask)
}
declare 195 {
Tcl_Obj *Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, int flags)
}
declare 196 {
Tcl_Obj *Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags)
}
declare 197 {
Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
const char **argv, int flags)
}
# This is obsolete, use Tcl_FSOpenFileChannel
declare 198 {
Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName,
const char *modeString, int permissions)
}
declare 199 {
|
| ︙ | ︙ | |||
726 727 728 729 730 731 732 |
declare 202 {
void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst)
}
declare 203 {
int Tcl_PutEnv(const char *assignment)
}
declare 204 {
| | | 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 |
declare 202 {
void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst)
}
declare 203 {
int Tcl_PutEnv(const char *assignment)
}
declare 204 {
const char *Tcl_PosixError(Tcl_Interp *interp)
}
declare 205 {
void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
}
declare 206 {
int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead)
}
|
| ︙ | ︙ | |||
762 763 764 765 766 767 768 |
}
declare 214 {
int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
const char *pattern)
}
declare 215 {
void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
| | | | | < > | 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 |
}
declare 214 {
int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
const char *pattern)
}
declare 215 {
void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
const char **startPtr, const char **endPtr)
}
declare 216 {
void Tcl_Release(ClientData clientData)
}
declare 217 {
void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 {
int Tcl_ScanElement(const char *src, int *flagPtr)
}
declare 219 {
int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
# Removed in Tcl 9
#declare 220 {
# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
#}
declare 221 {
int Tcl_ServiceAll(void)
}
declare 222 {
int Tcl_ServiceEvent(int flags)
}
declare 223 {
|
| ︙ | ︙ | |||
810 811 812 813 814 815 816 |
}
declare 228 {
void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
}
declare 229 {
void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
| > | | < > > | | | < > | | | | | | | | < > > | | | < > > | | < > > | | | < > > | | | < > > | | < > > | | | < > | 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 |
}
declare 228 {
void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
}
declare 229 {
void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
# Removed (from stubtable only) in 9.0:
#declare 230 {
# void Tcl_SetPanicProc(Tcl_PanicProc *panicProc)
#}
declare 231 {
int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
}
declare 232 {
void Tcl_SetResult(Tcl_Interp *interp, char *result,
Tcl_FreeProc *freeProc)
}
declare 233 {
int Tcl_SetServiceMode(int mode)
}
declare 234 {
void Tcl_SetObjErrorCode(Tcl_Interp *interp, Tcl_Obj *errorObjPtr)
}
declare 235 {
void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr)
}
declare 236 {
void Tcl_SetStdChannel(Tcl_Channel channel, int type)
}
# Removed in 9.0:
#declare 237 {
# const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
# const char *newValue, int flags)
#}
declare 238 {
const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, const char *newValue, int flags)
}
declare 239 {
const char *Tcl_SignalId(int sig)
}
declare 240 {
const char *Tcl_SignalMsg(int sig)
}
declare 241 {
void Tcl_SourceRCFile(Tcl_Interp *interp)
}
declare 242 {
int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
const char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
}
declare 244 {
void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}
declare 245 {
int Tcl_StringMatch(const char *str, const char *pattern)
}
# Removed in Tcl 9
#declare 246 {
# int Tcl_TellOld(Tcl_Channel chan)
#}
# Removed in Tcl 9
#declare 247 {
# int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
# Tcl_VarTraceProc *proc, ClientData clientData)
#}
declare 248 {
int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2,
int flags, Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 249 {
char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name,
Tcl_DString *bufferPtr)
}
declare 250 {
int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead)
}
declare 251 {
void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName)
}
declare 252 {
int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
# Removed in 9.0:
#declare 253 {
# int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags)
#}
declare 254 {
int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2,
int flags)
}
# Removed in 9.0:
#declare 255 {
# void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
# Tcl_VarTraceProc *proc, ClientData clientData)
#}
declare 256 {
void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags, Tcl_VarTraceProc *proc,
ClientData clientData)
}
declare 257 {
void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
}
# Removed in 9.0
#declare 258 {
# int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
# const char *varName, const char *localName, int flags)
#}
declare 259 {
int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1,
const char *part2, const char *localName, int flags)
}
# Removed in 9.0
#declare 260 {
# int Tcl_VarEval(Tcl_Interp *interp, ...)
#}
# Removed in 9.0
#declare 261 {
# ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
# int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
#}
declare 262 {
ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags, Tcl_VarTraceProc *procPtr,
ClientData prevClientData)
}
declare 263 {
int Tcl_Write(Tcl_Channel chan, const char *s, int slen)
|
| ︙ | ︙ | |||
951 952 953 954 955 956 957 |
declare 268 {
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
declare 269 {
char *Tcl_HashStats(Tcl_HashTable *tablePtr)
}
declare 270 {
| | | > | | | < > | > | > | | | < > > | | < > | 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 |
declare 268 {
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
declare 269 {
char *Tcl_HashStats(Tcl_HashTable *tablePtr)
}
declare 270 {
const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
const char **termPtr)
}
# Removed in 9.0, converted to macro
#declare 271 {
# const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
# const char *version, int exact)
#}
declare 272 {
const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
const char *name, const char *version, int exact,
void *clientDataPtr)
}
# Changed to a macro, only (internally) exposed for legacy protection.
declare 273 {
int TclPkgProvide(Tcl_Interp *interp, const char *name,
const char *version)
}
# TIP #268: The internally used new Require function is in slot 573.
# Removed in 9.0, converted to macro
#declare 274 {
# const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
# const char *version, int exact)
#}
declare 275 {
void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
}
# Removed in 9.0
#declare 276 {
# int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
#}
declare 277 {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
declare 278 {
TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
}
declare 279 {
|
| ︙ | ︙ | |||
1040 1041 1042 1043 1044 1045 1046 |
}
declare 288 {
void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 289 {
void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
| > | | < > | 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 |
}
declare 288 {
void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 289 {
void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
# Removed in 9.0:
#declare 290 {
# void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
#}
declare 291 {
int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes,
int flags)
}
declare 292 {
int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
int flags)
|
| ︙ | ︙ | |||
1083 1084 1085 1086 1087 1088 1089 |
declare 300 {
Tcl_ThreadId Tcl_GetCurrentThread(void)
}
declare 301 {
Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name)
}
declare 302 {
| | | 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 |
declare 300 {
Tcl_ThreadId Tcl_GetCurrentThread(void)
}
declare 301 {
Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name)
}
declare 302 {
const char *Tcl_GetEncodingName(Tcl_Encoding encoding)
}
declare 303 {
void Tcl_GetEncodingNames(Tcl_Interp *interp)
}
declare 304 {
int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
const void *tablePtr, int offset, const char *msg, int flags,
|
| ︙ | ︙ | |||
1123 1124 1125 1126 1127 1128 1129 |
declare 312 {
int Tcl_NumUtfChars(const char *src, int length)
}
declare 313 {
int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead,
int appendFlag)
}
| > | | < > > | | < > | 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 |
declare 312 {
int Tcl_NumUtfChars(const char *src, int length)
}
declare 313 {
int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead,
int appendFlag)
}
# Removed in 9.0:
#declare 314 {
# void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
#}
# Removed in 9.0:
#declare 315 {
# void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
#}
declare 316 {
int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name)
}
declare 317 {
Tcl_Obj *Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
const char *part2, Tcl_Obj *newValuePtr, int flags)
}
|
| ︙ | ︙ | |||
1159 1160 1161 1162 1163 1164 1165 |
declare 323 {
Tcl_UniChar Tcl_UniCharToUpper(int ch)
}
declare 324 {
int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
| | | | | | | 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 |
declare 323 {
Tcl_UniChar Tcl_UniCharToUpper(int ch)
}
declare 324 {
int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
const char *Tcl_UtfAtIndex(const char *src, int index)
}
declare 326 {
int Tcl_UtfCharComplete(const char *src, int length)
}
declare 327 {
int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
}
declare 328 {
const char *Tcl_UtfFindFirst(const char *src, int ch)
}
declare 329 {
const char *Tcl_UtfFindLast(const char *src, int ch)
}
declare 330 {
const char *Tcl_UtfNext(const char *src)
}
declare 331 {
const char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 332 {
int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
|
| ︙ | ︙ | |||
1210 1211 1212 1213 1214 1215 1216 |
}
declare 339 {
int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 {
char *Tcl_GetString(Tcl_Obj *objPtr)
}
| > | | < > > | | < > | 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 |
}
declare 339 {
int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 {
char *Tcl_GetString(Tcl_Obj *objPtr)
}
# Removed in 9.0
#declare 341 {
# const char *Tcl_GetDefaultEncodingDir(void)
#}
# Removed in 9.0
#declare 342 {
# void Tcl_SetDefaultEncodingDir(const char *path)
#}
declare 343 {
void Tcl_AlertNotifier(ClientData clientData)
}
declare 344 {
void Tcl_ServiceModeHook(int mode)
}
declare 345 {
|
| ︙ | ︙ | |||
1248 1249 1250 1251 1252 1253 1254 |
int Tcl_UniCharIsWordChar(int ch)
}
declare 352 {
int Tcl_UniCharLen(const Tcl_UniChar *uniStr)
}
declare 353 {
int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
| | > | | | < > | | | | | 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 |
int Tcl_UniCharIsWordChar(int ch)
}
declare 352 {
int Tcl_UniCharLen(const Tcl_UniChar *uniStr)
}
declare 353 {
int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
size_t numChars)
}
declare 354 {
char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr,
int uniLength, Tcl_DString *dsPtr)
}
declare 355 {
Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src,
int length, Tcl_DString *dsPtr)
}
declare 356 {
Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
int flags)
}
# Removed in 9.0:
#declare 357 {
# Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
# int count)
#}
declare 358 {
void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
declare 359 {
void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script,
const char *command, int length)
}
declare 360 {
int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes,
Tcl_Parse *parsePtr, int append, const char **termPtr)
}
declare 361 {
int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes,
int nested, Tcl_Parse *parsePtr)
}
declare 362 {
int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes,
Tcl_Parse *parsePtr)
}
declare 363 {
int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start,
int numBytes, Tcl_Parse *parsePtr, int append,
const char **termPtr)
}
declare 364 {
int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes,
Tcl_Parse *parsePtr, int append)
}
# These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir,
# Tcl_FSAccess and Tcl_FSStat
declare 365 {
char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 366 {
int Tcl_Chdir(const char *dirName)
}
declare 367 {
int Tcl_Access(const char *path, int mode)
}
declare 368 {
int Tcl_Stat(const char *path, struct stat *bufPtr)
}
declare 369 {
int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n)
}
declare 370 {
int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n)
}
declare 371 {
int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase)
}
declare 372 {
int Tcl_UniCharIsControl(int ch)
}
|
| ︙ | ︙ | |||
1404 1405 1406 1407 1408 1409 1410 |
declare 396 {
Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan)
}
declare 397 {
int Tcl_ChannelBuffered(Tcl_Channel chan)
}
declare 398 {
| | | 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 |
declare 396 {
Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan)
}
declare 397 {
int Tcl_ChannelBuffered(Tcl_Channel chan)
}
declare 398 {
const char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
}
declare 399 {
Tcl_ChannelTypeVersion Tcl_ChannelVersion(
const Tcl_ChannelType *chanTypePtr)
}
declare 400 {
Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc(
|
| ︙ | ︙ | |||
1483 1484 1485 1486 1487 1488 1489 |
void Tcl_ClearChannelHandlers(Tcl_Channel channel)
}
declare 418 {
int Tcl_IsChannelExisting(const char *channelName)
}
declare 419 {
int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
| | | | < > | | | < > | 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 |
void Tcl_ClearChannelHandlers(Tcl_Channel channel)
}
declare 418 {
int Tcl_IsChannelExisting(const char *channelName)
}
declare 419 {
int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
size_t numChars)
}
declare 420 {
int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
const Tcl_UniChar *uniPattern, int nocase)
}
#declare 421 {
# Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
#}
#declare 422 {
# Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
# const void *key, int *newPtr)
#}
declare 423 {
void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
const Tcl_HashKeyType *typePtr)
}
declare 424 {
void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
}
|
| ︙ | ︙ | |||
1544 1545 1546 1547 1548 1549 1550 |
# introduced in 8.4a3
declare 434 {
Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
# TIP#15 (math function introspection) dkf
| | | | | < > | | < > | 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 |
# introduced in 8.4a3
declare 434 {
Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
# TIP#15 (math function introspection) dkf
#declare 435 {
# int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
# int *numArgsPtr, Tcl_ValueType **argTypesPtr,
# Tcl_MathProc **procPtr, ClientData *clientDataPtr)
#}
#declare 436 {
# Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
#}
# TIP#36 (better access to 'subst') dkf
declare 437 {
Tcl_Obj *Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
# TIP#17 (virtual filesystem layer) vdarley
|
| ︙ | ︙ | |||
1613 1614 1615 1616 1617 1618 1619 |
int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)
}
declare 452 {
int Tcl_FSFileAttrsSet(Tcl_Interp *interp,
int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
}
declare 453 {
| | | 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 |
int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)
}
declare 452 {
int Tcl_FSFileAttrsSet(Tcl_Interp *interp,
int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
}
declare 453 {
const char *const *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
Tcl_Obj **objPtrRef)
}
declare 454 {
int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
}
declare 455 {
int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode)
|
| ︙ | ︙ | |||
1691 1692 1693 1694 1695 1696 1697 |
ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr)
}
declare 476 {
const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
Tcl_Obj *pathPtr)
}
declare 477 {
| | | 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 |
ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr)
}
declare 476 {
const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
Tcl_Obj *pathPtr)
}
declare 477 {
const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
}
declare 478 {
Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
}
# TIP#49 (detection of output buffering) akupries
declare 479 {
|
| ︙ | ︙ | |||
2363 2364 2365 2366 2367 2368 2369 | int hasResourceFile, int maxPathLen, char *libraryPath) } ############################################################################## # Public functions that are not accessible via the stubs table. | < < < | 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 |
int hasResourceFile, int maxPathLen, char *libraryPath)
}
##############################################################################
# Public functions that are not accessible via the stubs table.
export {
const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
int exact)
}
export {
const char *TclTomMathInitializeStubs(Tcl_Interp* interp,
const char* version, int epoch, int revision)
|
| ︙ | ︙ |
Changes to generic/tcl.h.
| ︙ | ︙ | |||
49 50 51 52 53 54 55 | * macosx/Tcl.xcode/default.pbxuser (not patchlevel) 1 LOC * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) * tools/tcl.hpj.in (not patchlevel, for windows installer) */ | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | * macosx/Tcl.xcode/default.pbxuser (not patchlevel) 1 LOC * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) * tools/tcl.hpj.in (not patchlevel, for windows installer) */ #define TCL_MAJOR_VERSION 9 #define TCL_MINOR_VERSION 0 #define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE #define TCL_RELEASE_SERIAL 0 #define TCL_VERSION "9.0" #define TCL_PATCH_LEVEL "9.0a0" /* * A special definition used to allow this header file to be included from * windows resource files so that they can obtain version information. * RC_INVOKED is defined by default by the windows RC tool. * * Resource compilers don't like all the C stuff, like typedefs and function * declarations, that occur below, so block them out. |
| ︙ | ︙ | |||
123 124 125 126 127 128 129 | */ #include <stdio.h> /* *---------------------------------------------------------------------------- * Support for functions with a variable number of arguments. | < < < < < < < < < < < < < | < | < | 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | */ #include <stdio.h> /* *---------------------------------------------------------------------------- * Support for functions with a variable number of arguments. */ #include <stdarg.h> #if defined(__GNUC__) && (__GNUC__ > 2) # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b))) # define TCL_NORETURN __attribute__ ((noreturn)) # define TCL_NORETURN1 __attribute__ ((noreturn)) # define TCL_NOINLINE __attribute__ ((noinline)) #else # define TCL_FORMAT_PRINTF(a,b) # if defined(_MSC_VER) && (_MSC_VER >= 1310) # define TCL_NORETURN _declspec(noreturn) # define TCL_NOINLINE __declspec(noinline) # else # define TCL_NORETURN /* nothing */ |
| ︙ | ︙ | |||
230 231 232 233 234 235 236 | * The convention is that a macro called BUILD_xxxx, where xxxx is the name of * a library we are building, is set on the compile line for sources that are * to be placed in the library. When this macro is set, the storage class will * be set to DLLEXPORT. At the end of the header file, the storage class will * be reset to DLLIMPORT. */ | < | < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < | 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 | * The convention is that a macro called BUILD_xxxx, where xxxx is the name of * a library we are building, is set on the compile line for sources that are * to be placed in the library. When this macro is set, the storage class will * be set to DLLEXPORT. At the end of the header file, the storage class will * be reset to DLLIMPORT. */ #ifdef BUILD_tcl # define TCLAPI extern DLLEXPORT #else # define TCLAPI extern DLLIMPORT #endif /* * Miscellaneous declarations. */ typedef void *ClientData; /* * Darwin specific configure overrides (to support fat compiles, where * configure runs only once for multiple architectures): */ #ifdef __APPLE__ |
| ︙ | ︙ | |||
494 495 496 497 498 499 500 | * "real" definition in tclInt.h. * * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc. * Instead, they set a Tcl_Obj member in the "real" structure that can be * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 | * "real" definition in tclInt.h. * * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc. * Instead, they set a Tcl_Obj member in the "real" structure that can be * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ typedef struct Tcl_Interp Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion; typedef struct Tcl_Command_ *Tcl_Command; typedef struct Tcl_Condition_ *Tcl_Condition; typedef struct Tcl_Dict_ *Tcl_Dict; |
| ︙ | ︙ | |||
675 676 677 678 679 680 681 | #define TCL_OK 0 #define TCL_ERROR 1 #define TCL_RETURN 2 #define TCL_BREAK 3 #define TCL_CONTINUE 4 | < < < < < < < < < < < < < < < < < < > > | | | 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 | #define TCL_OK 0 #define TCL_ERROR 1 #define TCL_RETURN 2 #define TCL_BREAK 3 #define TCL_CONTINUE 4 /* *---------------------------------------------------------------------------- * Flags to control what substitutions are performed by Tcl_SubstObj(): */ #define TCL_SUBST_COMMANDS 001 #define TCL_SUBST_VARIABLES 002 #define TCL_SUBST_BACKSLASHES 004 #define TCL_SUBST_ALL 007 /* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the function types declared below. */ struct Tcl_Obj; typedef struct Tcl_Obj Tcl_Value; /* *---------------------------------------------------------------------------- * Function types defined by Tcl: */ typedef int (Tcl_AppInitProc) (Tcl_Interp *interp); typedef int (Tcl_AsyncProc) (ClientData clientData, Tcl_Interp *interp, int code); typedef void (Tcl_ChannelProc) (ClientData clientData, int mask); typedef void (Tcl_CloseProc) (ClientData data); typedef void (Tcl_CmdDeleteProc) (ClientData clientData); typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp, int argc, const char *argv[]); typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, ClientData cmdClientData, int argc, const char *argv[]); typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src, |
| ︙ | ︙ | |||
748 749 750 751 752 753 754 | typedef void (Tcl_FileProc) (ClientData clientData, int mask); typedef void (Tcl_FileFreeProc) (ClientData clientData); typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); typedef void (Tcl_FreeProc) (char *blockPtr); typedef void (Tcl_IdleProc) (ClientData clientData); typedef void (Tcl_InterpDeleteProc) (ClientData clientData, Tcl_Interp *interp); | < < | | 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 | typedef void (Tcl_FileProc) (ClientData clientData, int mask); typedef void (Tcl_FileFreeProc) (ClientData clientData); typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); typedef void (Tcl_FreeProc) (char *blockPtr); typedef void (Tcl_IdleProc) (ClientData clientData); typedef void (Tcl_InterpDeleteProc) (ClientData clientData, Tcl_Interp *interp); typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp); typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan, char *address, int port); typedef void (Tcl_TimerProc) (ClientData clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *part1, const char *part2, int flags); typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); typedef void (Tcl_DeleteFileHandlerProc) (int fd); typedef void (Tcl_AlertNotifierProc) (ClientData clientData); typedef void (Tcl_ServiceModeHookProc) (int mode); |
| ︙ | ︙ | |||
860 861 862 863 864 865 866 | void Tcl_IncrRefCount(Tcl_Obj *objPtr); void Tcl_DecrRefCount(Tcl_Obj *objPtr); int Tcl_IsShared(Tcl_Obj *objPtr); /* *---------------------------------------------------------------------------- | | < | < < < < < < < < | | 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 | void Tcl_IncrRefCount(Tcl_Obj *objPtr); void Tcl_DecrRefCount(Tcl_Obj *objPtr); int Tcl_IsShared(Tcl_Obj *objPtr); /* *---------------------------------------------------------------------------- * The following type contains the state needed by Tcl_SaveResult. This * structure is typically allocated on the stack. */ typedef Tcl_Obj *Tcl_SavedResult; /* *---------------------------------------------------------------------------- * The following definitions support Tcl's namespace facility. Note: the first * five fields must match exactly the fields in a Namespace structure (see * tclInt.h). */ |
| ︙ | ︙ | |||
998 999 1000 1001 1002 1003 1004 |
char staticSpace[TCL_DSTRING_STATIC_SIZE];
/* Space to use in common case where string is
* small. */
} Tcl_DString;
#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
| < | 789 790 791 792 793 794 795 796 797 798 799 800 801 802 |
char staticSpace[TCL_DSTRING_STATIC_SIZE];
/* Space to use in common case where string is
* small. */
} Tcl_DString;
#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
/*
* Definitions for the maximum number of digits of precision that may be
* specified in the "tcl_precision" variable, and the number of bytes of
* buffer space required by Tcl_PrintDouble.
*/
|
| ︙ | ︙ | |||
1117 1118 1119 1120 1121 1122 1123 | */ #define TCL_TRACE_RENAME 0x2000 #define TCL_TRACE_DELETE 0x4000 #define TCL_ALLOW_INLINE_COMPILATION 0x20000 | < < < < < < < < < < < | 907 908 909 910 911 912 913 914 915 916 917 918 919 920 | */ #define TCL_TRACE_RENAME 0x2000 #define TCL_TRACE_DELETE 0x4000 #define TCL_ALLOW_INLINE_COMPILATION 0x20000 /* * Types for linked variables: */ #define TCL_LINK_INT 1 #define TCL_LINK_DOUBLE 2 #define TCL_LINK_BOOLEAN 3 |
| ︙ | ︙ | |||
1397 1398 1399 1400 1401 1402 1403 |
*/
typedef struct Tcl_Time {
long sec; /* Seconds. */
long usec; /* Microseconds. */
} Tcl_Time;
| | | | 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 |
*/
typedef struct Tcl_Time {
long sec; /* Seconds. */
long usec; /* Microseconds. */
} Tcl_Time;
typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr);
typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr);
/*
* TIP #233 (Virtualized Time)
*/
typedef void (Tcl_GetTimeProc) (Tcl_Time *timebuf, ClientData clientData);
typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);
|
| ︙ | ︙ | |||
1472 1473 1474 1475 1476 1477 1478 | typedef int (Tcl_DriverCloseProc) (ClientData instanceData, Tcl_Interp *interp); typedef int (Tcl_DriverClose2Proc) (ClientData instanceData, Tcl_Interp *interp, int flags); typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf, int toRead, int *errorCodePtr); typedef int (Tcl_DriverOutputProc) (ClientData instanceData, | | | | 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 | typedef int (Tcl_DriverCloseProc) (ClientData instanceData, Tcl_Interp *interp); typedef int (Tcl_DriverClose2Proc) (ClientData instanceData, Tcl_Interp *interp, int flags); typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf, int toRead, int *errorCodePtr); typedef int (Tcl_DriverOutputProc) (ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr); typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset, int mode, int *errorCodePtr); typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value); typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask); typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData, int direction, ClientData *handlePtr); typedef int (Tcl_DriverFlushProc) (ClientData instanceData); typedef int (Tcl_DriverHandlerProc) (ClientData instanceData, int interestMask); |
| ︙ | ︙ | |||
1670 1671 1672 1673 1674 1675 1676 | /* We have to declare the utime structure here. */ struct utimbuf; typedef int (Tcl_FSUtimeProc) (Tcl_Obj *pathPtr, struct utimbuf *tval); typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint); typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); | | | 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 | /* We have to declare the utime structure here. */ struct utimbuf; typedef int (Tcl_FSUtimeProc) (Tcl_Obj *pathPtr, struct utimbuf *tval); typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint); typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); typedef const char *const * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); typedef Tcl_Obj * (Tcl_FSLinkProc) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType); typedef int (Tcl_FSLoadFileProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); |
| ︙ | ︙ | |||
2379 2380 2381 2382 2383 2384 2385 | /* *---------------------------------------------------------------------------- * The following constant is used to test for older versions of Tcl in the * stubs tables. */ | | > | | > > > > > > < < < < > > | > > > > | | | < | 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 |
/*
*----------------------------------------------------------------------------
* The following constant is used to test for older versions of Tcl in the
* stubs tables.
*/
#define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *))
/*
* The following function is required to be defined in all stubs aware
* extensions. The function is actually implemented in the stub library, not
* the main Tcl library, although there is a trivial implementation in the
* main library in case an extension is statically linked into an application.
*/
const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version,
int exact, int magic);
const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
const char *version, int epoch, int revision);
#ifdef USE_TCL_STUBS
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
# define Tcl_InitStubs(interp, version, exact) \
(Tcl_InitStubs)(interp, version, \
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
TCL_STUB_MAGIC)
#else
# define Tcl_InitStubs(interp, version, exact) \
(Tcl_InitStubs)(interp, TCL_PATCH_LEVEL, \
1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
TCL_STUB_MAGIC)
#endif
#else
#define Tcl_InitStubs(interp, version, exact) \
Tcl_PkgInitStubsCheck(interp, version, \
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
#endif
/*
* Public functions that are not accessible via the stubs table.
* Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
*/
#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
((Tcl_CreateInterp)()))
TCLAPI void Tcl_FindExecutable(const char *argv0);
TCLAPI void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc);
TCLAPI void Tcl_MainEx(int argc, char **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#if defined(_WIN32) && defined(UNICODE)
TCLAPI void Tcl_MainExW(int argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
TCLAPI const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
const char *version, int exact);
TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
/*
*----------------------------------------------------------------------------
* Include the public function declarations that are accessible via the stubs
* table.
*/
#include "tclDecls.h"
/*
* Include platform specific public function declarations that are accessible
* via the stubs table.
*/
#if defined(BUILD_tcl)
# undef TCLAPI
# define TCLAPI MODULE_SCOPE
#endif
|
| ︙ | ︙ | |||
2533 2534 2535 2536 2537 2538 2539 |
Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
# undef Tcl_NewByteArrayObj
# define Tcl_NewByteArrayObj(bytes, len) \
Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
# undef Tcl_NewDoubleObj
# define Tcl_NewDoubleObj(val) \
Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
| < < < | 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 |
Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
# undef Tcl_NewByteArrayObj
# define Tcl_NewByteArrayObj(bytes, len) \
Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
# undef Tcl_NewDoubleObj
# define Tcl_NewDoubleObj(val) \
Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
# undef Tcl_NewListObj
# define Tcl_NewListObj(objc, objv) \
Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
# undef Tcl_NewLongObj
# define Tcl_NewLongObj(val) \
Tcl_DbNewLongObj(val, __FILE__, __LINE__)
# undef Tcl_NewObj
|
| ︙ | ︙ | |||
2571 2572 2573 2574 2575 2576 2577 | : (h)->key.string)) /* * Macros to use for clients to use to invoke find and create functions for * hash tables: */ | < < | 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 | : (h)->key.string)) /* * Macros to use for clients to use to invoke find and create functions for * hash tables: */ #define Tcl_FindHashEntry(tablePtr, key) \ (*((tablePtr)->findProc))(tablePtr, (const char *)(key)) #define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ (*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr) /* *---------------------------------------------------------------------------- * Macros that eliminate the overhead of the thread synchronization functions * when compiling without thread support. |
| ︙ | ︙ | |||
2599 2600 2601 2602 2603 2604 2605 | #define Tcl_ConditionNotify(condPtr) #undef Tcl_ConditionWait #define Tcl_ConditionWait(condPtr, mutexPtr, timePtr) #undef Tcl_ConditionFinalize #define Tcl_ConditionFinalize(condPtr) #endif /* TCL_THREADS */ | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 | #define Tcl_ConditionNotify(condPtr) #undef Tcl_ConditionWait #define Tcl_ConditionWait(condPtr, mutexPtr, timePtr) #undef Tcl_ConditionFinalize #define Tcl_ConditionFinalize(condPtr) #endif /* TCL_THREADS */ #endif /* RC_INVOKED */ /* * end block for C++ */ #ifdef __cplusplus |
| ︙ | ︙ |
Changes to generic/tclBasic.c.
| ︙ | ︙ | |||
33 34 35 36 37 38 39 | #if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024) # define IEEE_FLOATING_POINT /* Largest odd integer that can be represented exactly in a double */ # define MAX_EXACT 9007199254740991.0 #endif | < < < < < < < < < < < < | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | #if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024) # define IEEE_FLOATING_POINT /* Largest odd integer that can be represented exactly in a double */ # define MAX_EXACT 9007199254740991.0 #endif /* * This is the script cancellation struct and hash table. The hash table is * used to keep track of the information necessary to process script * cancellation requests, including the original interp, asynchronous handler * tokens (created by Tcl_AsyncCreate), and the clientData and flags arguments * passed to Tcl_CancelEval on a per-interp basis. The cancelLock mutex is * used for protecting calls to Tcl_CancelEval as well as protecting access to |
| ︙ | ︙ | |||
126 127 128 129 130 131 132 | static Tcl_ObjCmdProc ExprWideFunc; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static Tcl_NRPostProc NRCommand; | < < | 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | static Tcl_ObjCmdProc ExprWideFunc; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static Tcl_NRPostProc NRCommand; static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); static inline Command * TEOV_LookupCmdFromObj(Tcl_Interp *interp, |
| ︙ | ︙ | |||
199 200 201 202 203 204 205 |
/*
* Commands in the generic core.
*/
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE},
{"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE},
{"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE},
| < < < | 185 186 187 188 189 190 191 192 193 194 195 196 197 198 |
/*
* Commands in the generic core.
*/
{"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},
|
| ︙ | ︙ | |||
507 508 509 510 511 512 513 |
* (whose name is ""; an alias is "::"). This also initializes the Tcl
* object type table and other object management code.
*/
iPtr = ckalloc(sizeof(Interp));
interp = (Tcl_Interp *) iPtr;
| | > > | > < | | 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 |
* (whose name is ""; an alias is "::"). This also initializes the Tcl
* object type table and other object management code.
*/
iPtr = ckalloc(sizeof(Interp));
interp = (Tcl_Interp *) iPtr;
iPtr->legacyResult = NULL;
/* Special invalid value: Any attempt to free the legacy result
* will cause a crash. */
iPtr->legacyFreeProc = (void (*) (void))-1;
iPtr->errorLine = 0;
iPtr->stubTable = &tclStubs;
iPtr->objResultPtr = Tcl_NewObj();
Tcl_IncrRefCount(iPtr->objResultPtr);
iPtr->handle = TclHandleCreate(iPtr);
iPtr->globalNsPtr = NULL;
iPtr->hiddenCmdTablePtr = NULL;
iPtr->interpInfo = NULL;
iPtr->optimizer = TclOptimizeBytecode;
iPtr->numLevels = 0;
iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
iPtr->framePtr = NULL; /* Initialise as soon as :: is available */
iPtr->varFramePtr = NULL; /* Initialise as soon as :: is available */
/*
|
| ︙ | ︙ | |||
567 568 569 570 571 572 573 |
Tcl_IncrRefCount(iPtr->ecVar);
iPtr->returnLevel = 1;
iPtr->returnCode = TCL_OK;
iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */
iPtr->lookupNsPtr = NULL;
| < < < < | 552 553 554 555 556 557 558 559 560 561 562 563 564 565 |
Tcl_IncrRefCount(iPtr->ecVar);
iPtr->returnLevel = 1;
iPtr->returnCode = TCL_OK;
iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */
iPtr->lookupNsPtr = NULL;
Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
iPtr->packageUnknown = NULL;
/* TIP #268 */
#if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)
if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
iPtr->packagePrefer = PKG_PREFER_STABLE;
|
| ︙ | ︙ | |||
599 600 601 602 603 604 605 |
iPtr->activeCmdTracePtr = NULL;
iPtr->activeInterpTracePtr = NULL;
iPtr->assocData = NULL;
iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */
iPtr->emptyObjPtr = Tcl_NewObj();
/* Another empty object. */
Tcl_IncrRefCount(iPtr->emptyObjPtr);
| < | 580 581 582 583 584 585 586 587 588 589 590 591 592 593 |
iPtr->activeCmdTracePtr = NULL;
iPtr->activeInterpTracePtr = NULL;
iPtr->assocData = NULL;
iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */
iPtr->emptyObjPtr = Tcl_NewObj();
/* Another empty object. */
Tcl_IncrRefCount(iPtr->emptyObjPtr);
iPtr->threadId = Tcl_GetCurrentThread();
/* TIP #378 */
#ifdef TCL_INTERP_DEBUG_FRAME
iPtr->flags |= INTERP_DEBUG_FRAME;
#else
if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {
|
| ︙ | ︙ | |||
709 710 711 712 713 714 715 |
statsPtr->numLiteralsCreated = 0;
statsPtr->totalLitStringBytes = 0.0;
statsPtr->currentLitStringBytes = 0.0;
memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
#endif /* TCL_COMPILE_STATS */
| < < < < < < | > > | 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 |
statsPtr->numLiteralsCreated = 0;
statsPtr->totalLitStringBytes = 0.0;
statsPtr->currentLitStringBytes = 0.0;
memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
#endif /* TCL_COMPILE_STATS */
/*
* Initialize the ensemble error message rewriting support.
*/
iPtr->ensembleRewrite.sourceObjs = NULL;
iPtr->ensembleRewrite.numRemovedObjs = 0;
iPtr->ensembleRewrite.numInsertedObjs = 0;
/*
* TIP#143: Initialise the resource limit support.
*/
TclInitLimitSupport(interp);
|
| ︙ | ︙ | |||
936 937 938 939 940 941 942 |
Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize",
Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY);
/*
* Set up other variables such as tcl_version and tcl_library
*/
| | | | 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 |
Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize",
Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY);
/*
* Set up other variables such as tcl_version and tcl_library
*/
Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
Tcl_TraceVar2(interp, "tcl_precision", NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
TclPrecTraceProc, NULL);
TclpSetVariables(interp);
#ifdef TCL_THREADS
/*
|
| ︙ | ︙ | |||
1508 1509 1510 1511 1512 1513 1514 |
/*
* Free up the result *after* deleting variables, since variable deletion
* could have transferred ownership of the result string to Tcl.
*/
Tcl_FreeResult(interp);
| < | 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 |
/*
* Free up the result *after* deleting variables, since variable deletion
* could have transferred ownership of the result string to Tcl.
*/
Tcl_FreeResult(interp);
Tcl_DecrRefCount(iPtr->objResultPtr);
iPtr->objResultPtr = NULL;
Tcl_DecrRefCount(iPtr->ecVar);
if (iPtr->errorCode) {
Tcl_DecrRefCount(iPtr->errorCode);
iPtr->errorCode = NULL;
}
|
| ︙ | ︙ | |||
1530 1531 1532 1533 1534 1535 1536 |
Tcl_DecrRefCount(iPtr->upLiteral);
Tcl_DecrRefCount(iPtr->callLiteral);
Tcl_DecrRefCount(iPtr->innerLiteral);
Tcl_DecrRefCount(iPtr->innerContext);
if (iPtr->returnOpts) {
Tcl_DecrRefCount(iPtr->returnOpts);
}
| < < < < | 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 |
Tcl_DecrRefCount(iPtr->upLiteral);
Tcl_DecrRefCount(iPtr->callLiteral);
Tcl_DecrRefCount(iPtr->innerLiteral);
Tcl_DecrRefCount(iPtr->innerContext);
if (iPtr->returnOpts) {
Tcl_DecrRefCount(iPtr->returnOpts);
}
TclFreePackageInfo(iPtr);
while (iPtr->tracePtr != NULL) {
Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
}
if (iPtr->execEnvPtr != NULL) {
TclDeleteExecEnv(iPtr->execEnvPtr);
}
|
| ︙ | ︙ | |||
2251 2252 2253 2254 2255 2256 2257 |
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
TclInvalidateNsPath(nsPtr);
if (!isNew) {
cmdPtr = Tcl_GetHashValue(hPtr);
| < < < < < < < < < < < < < < < < < < < | | 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 |
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
TclInvalidateNsPath(nsPtr);
if (!isNew) {
cmdPtr = Tcl_GetHashValue(hPtr);
/*
* Command already exists; delete it. Be careful to preserve any
* existing import links so we can restore them down below. That way,
* you can redefine a command and its import status will remain
* intact.
*/
cmdPtr->refCount++;
if (cmdPtr->importRefPtr) {
|
| ︙ | ︙ | |||
2425 2426 2427 2428 2429 2430 2431 | * "Wrapper" Tcl_CmdProc used to call an existing object-based * Tcl_ObjCmdProc if no string-based function exists for a command. A * pointer to this function is stored as the Tcl_CmdProc in a Command * structure. It simply turns around and calls the object Tcl_ObjCmdProc * in the Command structure. * * Results: | | | 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 | * "Wrapper" Tcl_CmdProc used to call an existing object-based * Tcl_ObjCmdProc if no string-based function exists for a command. A * pointer to this function is stored as the Tcl_CmdProc in a Command * structure. It simply turns around and calls the object Tcl_ObjCmdProc * in the Command structure. * * Results: * A standard Tcl result value. * * Side effects: * Besides those side effects of the called Tcl_ObjCmdProc, * TclInvokeObjectCommand allocates and frees storage. * *---------------------------------------------------------------------- */ |
| ︙ | ︙ | |||
2465 2466 2467 2468 2469 2470 2471 |
if (cmdPtr->objProc != NULL) {
result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv);
} else {
result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
cmdPtr->objClientData, argc, objv);
}
| < < < < < < < | 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 |
if (cmdPtr->objProc != NULL) {
result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv);
} else {
result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
cmdPtr->objClientData, argc, objv);
}
/*
* Decrement the ref counts for the argument objects created above, then
* free the objv array if malloc'ed storage was used.
*/
for (i = 0; i < argc; i++) {
objPtr = objv[i];
|
| ︙ | ︙ | |||
3405 3406 3407 3408 3409 3410 3411 |
ckfree(cmdPtr);
}
}
/*
*----------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 |
ckfree(cmdPtr);
}
}
/*
*----------------------------------------------------------------------
*
* TclInterpReady --
*
* Check if an interpreter is ready to eval commands or scripts, i.e., if
* it was not deleted and if the nesting level is not too high.
*
* Results:
* The return value is TCL_OK if it the interpreter is ready, TCL_ERROR
* otherwise.
*
* Side effects:
* The interpreter's result is cleared.
*
*----------------------------------------------------------------------
*/
int
TclInterpReady(
Tcl_Interp *interp)
{
register Interp *iPtr = (Interp *) interp;
/*
* Reset the interpreter's result and clear out any previous error
* information.
*/
Tcl_ResetResult(interp);
/*
* If the interpreter has been deleted, return an error.
*/
|
| ︙ | ︙ | |||
4214 4215 4216 4217 4218 4219 4220 |
lookupNsPtr = iPtr->globalNsPtr;
} else {
/*
* TCL_EVAL_INVOKE was not set: clear rewrite rules
*/
| | | 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 |
lookupNsPtr = iPtr->globalNsPtr;
} else {
/*
* TCL_EVAL_INVOKE was not set: clear rewrite rules
*/
iPtr->ensembleRewrite.sourceObjs = NULL;
if (flags & TCL_EVAL_GLOBAL) {
TEOV_SwitchVarFrame(interp);
lookupNsPtr = iPtr->globalNsPtr;
}
}
|
| ︙ | ︙ | |||
4362 4363 4364 4365 4366 4367 4368 |
TclNRRunCallbacks(
Tcl_Interp *interp,
int result,
struct NRE_callback *rootPtr)
/* All callbacks down to rootPtr not inclusive
* are to be run. */
{
| < < < < < < < < < < < < < < < | 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 |
TclNRRunCallbacks(
Tcl_Interp *interp,
int result,
struct NRE_callback *rootPtr)
/* All callbacks down to rootPtr not inclusive
* are to be run. */
{
NRE_callback *callbackPtr;
Tcl_NRPostProc *procPtr;
while (TOP_CB(interp) != rootPtr) {
callbackPtr = TOP_CB(interp);
procPtr = callbackPtr->procPtr;
TOP_CB(interp) = callbackPtr->nextPtr;
result = procPtr(callbackPtr->data, interp, result);
TCLNR_FREE(interp, callbackPtr);
}
|
| ︙ | ︙ | |||
4836 4837 4838 4839 4840 4841 4842 |
* evaluate and concatenate. */
int count) /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
{
return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
NULL, NULL);
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 |
* evaluate and concatenate. */
int count) /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
{
return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
NULL, NULL);
}
/*
*----------------------------------------------------------------------
*
* Tcl_EvalEx, TclEvalEx --
*
* This function evaluates a Tcl script without using the compiler or
|
| ︙ | ︙ | |||
5821 5822 5823 5824 5825 5826 5827 |
return;
}
}
/*
*----------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 |
return;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_EvalObjEx, TclEvalObjEx --
*
* Execute Tcl commands stored in a Tcl object. These commands are
* compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is
* specified.
*
* If the flag TCL_EVAL_DIRECT is passed in, the value of invoker
|
| ︙ | ︙ | |||
6278 6279 6280 6281 6282 6283 6284 |
*ptr = 0;
} else {
exprPtr = Tcl_NewStringObj(exprstring, -1);
Tcl_IncrRefCount(exprPtr);
result = Tcl_ExprLongObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
| < < < | 5731 5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 |
*ptr = 0;
} else {
exprPtr = Tcl_NewStringObj(exprstring, -1);
Tcl_IncrRefCount(exprPtr);
result = Tcl_ExprLongObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
}
return result;
}
int
Tcl_ExprDouble(
Tcl_Interp *interp, /* Context in which to evaluate the
|
| ︙ | ︙ | |||
6307 6308 6309 6310 6311 6312 6313 |
*ptr = 0.0;
} else {
exprPtr = Tcl_NewStringObj(exprstring, -1);
Tcl_IncrRefCount(exprPtr);
result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
/* Discard the expression object. */
| < < < | 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 |
*ptr = 0.0;
} else {
exprPtr = Tcl_NewStringObj(exprstring, -1);
Tcl_IncrRefCount(exprPtr);
result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
/* Discard the expression object. */
}
return result;
}
int
Tcl_ExprBoolean(
Tcl_Interp *interp, /* Context in which to evaluate the
|
| ︙ | ︙ | |||
6335 6336 6337 6338 6339 6340 6341 |
} else {
int result;
Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1);
Tcl_IncrRefCount(exprPtr);
result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
| < < < < < < < < | 5782 5783 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 |
} else {
int result;
Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1);
Tcl_IncrRefCount(exprPtr);
result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
return result;
}
}
/*
*--------------------------------------------------------------
*
|
| ︙ | ︙ | |||
6657 6658 6659 6660 6661 6662 6663 |
code = Tcl_ExprObj(interp, exprObj, &resultPtr);
Tcl_DecrRefCount(exprObj);
if (code == TCL_OK) {
Tcl_SetObjResult(interp, resultPtr);
Tcl_DecrRefCount(resultPtr);
}
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 6111 |
code = Tcl_ExprObj(interp, exprObj, &resultPtr);
Tcl_DecrRefCount(exprObj);
if (code == TCL_OK) {
Tcl_SetObjResult(interp, resultPtr);
Tcl_DecrRefCount(resultPtr);
}
}
return code;
}
/*
*----------------------------------------------------------------------
*
* Tcl_AddErrorInfo --
*
* Add information to the errorInfo field that describes the current
|
| ︙ | ︙ | |||
6726 6727 6728 6729 6730 6731 6732 |
#undef Tcl_AddErrorInfo
void
Tcl_AddErrorInfo(
Tcl_Interp *interp, /* Interpreter to which error information
* pertains. */
const char *message) /* Message to record. */
{
| | | | | < | < | < | < < > > > > < < < < < < < < < < < | < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 6178 6179 6180 6181 6182 6183 6184 6185 6186 6187 6188 6189 6190 6191 6192 6193 6194 6195 6196 6197 6198 6199 |
#undef Tcl_AddErrorInfo
void
Tcl_AddErrorInfo(
Tcl_Interp *interp, /* Interpreter to which error information
* pertains. */
const char *message) /* Message to record. */
{
Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj(message, -1));
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendObjToErrorInfo --
*
* Add a Tcl_Obj value to the errorInfo field that describes the current
* error.
*
* Results:
* None.
*
* Side effects:
* The value of the Tcl_obj is appended to the errorInfo field. If we are
* just starting to log an error, errorInfo is initialized from the error
* message in the interpreter's result.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendObjToErrorInfo(
Tcl_Interp *interp, /* Interpreter to which error information
* pertains. */
Tcl_Obj *objPtr) /* Message to record. */
{
int length;
register Interp *iPtr = (Interp *) interp;
const char *message = TclGetStringFromObj(objPtr, &length);
Tcl_IncrRefCount(objPtr);
/*
* If we are just starting to log an error, errorInfo is initialized from
* the error message in the interpreter's result.
*/
iPtr->flags |= ERR_LEGACY_COPY;
if (iPtr->errorInfo == NULL) {
iPtr->errorInfo = iPtr->objResultPtr;
Tcl_IncrRefCount(iPtr->errorInfo);
if (!iPtr->errorCode) {
Tcl_SetErrorCode(interp, "NONE", NULL);
}
}
/*
* Now append "message" to the end of errorInfo.
*/
if (length != 0) {
if (Tcl_IsShared(iPtr->errorInfo)) {
Tcl_DecrRefCount(iPtr->errorInfo);
iPtr->errorInfo = Tcl_DuplicateObj(iPtr->errorInfo);
Tcl_IncrRefCount(iPtr->errorInfo);
}
Tcl_AppendToObj(iPtr->errorInfo, message, length);
}
Tcl_DecrRefCount(objPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetRecursionLimit --
*
|
| ︙ | ︙ |
Changes to generic/tclBinary.c.
| ︙ | ︙ | |||
190 191 192 193 194 195 196 | /* * The following structure is the internal rep for a ByteArray object. Keeps * track of how much memory has been used and how much has been allocated for * the byte array to enable growing and shrinking of the ByteArray object with * fewer mallocs. */ | | | 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 |
/*
* The following structure is the internal rep for a ByteArray object. Keeps
* track of how much memory has been used and how much has been allocated for
* the byte array to enable growing and shrinking of the ByteArray object with
* fewer mallocs.
*/
typedef struct {
int used; /* The number of bytes used in the byte
* array. */
int allocated; /* The amount of space actually allocated
* minus 1 byte. */
unsigned char bytes[1]; /* The array of bytes. The actual size of this
* field depends on the 'allocated' field
* above. */
|
| ︙ | ︙ | |||
2356 2357 2358 2359 2360 2361 2362 |
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) {
| | | | 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 |
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_GetIndexFromObjStruct(interp, objv[i], optStrings,
sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case OPT_STRICT:
strict = 1;
break;
}
|
| ︙ | ︙ | |||
2478 2479 2480 2481 2482 2483 2484 |
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) {
| | | | 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 |
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_GetIndexFromObjStruct(interp, objv[i], optStrings,
sizeof(char *), "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;
}
|
| ︙ | ︙ | |||
2698 2699 2700 2701 2702 2703 2704 |
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) {
| | | | 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 |
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_GetIndexFromObjStruct(interp, objv[i], optStrings,
sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case OPT_STRICT:
strict = 1;
break;
}
|
| ︙ | ︙ | |||
2862 2863 2864 2865 2866 2867 2868 |
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) {
| | | | 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 |
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_GetIndexFromObjStruct(interp, objv[i], optStrings,
sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case OPT_STRICT:
strict = 1;
break;
}
|
| ︙ | ︙ |
Changes to generic/tclCkalloc.c.
| ︙ | ︙ | |||
29 30 31 32 33 34 35 | #ifdef TCL_MEM_DEBUG /* * One of the following structures is allocated each time the * "memory tag" command is invoked, to hold the current tag. */ | | | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
#ifdef TCL_MEM_DEBUG
/*
* One of the following structures is allocated each time the
* "memory tag" command is invoked, to hold the current tag.
*/
typedef struct {
int 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;
|
| ︙ | ︙ |
Changes to generic/tclClock.c.
| ︙ | ︙ | |||
87 88 89 90 91 92 93 |
"year"
};
/*
* Structure containing the client data for [clock]
*/
| | | | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 |
"year"
};
/*
* Structure containing the client data for [clock]
*/
typedef struct {
int refCount; /* Number of live references. */
Tcl_Obj **literals; /* Pool of object literals. */
} ClockClientData;
/*
* Structure containing the fields used in [clock format] and [clock scan]
*/
typedef struct {
Tcl_WideInt seconds; /* Time expressed in seconds from the Posix
* epoch */
Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds
* from the Posix epoch */
int tzOffset; /* Time zone offset in seconds east of
* Greenwich */
Tcl_Obj *tzName; /* Time zone name */
|
| ︙ | ︙ |
Changes to generic/tclCmdAH.c.
| ︙ | ︙ | |||
131 132 133 134 135 136 137 |
}
return TCL_BREAK;
}
/*
*----------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 131 132 133 134 135 136 137 138 139 140 141 142 143 144 |
}
return TCL_BREAK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_CatchObjCmd --
*
* This object-based procedure is invoked to process the "catch" Tcl
* command. See the user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
|
| ︙ | ︙ | |||
530 531 532 533 534 535 536 |
ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
| | | | 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 |
ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case ENC_CONVERTTO:
case ENC_CONVERTFROM: {
Tcl_Obj *data;
|
| ︙ | ︙ |
Changes to generic/tclCmdIL.c.
| ︙ | ︙ | |||
52 53 54 55 56 57 58 | /* * The "lsort" command needs to pass certain information down to the function * that compares two list elements, and the comparison function needs to pass * success or failure information back up to the top-level "lsort" command. * The following structure is used to pass this information. */ | | | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 |
/*
* The "lsort" command needs to pass certain information down to the function
* that compares two list elements, and the comparison function needs to pass
* success or failure information back up to the top-level "lsort" command.
* The following structure is used to pass this information.
*/
typedef struct {
int isIncreasing; /* Nonzero means sort in increasing order. */
int sortMode; /* The sort mode. One of SORTMODE_* values
* defined below. */
Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode is
* SORTMODE_COMMAND. Pre-initialized to hold
* base of command. */
int *indexv; /* If the -index option was specified, this
|
| ︙ | ︙ | |||
2986 2987 2988 2989 2990 2991 2992 |
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern");
return TCL_ERROR;
}
for (i = 1; i < objc-2; i++) {
| | | | 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 |
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern");
return TCL_ERROR;
}
for (i = 1; i < objc-2; i++) {
if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
sizeof(char *), "option", 0, &index) != TCL_OK) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
result = TCL_ERROR;
goto done;
}
switch ((enum options) index) {
|
| ︙ | ︙ | |||
3716 3717 3718 3719 3720 3721 3722 |
cmdPtr = NULL;
indices = 0;
group = 0;
groupSize = 1;
groupOffset = 0;
indexPtr = NULL;
for (i = 1; i < objc-1; i++) {
| | | | 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 |
cmdPtr = NULL;
indices = 0;
group = 0;
groupSize = 1;
groupOffset = 0;
indexPtr = NULL;
for (i = 1; i < objc-1; i++) {
if (Tcl_GetIndexFromObjStruct(interp, objv[i], switches,
sizeof(char *), "option", 0, &index) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
goto done2;
}
switch ((enum Lsort_Switches) index) {
case LSORT_ASCII:
sortInfo.sortMode = SORTMODE_ASCII;
break;
|
| ︙ | ︙ |
Changes to generic/tclCmdMZ.c.
| ︙ | ︙ | |||
331 332 333 334 335 336 337 |
/*
* If inlining, the interpreter's object result remains an
* empty list, otherwise set it to an integer object w/ value
* 0.
*/
if (!doinline) {
| | | 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 |
/*
* If inlining, the interpreter's object result remains an
* empty list, otherwise set it to an integer object w/ value
* 0.
*/
if (!doinline) {
Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
}
return TCL_OK;
}
break;
}
/*
|
| ︙ | ︙ | |||
453 454 455 456 457 458 459 |
* if -all wasn't specified, otherwise it's all-1 (the number of times
* through the while - 1).
*/
if (doinline) {
Tcl_SetObjResult(interp, resultPtr);
} else {
| | | 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 |
* if -all wasn't specified, otherwise it's all-1 (the number of times
* through the while - 1).
*/
if (doinline) {
Tcl_SetObjResult(interp, resultPtr);
} else {
Tcl_SetObjResult(interp, Tcl_NewLongObj(all ? all-1 : 1));
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
590 591 592 593 594 595 596 |
&& (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
/*
* This is a simple one pair string map situation. We make use of a
* slightly modified version of the one pair STR_MAP code.
*/
int slen, nocase;
| | | 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 |
&& (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
/*
* This is a simple one pair string map situation. We make use of a
* slightly modified version of the one pair STR_MAP code.
*/
int slen, nocase;
int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t);
Tcl_UniChar *p, wsrclc;
numMatches = 0;
nocase = (cflags & TCL_REG_NOCASE);
strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen);
|
| ︙ | ︙ | |||
625 626 627 628 629 630 631 |
}
} else {
wsrclc = Tcl_UniCharToLower(*wsrc);
for (p = wfirstChar = wstring; wstring < wend; wstring++) {
if ((*wstring == *wsrc ||
(nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) &&
(slen==1 || (strCmpFn(wstring, wsrc,
| | | 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 |
}
} else {
wsrclc = Tcl_UniCharToLower(*wsrc);
for (p = wfirstChar = wstring; wstring < wend; wstring++) {
if ((*wstring == *wsrc ||
(nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) &&
(slen==1 || (strCmpFn(wstring, wsrc,
(size_t)slen) == 0))) {
if (numMatches == 0) {
resultPtr = Tcl_NewUnicodeObj(wstring, 0);
Tcl_IncrRefCount(resultPtr);
}
if (p != wstring) {
Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p);
p = wstring + slen;
|
| ︙ | ︙ | |||
843 844 845 846 847 848 849 |
result = TCL_ERROR;
} else {
/*
* Set the interpreter's object result to an integer object
* holding the number of matches.
*/
| | | 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 |
result = TCL_ERROR;
} else {
/*
* Set the interpreter's object result to an integer object
* holding the number of matches.
*/
Tcl_SetObjResult(interp, Tcl_NewLongObj(numMatches));
}
} else {
/*
* No varname supplied, so just return the modified string.
*/
Tcl_SetObjResult(interp, resultPtr);
|
| ︙ | ︙ | |||
999 1000 1001 1002 1003 1004 1005 |
if (objc == 4) {
static const char *const options[] = {
"-encoding", NULL
};
int index;
| | | | 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 |
if (objc == 4) {
static const char *const options[] = {
"-encoding", NULL
};
int index;
if (TCL_ERROR == Tcl_GetIndexFromObjStruct(interp, objv[1], options,
sizeof(char *), "option", TCL_EXACT, &index)) {
return TCL_ERROR;
}
encodingName = TclGetString(objv[2]);
}
return TclNREvalFile(interp, fileName, encodingName);
}
|
| ︙ | ︙ | |||
1376 1377 1378 1379 1380 1381 1382 |
};
if (objc < 3 || objc > 6) {
Tcl_WrongNumArgs(interp, 1, objv,
"class ?-strict? ?-failindex var? str");
return TCL_ERROR;
}
| | | | | | 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 |
};
if (objc < 3 || objc > 6) {
Tcl_WrongNumArgs(interp, 1, objv,
"class ?-strict? ?-failindex var? str");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], isClasses,
sizeof(char *), "class", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
if (objc != 3) {
for (i = 2; i < objc-1; i++) {
int idx2;
if (Tcl_GetIndexFromObjStruct(interp, objv[i], isOptions,
sizeof(char *), "option", 0, &idx2) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum isOptions) idx2) {
case OPT_STRICT:
strict = 1;
break;
case OPT_FAILIDX:
|
| ︙ | ︙ | |||
1689 1690 1691 1692 1693 1694 1695 |
/*
* Only set the failVarObj when we will return 0 and we have indicated a
* valid fail index (>= 0).
*/
str_is_done:
if ((result == 0) && (failVarObj != NULL) &&
| | | | 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 |
/*
* Only set the failVarObj when we will return 0 and we have indicated a
* valid fail index (>= 0).
*/
str_is_done:
if ((result == 0) && (failVarObj != NULL) &&
Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewLongObj(failat),
TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(result!=0));
return TCL_OK;
}
static int
UniCharIsAscii(
int character)
{
|
| ︙ | ︙ | |||
1740 1741 1742 1743 1744 1745 1746 |
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int length1, length2, mapElemc, index;
int nocase = 0, mapWithDict = 0, copySource = 0;
Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
Tcl_UniChar *ustring1, *ustring2, *p, *end;
| | | 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 |
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int 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");
return TCL_ERROR;
}
if (objc == 4) {
|
| ︙ | ︙ | |||
1881 1882 1883 1884 1885 1886 1887 |
} else {
mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
for (; ustring1 < end; ustring1++) {
if (((*ustring1 == *ustring2) ||
(nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) &&
(length2==1 || strCmpFn(ustring1, ustring2,
| | | 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 |
} else {
mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
for (; ustring1 < end; ustring1++) {
if (((*ustring1 == *ustring2) ||
(nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) &&
(length2==1 || strCmpFn(ustring1, ustring2,
(size_t) length2) == 0)) {
if (p != ustring1) {
Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
p = ustring1 + length2;
} else {
p += length2;
}
ustring1 = p - 1;
|
| ︙ | ︙ | |||
1929 1930 1931 1932 1933 1934 1935 | ustring2 = mapStrings[index]; length2 = mapLens[index]; if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ (end-ustring1 >= length2) && ((length2 == 1) || | | | 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 |
ustring2 = mapStrings[index];
length2 = mapLens[index];
if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase &&
(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
/* Restrict max compare length. */
(end-ustring1 >= length2) && ((length2 == 1) ||
!strCmpFn(ustring2, ustring1, (size_t) length2))) {
if (p != ustring1) {
/*
* Put the skipped chars onto the result first.
*/
Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
p = ustring1 + length2;
|
| ︙ | ︙ | |||
2028 2029 2030 2031 2032 2033 2034 |
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\": must be -nocase", string));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string, NULL);
return TCL_ERROR;
}
}
| | | | 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 |
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\": must be -nocase", string));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string, NULL);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(
TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)!=0));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringRangeCmd --
|
| ︙ | ︙ | |||
2359 2360 2361 2362 2363 2364 2365 |
}
p = Tcl_UtfPrev(p, string);
}
if (cur != index) {
cur += 1;
}
}
| | | 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 |
}
p = Tcl_UtfPrev(p, string);
}
if (cur != index) {
cur += 1;
}
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(cur));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringEndCmd --
|
| ︙ | ︙ | |||
2421 2422 2423 2424 2425 2426 2427 |
}
if (cur == index) {
cur++;
}
} else {
cur = numChars;
}
| | | 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 |
}
if (cur == index) {
cur++;
}
} else {
cur = numChars;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(cur));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringEqualCmd --
|
| ︙ | ︙ | |||
2458 2459 2460 2461 2462 2463 2464 |
* Remember to keep code here in some sync with the byte-compiled versions
* in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
*/
const char *string1, *string2;
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
| | | 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 |
* Remember to keep code here in some sync with the byte-compiled versions
* in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
*/
const char *string1, *string2;
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
typedef int (*strCmpFn_t)(const char *, const char *, size_t);
strCmpFn_t strCmpFn;
if (objc < 3 || objc > 6) {
str_cmp_args:
Tcl_WrongNumArgs(interp, 1, objv,
"?-nocase? ?-length int? string1 string2");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2503 2504 2505 2506 2507 2508 2509 |
objv += objc-2;
if ((reqlength == 0) || (objv[0] == objv[1])) {
/*
* Always match at 0 chars of if it is the same obj.
*/
| | | 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 |
objv += objc-2;
if ((reqlength == 0) || (objv[0] == objv[1])) {
/*
* Always match at 0 chars of if it is the same obj.
*/
Tcl_SetObjResult(interp, Tcl_NewLongObj(1));
return TCL_OK;
}
if (!nocase && TclIsPureByteArray(objv[0]) &&
TclIsPureByteArray(objv[1])) {
/*
* Use binary versions of comparisons since that won't cause undue
|
| ︙ | ︙ | |||
2571 2572 2573 2574 2575 2576 2577 |
match = strCmpFn(string1, string2, (unsigned) length);
if ((match == 0) && (reqlength > length)) {
match = length1 - length2;
}
}
| | | 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 |
match = strCmpFn(string1, string2, (unsigned) length);
if ((match == 0) && (reqlength > length)) {
match = length1 - length2;
}
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(match==0));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringCmpCmd --
|
| ︙ | ︙ | |||
2608 2609 2610 2611 2612 2613 2614 |
* Remember to keep code here in some sync with the byte-compiled versions
* in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
*/
const char *string1, *string2;
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
| | | 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 |
* Remember to keep code here in some sync with the byte-compiled versions
* in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
*/
const char *string1, *string2;
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
typedef int (*strCmpFn_t)(const char *, const char *, size_t);
strCmpFn_t strCmpFn;
if (objc < 3 || objc > 6) {
str_cmp_args:
Tcl_WrongNumArgs(interp, 1, objv,
"?-nocase? ?-length int? string1 string2");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2653 2654 2655 2656 2657 2658 2659 |
objv += objc-2;
if ((reqlength == 0) || (objv[0] == objv[1])) {
/*
* Always match at 0 chars of if it is the same obj.
*/
| | | 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 |
objv += objc-2;
if ((reqlength == 0) || (objv[0] == objv[1])) {
/*
* Always match at 0 chars of if it is the same obj.
*/
Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
return TCL_OK;
}
if (!nocase && TclIsPureByteArray(objv[0]) &&
TclIsPureByteArray(objv[1])) {
/*
* Use binary versions of comparisons since that won't cause undue
|
| ︙ | ︙ | |||
2692 2693 2694 2695 2696 2697 2698 |
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
* case-sensitive and no specific length was requested.
*/
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
if ((reqlength < 0) && !nocase) {
| | | | | | 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 |
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
* case-sensitive and no specific length was requested.
*/
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
if ((reqlength < 0) && !nocase) {
strCmpFn = TclpUtfNcmp2;
} else {
length1 = Tcl_NumUtfChars(string1, length1);
length2 = Tcl_NumUtfChars(string2, length2);
strCmpFn = nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp;
}
}
length = (length1 < length2) ? length1 : length2;
if (reqlength > 0 && reqlength < length) {
length = reqlength;
} else if (reqlength < 0) {
/*
* The requested length is negative, so we ignore it by setting it to
* length + 1 so we correct the match var.
*/
reqlength = length + 1;
}
match = strCmpFn(string1, string2, (size_t) length);
if ((match == 0) && (reqlength > length)) {
match = length1 - length2;
}
Tcl_SetObjResult(interp,
Tcl_NewLongObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringCatCmd --
|
| ︙ | ︙ | |||
2809 2810 2811 2812 2813 2814 2815 |
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
(void) TclGetStringFromObj(objv[1], &length);
| | | 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 |
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
(void) TclGetStringFromObj(objv[1], &length);
Tcl_SetObjResult(interp, Tcl_NewLongObj(length));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringLenCmd --
|
| ︙ | ︙ | |||
2843 2844 2845 2846 2847 2848 2849 |
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
| | | 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 |
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_GetCharLength(objv[1])));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringLowerCmd --
|
| ︙ | ︙ | |||
3459 3460 3461 3462 3463 3464 3465 |
matchVarObj = NULL;
numMatchesSaved = 0;
noCase = 0;
for (i = 1; i < objc-2; i++) {
if (TclGetString(objv[i])[0] != '-') {
break;
}
| | | | 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 |
matchVarObj = NULL;
numMatchesSaved = 0;
noCase = 0;
for (i = 1; i < objc-2; i++) {
if (TclGetString(objv[i])[0] != '-') {
break;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
/*
* General options.
*/
|
| ︙ | ︙ | |||
3736 3737 3738 3739 3740 3741 3742 |
if (indexVarObj != NULL) {
Tcl_Obj *rangeObjAry[2];
if (info.matches[j].end > 0) {
rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1);
} else {
| | | 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 |
if (indexVarObj != NULL) {
Tcl_Obj *rangeObjAry[2];
if (info.matches[j].end > 0) {
rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1);
} else {
rangeObjAry[0] = rangeObjAry[1] = Tcl_NewLongObj(-1);
}
/*
* Never fails; the object is always clean at this point.
*/
Tcl_ListObjAppendElement(NULL, indicesObj,
|
| ︙ | ︙ | |||
4056 4057 4058 4059 4060 4061 4062 |
#endif
if (count <= 1) {
/*
* Use int obj since we know time is not fractional. [Bug 1202178]
*/
| | | 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 |
#endif
if (count <= 1) {
/*
* Use int obj since we know time is not fractional. [Bug 1202178]
*/
objs[0] = Tcl_NewLongObj((count <= 0) ? 0 : (int) totalMicroSec);
} else {
objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
}
/*
* Construct the result as a list because many programs have always parsed
* as such (extracting the first element, typically).
|
| ︙ | ︙ | |||
4136 4137 4138 4139 4140 4141 4142 |
handlersObj = Tcl_NewObj();
bodyShared = 0;
haveHandlers = 0;
for (i=2 ; i<objc ; i++) {
int type;
Tcl_Obj *info[5];
| | | | 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 |
handlersObj = Tcl_NewObj();
bodyShared = 0;
haveHandlers = 0;
for (i=2 ; i<objc ; i++) {
int type;
Tcl_Obj *info[5];
if (Tcl_GetIndexFromObjStruct(interp, objv[i], handlerNames,
sizeof(char *), "handler type", 0, &type) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
switch ((enum Handlers) type) {
case TryFinally: /* finally script */
if (i < objc-2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
| ︙ | ︙ | |||
4210 4211 4212 4213 4214 4215 4216 |
commonHandler:
if (Tcl_ListObjLength(interp, objv[i+2], &dummy) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
info[0] = objv[i]; /* type */
| | | 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 |
commonHandler:
if (Tcl_ListObjLength(interp, objv[i+2], &dummy) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
info[0] = objv[i]; /* type */
TclNewLongObj(info[1], code); /* returnCode */
if (info[2] == NULL) { /* errorCodePrefix */
TclNewObj(info[2]);
}
info[3] = objv[i+2]; /* bindVariables */
info[4] = objv[i+3]; /* script */
bodyShared = !strcmp(TclGetString(objv[i+3]), "-");
|
| ︙ | ︙ |
Changes to generic/tclCompExpr.c.
| ︙ | ︙ | |||
18 19 20 21 22 23 24 | * Expression parsing takes place in the routine ParseExpr(). It takes a * string as input, parses that string, and generates a representation of the * expression in the form of a tree of operators, a list of literals, a list * of function names, and an array of Tcl_Token's within a Tcl_Parse struct. * The tree is composed of OpNodes. */ | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
* Expression parsing takes place in the routine ParseExpr(). It takes a
* string as input, parses that string, and generates a representation of the
* expression in the form of a tree of operators, a list of literals, a list
* of function names, and an array of Tcl_Token's within a Tcl_Parse struct.
* The tree is composed of OpNodes.
*/
typedef struct {
int left; /* "Pointer" to the left operand. */
int right; /* "Pointer" to the right operand. */
union {
int parent; /* "Pointer" to the parent operand. */
int prev; /* "Pointer" joining incomplete tree stack */
} p;
unsigned char lexeme; /* Code that identifies the operator. */
|
| ︙ | ︙ |
Changes to generic/tclCompile.c.
| ︙ | ︙ | |||
842 843 844 845 846 847 848 |
}
/*
* Apply some peephole optimizations that can cross specific/generic
* instruction generator boundaries.
*/
| | | | 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 |
}
/*
* Apply some peephole optimizations that can cross specific/generic
* instruction generator boundaries.
*/
if (iPtr->optimizer) {
(iPtr->optimizer)(&compEnv);
}
/*
* Invoke the compilation hook procedure if one exists.
*/
if (hookProc) {
|
| ︙ | ︙ |
Changes to generic/tclCompile.h.
| ︙ | ︙ | |||
83 84 85 86 87 88 89 |
* and continue "exceptions" cause jumps to
* appropriate PC offsets. */
CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a catch
* command. Errors in the range cause a jump
* to a catch PC offset. */
} ExceptionRangeType;
| | | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 |
* and continue "exceptions" cause jumps to
* appropriate PC offsets. */
CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a catch
* command. Errors in the range cause a jump
* to a catch PC offset. */
} ExceptionRangeType;
typedef struct {
ExceptionRangeType type; /* The kind of ExceptionRange. */
int nestingLevel; /* Static depth of the exception range. Used
* to find the most deeply-nested range
* surrounding a PC at runtime. */
int codeOffset; /* Offset of the first instruction byte of the
* code range. */
int numCodeBytes; /* Number of bytes in the code range. */
|
| ︙ | ︙ | |||
158 159 160 161 162 163 164 | * Structure used to map between instruction pc and source locations. It * defines for each compiled Tcl command its code's starting offset and its * source's starting offset and length. Note that the code offset increases * monotonically: that is, the table is sorted in code offset order. The * source offset is not monotonic. */ | | | | | 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 |
* Structure used to map between instruction pc and source locations. It
* defines for each compiled Tcl command its code's starting offset and its
* source's starting offset and length. Note that the code offset increases
* monotonically: that is, the table is sorted in code offset order. The
* source offset is not monotonic.
*/
typedef struct {
int codeOffset; /* Offset of first byte of command code. */
int numCodeBytes; /* Number of bytes for command's code. */
int srcOffset; /* Offset of first char of the command. */
int numSrcBytes; /* Number of command source chars. */
} CmdLocation;
/*
* TIP #280
* Structure to record additional location information for byte code. This
* information is internal and not saved. i.e. tbcload'ed code will not have
* this information. It records the lines for all words of all commands found
* in the byte code. The association with a ByteCode structure BC is done
* through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
* Also recorded is information coming from the context, i.e. type of the
* frame and associated information, like the path of a sourced file.
*/
typedef struct {
int srcOffset; /* Command location to find the entry. */
int nline; /* Number of words in the command */
int *line; /* Line information for all words in the
* command. */
int **next; /* Transient information used by the compiler
* for tracking of hidden continuation
* lines. */
} ECL;
typedef struct {
int type; /* Context type. */
int start; /* Starting line for compiled script. Needed
* for the extended recompile check in
* tclCompileObj. */
Tcl_Obj *path; /* Path of the sourced file the command is
* in. */
ECL *loc; /* Command word locations (lines). */
|
| ︙ | ︙ | |||
1092 1093 1094 1095 1096 1097 1098 | Tcl_Token *tokenPtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateAuxData(ClientData clientData, const AuxDataType *typePtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes, | | | 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 | Tcl_Token *tokenPtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateAuxData(ClientData clientData, const AuxDataType *typePtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes, size_t length, TCL_HASH_TYPE hash, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr, TclJumpType jumpType, JumpFixup *jumpFixupPtr); |
| ︙ | ︙ |
Changes to generic/tclConfig.c.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 | /* * A ClientData struct for the QueryConfig command. Store the three bits * of data we need; the package name for which we store a config dict, * the (Tcl_Interp *) in which it is stored, and the encoding. */ | | | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
/*
* A ClientData struct for the QueryConfig command. Store the three bits
* of data we need; the package name for which we store a config dict,
* the (Tcl_Interp *) in which it is stored, and the encoding.
*/
typedef struct {
Tcl_Obj *pkg;
Tcl_Interp *interp;
char *encoding;
} QCCD;
/*
* Static functions in this file:
|
| ︙ | ︙ | |||
213 214 215 216 217 218 219 |
Tcl_Encoding venc = NULL;
const char *value;
if ((objc < 2) || (objc > 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?");
return TCL_ERROR;
}
| | | | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 |
Tcl_Encoding venc = NULL;
const char *value;
if ((objc < 2) || (objc > 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmdStrings,
sizeof(char *), "subcommand", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
pDB = GetConfigDict(interp);
if (Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict) != TCL_OK
|| pkgDict == NULL) {
/*
|
| ︙ | ︙ |
Changes to generic/tclDecls.h.
| ︙ | ︙ | |||
8 9 10 11 12 13 14 | * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLDECLS #define _TCLDECLS | < < < < < < < < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | < < | < | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < | | < | < < | < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | < | | | | | | | | | | < < | | | | | | | < < < | | | | | | | | | | | | | < | < < < | | | | | | < < | | < < < < | | | < < < | | < | < < < < | | | | | | | | | | | < < < | | | < < < | | < | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | < < | < < | | | | | | | | | | | | | | | | | | | | | | | | | | < | < | | | | | | | | | | | | < | | | | < < | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | < | | < < | < < | | | | | | | | | | | | | < < < < < | < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > | | 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 149 150 151 152 153 154 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 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 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 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 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 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 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 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 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 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 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 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 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 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 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 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 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 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 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 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 |
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _TCLDECLS
#define _TCLDECLS
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
* script. Any modifications to the function declarations below should be made
* in the generic/tcl.decls script.
*/
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
/*
* Exported function declarations:
*/
/* 0 */
TCLAPI int Tcl_PkgProvideEx(Tcl_Interp *interp,
const char *name, const char *version,
const void *clientData);
/* 1 */
TCLAPI const char * Tcl_PkgRequireEx(Tcl_Interp *interp,
const char *name, const char *version,
int exact, void *clientDataPtr);
/* 2 */
TCLAPI TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 3 */
TCLAPI char * Tcl_Alloc(unsigned int size);
/* 4 */
TCLAPI void Tcl_Free(char *ptr);
/* 5 */
TCLAPI char * Tcl_Realloc(char *ptr, unsigned int size);
/* 6 */
TCLAPI char * Tcl_DbCkalloc(unsigned int size, const char *file,
int line);
/* 7 */
TCLAPI void Tcl_DbCkfree(char *ptr, const char *file, int line);
/* 8 */
TCLAPI char * Tcl_DbCkrealloc(char *ptr, unsigned int size,
const char *file, int line);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 9 */
TCLAPI void Tcl_CreateFileHandler(int fd, int mask,
Tcl_FileProc *proc, ClientData clientData);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 9 */
TCLAPI void Tcl_CreateFileHandler(int fd, int mask,
Tcl_FileProc *proc, ClientData clientData);
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 10 */
TCLAPI void Tcl_DeleteFileHandler(int fd);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 10 */
TCLAPI void Tcl_DeleteFileHandler(int fd);
#endif /* MACOSX */
/* 11 */
TCLAPI void Tcl_SetTimer(const Tcl_Time *timePtr);
/* 12 */
TCLAPI void Tcl_Sleep(int ms);
/* 13 */
TCLAPI int Tcl_WaitForEvent(const Tcl_Time *timePtr);
/* 14 */
TCLAPI int Tcl_AppendAllObjTypes(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 15 */
TCLAPI void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...);
/* 16 */
TCLAPI void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes,
int length);
/* 17 */
TCLAPI Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]);
/* 18 */
TCLAPI int Tcl_ConvertToType(Tcl_Interp *interp,
Tcl_Obj *objPtr, const Tcl_ObjType *typePtr);
/* 19 */
TCLAPI void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file,
int line);
/* 20 */
TCLAPI void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
int line);
/* 21 */
TCLAPI int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
int line);
/* 22 */
TCLAPI Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
int line);
/* 23 */
TCLAPI Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
int length, const char *file, int line);
/* 24 */
TCLAPI Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue,
const char *file, int line);
/* 25 */
TCLAPI Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
const char *file, int line);
/* 26 */
TCLAPI Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file,
int line);
/* 27 */
TCLAPI Tcl_Obj * Tcl_DbNewObj(const char *file, int line);
/* 28 */
TCLAPI Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length,
const char *file, int line);
/* 29 */
TCLAPI Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr);
/* 30 */
TCLAPI void TclFreeObj(Tcl_Obj *objPtr);
/* 31 */
TCLAPI int Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
int *boolPtr);
/* 32 */
TCLAPI int Tcl_GetBooleanFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, int *boolPtr);
/* 33 */
TCLAPI unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
int *lengthPtr);
/* 34 */
TCLAPI int Tcl_GetDouble(Tcl_Interp *interp, const char *src,
double *doublePtr);
/* 35 */
TCLAPI int Tcl_GetDoubleFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, double *doublePtr);
/* Slot 36 is reserved */
/* 37 */
TCLAPI int Tcl_GetInt(Tcl_Interp *interp, const char *src,
int *intPtr);
/* 38 */
TCLAPI int Tcl_GetIntFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, int *intPtr);
/* 39 */
TCLAPI int Tcl_GetLongFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, long *longPtr);
/* 40 */
TCLAPI const Tcl_ObjType * Tcl_GetObjType(const char *typeName);
/* 41 */
TCLAPI char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
/* 42 */
TCLAPI void Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
/* 43 */
TCLAPI int Tcl_ListObjAppendList(Tcl_Interp *interp,
Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
/* 44 */
TCLAPI int Tcl_ListObjAppendElement(Tcl_Interp *interp,
Tcl_Obj *listPtr, Tcl_Obj *objPtr);
/* 45 */
TCLAPI int Tcl_ListObjGetElements(Tcl_Interp *interp,
Tcl_Obj *listPtr, int *objcPtr,
Tcl_Obj ***objvPtr);
/* 46 */
TCLAPI int Tcl_ListObjIndex(Tcl_Interp *interp,
Tcl_Obj *listPtr, int index,
Tcl_Obj **objPtrPtr);
/* 47 */
TCLAPI int Tcl_ListObjLength(Tcl_Interp *interp,
Tcl_Obj *listPtr, int *lengthPtr);
/* 48 */
TCLAPI int Tcl_ListObjReplace(Tcl_Interp *interp,
Tcl_Obj *listPtr, int first, int count,
int objc, Tcl_Obj *const objv[]);
/* 49 */
TCLAPI Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
/* 50 */
TCLAPI Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes,
int length);
/* 51 */
TCLAPI Tcl_Obj * Tcl_NewDoubleObj(double doubleValue);
/* 52 */
TCLAPI Tcl_Obj * Tcl_NewIntObj(int intValue);
/* 53 */
TCLAPI Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* 54 */
TCLAPI Tcl_Obj * Tcl_NewLongObj(long longValue);
/* 55 */
TCLAPI Tcl_Obj * Tcl_NewObj(void);
/* 56 */
TCLAPI Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length);
/* 57 */
TCLAPI void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
/* 58 */
TCLAPI unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
/* 59 */
TCLAPI void Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
const unsigned char *bytes, int length);
/* 60 */
TCLAPI void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* 61 */
TCLAPI void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
/* 62 */
TCLAPI void Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
Tcl_Obj *const objv[]);
/* 63 */
TCLAPI void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
/* 64 */
TCLAPI void Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
/* 65 */
TCLAPI void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
int length);
/* 66 */
TCLAPI void Tcl_AddErrorInfo(Tcl_Interp *interp,
const char *message);
/* Slot 67 is reserved */
/* 68 */
TCLAPI void Tcl_AllowExceptions(Tcl_Interp *interp);
/* 69 */
TCLAPI void Tcl_AppendElement(Tcl_Interp *interp,
const char *element);
/* 70 */
TCLAPI void Tcl_AppendResult(Tcl_Interp *interp, ...);
/* 71 */
TCLAPI Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc,
ClientData clientData);
/* 72 */
TCLAPI void Tcl_AsyncDelete(Tcl_AsyncHandler async);
/* 73 */
TCLAPI int Tcl_AsyncInvoke(Tcl_Interp *interp, int code);
/* 74 */
TCLAPI void Tcl_AsyncMark(Tcl_AsyncHandler async);
/* 75 */
TCLAPI int Tcl_AsyncReady(void);
/* 76 */
TCLAPI void Tcl_BackgroundError(Tcl_Interp *interp);
/* Slot 77 is reserved */
/* 78 */
TCLAPI int Tcl_BadChannelOption(Tcl_Interp *interp,
const char *optionName,
const char *optionList);
/* 79 */
TCLAPI void Tcl_CallWhenDeleted(Tcl_Interp *interp,
Tcl_InterpDeleteProc *proc,
ClientData clientData);
/* 80 */
TCLAPI void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
ClientData clientData);
/* 81 */
TCLAPI int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
/* 82 */
TCLAPI int Tcl_CommandComplete(const char *cmd);
/* 83 */
TCLAPI char * Tcl_Concat(int argc, const char *const *argv);
/* 84 */
TCLAPI int Tcl_ConvertElement(const char *src, char *dst,
int flags);
/* 85 */
TCLAPI int Tcl_ConvertCountedElement(const char *src,
int length, char *dst, int flags);
/* 86 */
TCLAPI int Tcl_CreateAlias(Tcl_Interp *slave,
const char *slaveCmd, Tcl_Interp *target,
const char *targetCmd, int argc,
const char *const *argv);
/* 87 */
TCLAPI int Tcl_CreateAliasObj(Tcl_Interp *slave,
const char *slaveCmd, Tcl_Interp *target,
const char *targetCmd, int objc,
Tcl_Obj *const objv[]);
/* 88 */
TCLAPI Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
const char *chanName,
ClientData instanceData, int mask);
/* 89 */
TCLAPI void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
Tcl_ChannelProc *proc, ClientData clientData);
/* 90 */
TCLAPI void Tcl_CreateCloseHandler(Tcl_Channel chan,
Tcl_CloseProc *proc, ClientData clientData);
/* 91 */
TCLAPI Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp,
const char *cmdName, Tcl_CmdProc *proc,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
/* 92 */
TCLAPI void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
Tcl_EventCheckProc *checkProc,
ClientData clientData);
/* 93 */
TCLAPI void Tcl_CreateExitHandler(Tcl_ExitProc *proc,
ClientData clientData);
/* 94 */
TCLAPI Tcl_Interp * Tcl_CreateInterp(void);
/* Slot 95 is reserved */
/* 96 */
TCLAPI Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
const char *cmdName, Tcl_ObjCmdProc *proc,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
/* 97 */
TCLAPI Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp,
const char *slaveName, int isSafe);
/* 98 */
TCLAPI Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
Tcl_TimerProc *proc, ClientData clientData);
/* 99 */
TCLAPI Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level,
Tcl_CmdTraceProc *proc,
ClientData clientData);
/* 100 */
TCLAPI void Tcl_DeleteAssocData(Tcl_Interp *interp,
const char *name);
/* 101 */
TCLAPI void Tcl_DeleteChannelHandler(Tcl_Channel chan,
Tcl_ChannelProc *proc, ClientData clientData);
/* 102 */
TCLAPI void Tcl_DeleteCloseHandler(Tcl_Channel chan,
Tcl_CloseProc *proc, ClientData clientData);
/* 103 */
TCLAPI int Tcl_DeleteCommand(Tcl_Interp *interp,
const char *cmdName);
/* 104 */
TCLAPI int Tcl_DeleteCommandFromToken(Tcl_Interp *interp,
Tcl_Command command);
/* 105 */
TCLAPI void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc,
ClientData clientData);
/* 106 */
TCLAPI void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
Tcl_EventCheckProc *checkProc,
ClientData clientData);
/* 107 */
TCLAPI void Tcl_DeleteExitHandler(Tcl_ExitProc *proc,
ClientData clientData);
/* 108 */
TCLAPI void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr);
/* 109 */
TCLAPI void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr);
/* 110 */
TCLAPI void Tcl_DeleteInterp(Tcl_Interp *interp);
/* 111 */
TCLAPI void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr);
/* 112 */
TCLAPI void Tcl_DeleteTimerHandler(Tcl_TimerToken token);
/* 113 */
TCLAPI void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace);
/* 114 */
TCLAPI void Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
Tcl_InterpDeleteProc *proc,
ClientData clientData);
/* 115 */
TCLAPI int Tcl_DoOneEvent(int flags);
/* 116 */
TCLAPI void Tcl_DoWhenIdle(Tcl_IdleProc *proc,
ClientData clientData);
/* 117 */
TCLAPI char * Tcl_DStringAppend(Tcl_DString *dsPtr,
const char *bytes, int length);
/* 118 */
TCLAPI char * Tcl_DStringAppendElement(Tcl_DString *dsPtr,
const char *element);
/* 119 */
TCLAPI void Tcl_DStringEndSublist(Tcl_DString *dsPtr);
/* 120 */
TCLAPI void Tcl_DStringFree(Tcl_DString *dsPtr);
/* 121 */
TCLAPI void Tcl_DStringGetResult(Tcl_Interp *interp,
Tcl_DString *dsPtr);
/* 122 */
TCLAPI void Tcl_DStringInit(Tcl_DString *dsPtr);
/* 123 */
TCLAPI void Tcl_DStringResult(Tcl_Interp *interp,
Tcl_DString *dsPtr);
/* 124 */
TCLAPI void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length);
/* 125 */
TCLAPI void Tcl_DStringStartSublist(Tcl_DString *dsPtr);
/* 126 */
TCLAPI int Tcl_Eof(Tcl_Channel chan);
/* 127 */
TCLAPI const char * Tcl_ErrnoId(void);
/* 128 */
TCLAPI const char * Tcl_ErrnoMsg(int err);
/* Slot 129 is reserved */
/* Slot 130 is reserved */
/* Slot 131 is reserved */
/* 132 */
TCLAPI void Tcl_EventuallyFree(ClientData clientData,
Tcl_FreeProc *freeProc);
/* 133 */
TCLAPI TCL_NORETURN void Tcl_Exit(int status);
/* 134 */
TCLAPI int Tcl_ExposeCommand(Tcl_Interp *interp,
const char *hiddenCmdToken,
const char *cmdName);
/* 135 */
TCLAPI int Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr,
int *ptr);
/* 136 */
TCLAPI int Tcl_ExprBooleanObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, int *ptr);
/* 137 */
TCLAPI int Tcl_ExprDouble(Tcl_Interp *interp, const char *expr,
double *ptr);
/* 138 */
TCLAPI int Tcl_ExprDoubleObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, double *ptr);
/* 139 */
TCLAPI int Tcl_ExprLong(Tcl_Interp *interp, const char *expr,
long *ptr);
/* 140 */
TCLAPI int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
long *ptr);
/* 141 */
TCLAPI int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Obj **resultPtrPtr);
/* 142 */
TCLAPI int Tcl_ExprString(Tcl_Interp *interp, const char *expr);
/* 143 */
TCLAPI void Tcl_Finalize(void);
/* Slot 144 is reserved */
/* 145 */
TCLAPI Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
Tcl_HashSearch *searchPtr);
/* 146 */
TCLAPI int Tcl_Flush(Tcl_Channel chan);
/* 147 */
TCLAPI void Tcl_FreeResult(Tcl_Interp *interp);
/* 148 */
TCLAPI int Tcl_GetAlias(Tcl_Interp *interp,
const char *slaveCmd,
Tcl_Interp **targetInterpPtr,
const char **targetCmdPtr, int *argcPtr,
const char ***argvPtr);
/* 149 */
TCLAPI int Tcl_GetAliasObj(Tcl_Interp *interp,
const char *slaveCmd,
Tcl_Interp **targetInterpPtr,
const char **targetCmdPtr, int *objcPtr,
Tcl_Obj ***objv);
/* 150 */
TCLAPI ClientData Tcl_GetAssocData(Tcl_Interp *interp,
const char *name,
Tcl_InterpDeleteProc **procPtr);
/* 151 */
TCLAPI Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp,
const char *chanName, int *modePtr);
/* 152 */
TCLAPI int Tcl_GetChannelBufferSize(Tcl_Channel chan);
/* 153 */
TCLAPI int Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
ClientData *handlePtr);
/* 154 */
TCLAPI ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan);
/* 155 */
TCLAPI int Tcl_GetChannelMode(Tcl_Channel chan);
/* 156 */
TCLAPI const char * Tcl_GetChannelName(Tcl_Channel chan);
/* 157 */
TCLAPI int Tcl_GetChannelOption(Tcl_Interp *interp,
Tcl_Channel chan, const char *optionName,
Tcl_DString *dsPtr);
/* 158 */
TCLAPI const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
/* 159 */
TCLAPI int Tcl_GetCommandInfo(Tcl_Interp *interp,
const char *cmdName, Tcl_CmdInfo *infoPtr);
/* 160 */
TCLAPI const char * Tcl_GetCommandName(Tcl_Interp *interp,
Tcl_Command command);
/* 161 */
TCLAPI int Tcl_GetErrno(void);
/* 162 */
TCLAPI const char * Tcl_GetHostName(void);
/* 163 */
TCLAPI int Tcl_GetInterpPath(Tcl_Interp *askInterp,
Tcl_Interp *slaveInterp);
/* 164 */
TCLAPI Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp);
/* 165 */
TCLAPI const char * Tcl_GetNameOfExecutable(void);
/* 166 */
TCLAPI Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 167 */
TCLAPI int Tcl_GetOpenFile(Tcl_Interp *interp,
const char *chanID, int forWriting,
int checkUsage, ClientData *filePtr);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 167 */
TCLAPI int Tcl_GetOpenFile(Tcl_Interp *interp,
const char *chanID, int forWriting,
int checkUsage, ClientData *filePtr);
#endif /* MACOSX */
/* 168 */
TCLAPI Tcl_PathType Tcl_GetPathType(const char *path);
/* 169 */
TCLAPI int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr);
/* 170 */
TCLAPI int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 171 */
TCLAPI int Tcl_GetServiceMode(void);
/* 172 */
TCLAPI Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp,
const char *slaveName);
/* 173 */
TCLAPI Tcl_Channel Tcl_GetStdChannel(int type);
/* 174 */
TCLAPI const char * Tcl_GetStringResult(Tcl_Interp *interp);
/* Slot 175 is reserved */
/* 176 */
TCLAPI const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags);
/* Slot 177 is reserved */
/* Slot 178 is reserved */
/* 179 */
TCLAPI int Tcl_HideCommand(Tcl_Interp *interp,
const char *cmdName,
const char *hiddenCmdToken);
/* 180 */
TCLAPI int Tcl_Init(Tcl_Interp *interp);
/* 181 */
TCLAPI void Tcl_InitHashTable(Tcl_HashTable *tablePtr,
int keyType);
/* 182 */
TCLAPI int Tcl_InputBlocked(Tcl_Channel chan);
/* 183 */
TCLAPI int Tcl_InputBuffered(Tcl_Channel chan);
/* 184 */
TCLAPI int Tcl_InterpDeleted(Tcl_Interp *interp);
/* 185 */
TCLAPI int Tcl_IsSafe(Tcl_Interp *interp);
/* 186 */
TCLAPI char * Tcl_JoinPath(int argc, const char *const *argv,
Tcl_DString *resultPtr);
/* 187 */
TCLAPI int Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
char *addr, int type);
/* Slot 188 is reserved */
/* 189 */
TCLAPI Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode);
/* 190 */
TCLAPI int Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
TCLAPI Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket);
/* 192 */
TCLAPI char * Tcl_Merge(int argc, const char *const *argv);
/* 193 */
TCLAPI Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
/* 194 */
TCLAPI void Tcl_NotifyChannel(Tcl_Channel channel, int mask);
/* 195 */
TCLAPI Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, int flags);
/* 196 */
TCLAPI Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
int flags);
/* 197 */
TCLAPI Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
const char **argv, int flags);
/* 198 */
TCLAPI Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp,
const char *fileName, const char *modeString,
int permissions);
/* 199 */
TCLAPI Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
const char *address, const char *myaddr,
int myport, int async);
/* 200 */
TCLAPI Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
const char *host,
Tcl_TcpAcceptProc *acceptProc,
ClientData callbackData);
/* 201 */
TCLAPI void Tcl_Preserve(ClientData data);
/* 202 */
TCLAPI void Tcl_PrintDouble(Tcl_Interp *interp, double value,
char *dst);
/* 203 */
TCLAPI int Tcl_PutEnv(const char *assignment);
/* 204 */
TCLAPI const char * Tcl_PosixError(Tcl_Interp *interp);
/* 205 */
TCLAPI void Tcl_QueueEvent(Tcl_Event *evPtr,
Tcl_QueuePosition position);
/* 206 */
TCLAPI int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead);
/* 207 */
TCLAPI void Tcl_ReapDetachedProcs(void);
/* 208 */
TCLAPI int Tcl_RecordAndEval(Tcl_Interp *interp,
const char *cmd, int flags);
/* 209 */
TCLAPI int Tcl_RecordAndEvalObj(Tcl_Interp *interp,
Tcl_Obj *cmdPtr, int flags);
/* 210 */
TCLAPI void Tcl_RegisterChannel(Tcl_Interp *interp,
Tcl_Channel chan);
/* 211 */
TCLAPI void Tcl_RegisterObjType(const Tcl_ObjType *typePtr);
/* 212 */
TCLAPI Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp,
const char *pattern);
/* 213 */
TCLAPI int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
const char *text, const char *start);
/* 214 */
TCLAPI int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
const char *pattern);
/* 215 */
TCLAPI void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
const char **startPtr, const char **endPtr);
/* 216 */
TCLAPI void Tcl_Release(ClientData clientData);
/* 217 */
TCLAPI void Tcl_ResetResult(Tcl_Interp *interp);
/* 218 */
TCLAPI int Tcl_ScanElement(const char *src, int *flagPtr);
/* 219 */
TCLAPI int Tcl_ScanCountedElement(const char *src, int length,
int *flagPtr);
/* Slot 220 is reserved */
/* 221 */
TCLAPI int Tcl_ServiceAll(void);
/* 222 */
TCLAPI int Tcl_ServiceEvent(int flags);
/* 223 */
TCLAPI void Tcl_SetAssocData(Tcl_Interp *interp,
const char *name, Tcl_InterpDeleteProc *proc,
ClientData clientData);
/* 224 */
TCLAPI void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz);
/* 225 */
TCLAPI int Tcl_SetChannelOption(Tcl_Interp *interp,
Tcl_Channel chan, const char *optionName,
const char *newValue);
/* 226 */
TCLAPI int Tcl_SetCommandInfo(Tcl_Interp *interp,
const char *cmdName,
const Tcl_CmdInfo *infoPtr);
/* 227 */
TCLAPI void Tcl_SetErrno(int err);
/* 228 */
TCLAPI void Tcl_SetErrorCode(Tcl_Interp *interp, ...);
/* 229 */
TCLAPI void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr);
/* Slot 230 is reserved */
/* 231 */
TCLAPI int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
/* 232 */
TCLAPI void Tcl_SetResult(Tcl_Interp *interp, char *result,
Tcl_FreeProc *freeProc);
/* 233 */
TCLAPI int Tcl_SetServiceMode(int mode);
/* 234 */
TCLAPI void Tcl_SetObjErrorCode(Tcl_Interp *interp,
Tcl_Obj *errorObjPtr);
/* 235 */
TCLAPI void Tcl_SetObjResult(Tcl_Interp *interp,
Tcl_Obj *resultObjPtr);
/* 236 */
TCLAPI void Tcl_SetStdChannel(Tcl_Channel channel, int type);
/* Slot 237 is reserved */
/* 238 */
TCLAPI const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, const char *newValue,
int flags);
/* 239 */
TCLAPI const char * Tcl_SignalId(int sig);
/* 240 */
TCLAPI const char * Tcl_SignalMsg(int sig);
/* 241 */
TCLAPI void Tcl_SourceRCFile(Tcl_Interp *interp);
/* 242 */
TCLAPI int Tcl_SplitList(Tcl_Interp *interp,
const char *listStr, int *argcPtr,
const char ***argvPtr);
/* 243 */
TCLAPI void Tcl_SplitPath(const char *path, int *argcPtr,
const char ***argvPtr);
/* 244 */
TCLAPI void Tcl_StaticPackage(Tcl_Interp *interp,
const char *pkgName,
Tcl_PackageInitProc *initProc,
Tcl_PackageInitProc *safeInitProc);
/* 245 */
TCLAPI int Tcl_StringMatch(const char *str, const char *pattern);
/* Slot 246 is reserved */
/* Slot 247 is reserved */
/* 248 */
TCLAPI int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags,
Tcl_VarTraceProc *proc,
ClientData clientData);
/* 249 */
TCLAPI char * Tcl_TranslateFileName(Tcl_Interp *interp,
const char *name, Tcl_DString *bufferPtr);
/* 250 */
TCLAPI int Tcl_Ungets(Tcl_Channel chan, const char *str,
int len, int atHead);
/* 251 */
TCLAPI void Tcl_UnlinkVar(Tcl_Interp *interp,
const char *varName);
/* 252 */
TCLAPI int Tcl_UnregisterChannel(Tcl_Interp *interp,
Tcl_Channel chan);
/* Slot 253 is reserved */
/* 254 */
TCLAPI int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags);
/* Slot 255 is reserved */
/* 256 */
TCLAPI void Tcl_UntraceVar2(Tcl_Interp *interp,
const char *part1, const char *part2,
int flags, Tcl_VarTraceProc *proc,
ClientData clientData);
/* 257 */
TCLAPI void Tcl_UpdateLinkedVar(Tcl_Interp *interp,
const char *varName);
/* Slot 258 is reserved */
/* 259 */
TCLAPI int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
const char *part1, const char *part2,
const char *localName, int flags);
/* Slot 260 is reserved */
/* Slot 261 is reserved */
/* 262 */
TCLAPI ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp,
const char *part1, const char *part2,
int flags, Tcl_VarTraceProc *procPtr,
ClientData prevClientData);
/* 263 */
TCLAPI int Tcl_Write(Tcl_Channel chan, const char *s, int slen);
/* 264 */
TCLAPI void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], const char *message);
/* 265 */
TCLAPI int Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
TCLAPI void Tcl_ValidateAllMemory(const char *file, int line);
/* 267 */
TCLAPI void Tcl_AppendResultVA(Tcl_Interp *interp,
va_list argList);
/* 268 */
TCLAPI void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
va_list argList);
/* 269 */
TCLAPI char * Tcl_HashStats(Tcl_HashTable *tablePtr);
/* 270 */
TCLAPI const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start,
const char **termPtr);
/* Slot 271 is reserved */
/* 272 */
TCLAPI const char * Tcl_PkgPresentEx(Tcl_Interp *interp,
const char *name, const char *version,
int exact, void *clientDataPtr);
/* 273 */
TCLAPI int TclPkgProvide(Tcl_Interp *interp, const char *name,
const char *version);
/* Slot 274 is reserved */
/* 275 */
TCLAPI void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
va_list argList);
/* Slot 276 is reserved */
/* 277 */
TCLAPI Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* 278 */
TCLAPI TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
/* 279 */
TCLAPI void Tcl_GetVersion(int *major, int *minor,
int *patchLevel, int *type);
/* 280 */
TCLAPI void Tcl_InitMemory(Tcl_Interp *interp);
/* 281 */
TCLAPI Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp,
const Tcl_ChannelType *typePtr,
ClientData instanceData, int mask,
Tcl_Channel prevChan);
/* 282 */
TCLAPI int Tcl_UnstackChannel(Tcl_Interp *interp,
Tcl_Channel chan);
/* 283 */
TCLAPI Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan);
/* 284 */
TCLAPI void Tcl_SetMainLoop(Tcl_MainLoopProc *proc);
/* Slot 285 is reserved */
/* 286 */
TCLAPI void Tcl_AppendObjToObj(Tcl_Obj *objPtr,
Tcl_Obj *appendObjPtr);
/* 287 */
TCLAPI Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr);
/* 288 */
TCLAPI void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc,
ClientData clientData);
/* 289 */
TCLAPI void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc,
ClientData clientData);
/* Slot 290 is reserved */
/* 291 */
TCLAPI int Tcl_EvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags);
/* 292 */
TCLAPI int Tcl_EvalObjv(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int flags);
/* 293 */
TCLAPI int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags);
/* 294 */
TCLAPI void Tcl_ExitThread(int status);
/* 295 */
TCLAPI int Tcl_ExternalToUtf(Tcl_Interp *interp,
Tcl_Encoding encoding, const char *src,
int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst,
int dstLen, int *srcReadPtr,
int *dstWrotePtr, int *dstCharsPtr);
/* 296 */
TCLAPI char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
const char *src, int srcLen,
Tcl_DString *dsPtr);
/* 297 */
TCLAPI void Tcl_FinalizeThread(void);
/* 298 */
TCLAPI void Tcl_FinalizeNotifier(ClientData clientData);
/* 299 */
TCLAPI void Tcl_FreeEncoding(Tcl_Encoding encoding);
/* 300 */
TCLAPI Tcl_ThreadId Tcl_GetCurrentThread(void);
/* 301 */
TCLAPI Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
/* 302 */
TCLAPI const char * Tcl_GetEncodingName(Tcl_Encoding encoding);
/* 303 */
TCLAPI void Tcl_GetEncodingNames(Tcl_Interp *interp);
/* 304 */
TCLAPI int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
Tcl_Obj *objPtr, const void *tablePtr,
int offset, const char *msg, int flags,
int *indexPtr);
/* 305 */
TCLAPI void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
int size);
/* 306 */
TCLAPI Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
const char *part2, int flags);
/* 307 */
TCLAPI ClientData Tcl_InitNotifier(void);
/* 308 */
TCLAPI void Tcl_MutexLock(Tcl_Mutex *mutexPtr);
/* 309 */
TCLAPI void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr);
/* 310 */
TCLAPI void Tcl_ConditionNotify(Tcl_Condition *condPtr);
/* 311 */
TCLAPI void Tcl_ConditionWait(Tcl_Condition *condPtr,
Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr);
/* 312 */
TCLAPI int Tcl_NumUtfChars(const char *src, int length);
/* 313 */
TCLAPI int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
int charsToRead, int appendFlag);
/* Slot 314 is reserved */
/* Slot 315 is reserved */
/* 316 */
TCLAPI int Tcl_SetSystemEncoding(Tcl_Interp *interp,
const char *name);
/* 317 */
TCLAPI Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
const char *part2, Tcl_Obj *newValuePtr,
int flags);
/* 318 */
TCLAPI void Tcl_ThreadAlert(Tcl_ThreadId threadId);
/* 319 */
TCLAPI void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
Tcl_Event *evPtr, Tcl_QueuePosition position);
/* 320 */
TCLAPI Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index);
/* 321 */
TCLAPI Tcl_UniChar Tcl_UniCharToLower(int ch);
/* 322 */
TCLAPI Tcl_UniChar Tcl_UniCharToTitle(int ch);
/* 323 */
TCLAPI Tcl_UniChar Tcl_UniCharToUpper(int ch);
/* 324 */
TCLAPI int Tcl_UniCharToUtf(int ch, char *buf);
/* 325 */
TCLAPI const char * Tcl_UtfAtIndex(const char *src, int index);
/* 326 */
TCLAPI int Tcl_UtfCharComplete(const char *src, int length);
/* 327 */
TCLAPI int Tcl_UtfBackslash(const char *src, int *readPtr,
char *dst);
/* 328 */
TCLAPI const char * Tcl_UtfFindFirst(const char *src, int ch);
/* 329 */
TCLAPI const char * Tcl_UtfFindLast(const char *src, int ch);
/* 330 */
TCLAPI const char * Tcl_UtfNext(const char *src);
/* 331 */
TCLAPI const char * Tcl_UtfPrev(const char *src, const char *start);
/* 332 */
TCLAPI int Tcl_UtfToExternal(Tcl_Interp *interp,
Tcl_Encoding encoding, const char *src,
int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst,
int dstLen, int *srcReadPtr,
int *dstWrotePtr, int *dstCharsPtr);
/* 333 */
TCLAPI char * Tcl_UtfToExternalDString(Tcl_Encoding encoding,
const char *src, int srcLen,
Tcl_DString *dsPtr);
/* 334 */
TCLAPI int Tcl_UtfToLower(char *src);
/* 335 */
TCLAPI int Tcl_UtfToTitle(char *src);
/* 336 */
TCLAPI int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr);
/* 337 */
TCLAPI int Tcl_UtfToUpper(char *src);
/* 338 */
TCLAPI int Tcl_WriteChars(Tcl_Channel chan, const char *src,
int srcLen);
/* 339 */
TCLAPI int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
TCLAPI char * Tcl_GetString(Tcl_Obj *objPtr);
/* Slot 341 is reserved */
/* Slot 342 is reserved */
/* 343 */
TCLAPI void Tcl_AlertNotifier(ClientData clientData);
/* 344 */
TCLAPI void Tcl_ServiceModeHook(int mode);
/* 345 */
TCLAPI int Tcl_UniCharIsAlnum(int ch);
/* 346 */
TCLAPI int Tcl_UniCharIsAlpha(int ch);
/* 347 */
TCLAPI int Tcl_UniCharIsDigit(int ch);
/* 348 */
TCLAPI int Tcl_UniCharIsLower(int ch);
/* 349 */
TCLAPI int Tcl_UniCharIsSpace(int ch);
/* 350 */
TCLAPI int Tcl_UniCharIsUpper(int ch);
/* 351 */
TCLAPI int Tcl_UniCharIsWordChar(int ch);
/* 352 */
TCLAPI int Tcl_UniCharLen(const Tcl_UniChar *uniStr);
/* 353 */
TCLAPI int Tcl_UniCharNcmp(const Tcl_UniChar *ucs,
const Tcl_UniChar *uct, size_t numChars);
/* 354 */
TCLAPI char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr,
int uniLength, Tcl_DString *dsPtr);
/* 355 */
TCLAPI Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length,
Tcl_DString *dsPtr);
/* 356 */
TCLAPI Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp,
Tcl_Obj *patObj, int flags);
/* Slot 357 is reserved */
/* 358 */
TCLAPI void Tcl_FreeParse(Tcl_Parse *parsePtr);
/* 359 */
TCLAPI void Tcl_LogCommandInfo(Tcl_Interp *interp,
const char *script, const char *command,
int length);
/* 360 */
TCLAPI int Tcl_ParseBraces(Tcl_Interp *interp,
const char *start, int numBytes,
Tcl_Parse *parsePtr, int append,
const char **termPtr);
/* 361 */
TCLAPI int Tcl_ParseCommand(Tcl_Interp *interp,
const char *start, int numBytes, int nested,
Tcl_Parse *parsePtr);
/* 362 */
TCLAPI int Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
int numBytes, Tcl_Parse *parsePtr);
/* 363 */
TCLAPI int Tcl_ParseQuotedString(Tcl_Interp *interp,
const char *start, int numBytes,
Tcl_Parse *parsePtr, int append,
const char **termPtr);
/* 364 */
TCLAPI int Tcl_ParseVarName(Tcl_Interp *interp,
const char *start, int numBytes,
Tcl_Parse *parsePtr, int append);
/* 365 */
TCLAPI char * Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 366 */
TCLAPI int Tcl_Chdir(const char *dirName);
/* 367 */
TCLAPI int Tcl_Access(const char *path, int mode);
/* 368 */
TCLAPI int Tcl_Stat(const char *path, struct stat *bufPtr);
/* 369 */
TCLAPI int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n);
/* 370 */
TCLAPI int Tcl_UtfNcasecmp(const char *s1, const char *s2,
size_t n);
/* 371 */
TCLAPI int Tcl_StringCaseMatch(const char *str,
const char *pattern, int nocase);
/* 372 */
TCLAPI int Tcl_UniCharIsControl(int ch);
/* 373 */
TCLAPI int Tcl_UniCharIsGraph(int ch);
/* 374 */
TCLAPI int Tcl_UniCharIsPrint(int ch);
/* 375 */
TCLAPI int Tcl_UniCharIsPunct(int ch);
/* 376 */
TCLAPI int Tcl_RegExpExecObj(Tcl_Interp *interp,
Tcl_RegExp regexp, Tcl_Obj *textObj,
int offset, int nmatches, int flags);
/* 377 */
TCLAPI void Tcl_RegExpGetInfo(Tcl_RegExp regexp,
Tcl_RegExpInfo *infoPtr);
/* 378 */
TCLAPI Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode,
int numChars);
/* 379 */
TCLAPI void Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
const Tcl_UniChar *unicode, int numChars);
/* 380 */
TCLAPI int Tcl_GetCharLength(Tcl_Obj *objPtr);
/* 381 */
TCLAPI Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
/* 382 */
TCLAPI Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr);
/* 383 */
TCLAPI Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
/* 384 */
TCLAPI void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
const Tcl_UniChar *unicode, int length);
/* 385 */
TCLAPI int Tcl_RegExpMatchObj(Tcl_Interp *interp,
Tcl_Obj *textObj, Tcl_Obj *patternObj);
/* 386 */
TCLAPI void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr);
/* 387 */
TCLAPI Tcl_Mutex * Tcl_GetAllocMutex(void);
/* 388 */
TCLAPI int Tcl_GetChannelNames(Tcl_Interp *interp);
/* 389 */
TCLAPI int Tcl_GetChannelNamesEx(Tcl_Interp *interp,
const char *pattern);
/* 390 */
TCLAPI int Tcl_ProcObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
/* 391 */
TCLAPI void Tcl_ConditionFinalize(Tcl_Condition *condPtr);
/* 392 */
TCLAPI void Tcl_MutexFinalize(Tcl_Mutex *mutex);
/* 393 */
TCLAPI int Tcl_CreateThread(Tcl_ThreadId *idPtr,
Tcl_ThreadCreateProc *proc,
ClientData clientData, int stackSize,
int flags);
/* 394 */
TCLAPI int Tcl_ReadRaw(Tcl_Channel chan, char *dst,
int bytesToRead);
/* 395 */
TCLAPI int Tcl_WriteRaw(Tcl_Channel chan, const char *src,
int srcLen);
/* 396 */
TCLAPI Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan);
/* 397 */
TCLAPI int Tcl_ChannelBuffered(Tcl_Channel chan);
/* 398 */
TCLAPI const char * Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr);
/* 399 */
TCLAPI Tcl_ChannelTypeVersion Tcl_ChannelVersion(
const Tcl_ChannelType *chanTypePtr);
/* 400 */
TCLAPI Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(
const Tcl_ChannelType *chanTypePtr);
/* 401 */
TCLAPI Tcl_DriverCloseProc * Tcl_ChannelCloseProc(
const Tcl_ChannelType *chanTypePtr);
/* 402 */
TCLAPI Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(
const Tcl_ChannelType *chanTypePtr);
/* 403 */
TCLAPI Tcl_DriverInputProc * Tcl_ChannelInputProc(
const Tcl_ChannelType *chanTypePtr);
/* 404 */
TCLAPI Tcl_DriverOutputProc * Tcl_ChannelOutputProc(
const Tcl_ChannelType *chanTypePtr);
/* 405 */
TCLAPI Tcl_DriverSeekProc * Tcl_ChannelSeekProc(
const Tcl_ChannelType *chanTypePtr);
/* 406 */
TCLAPI Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(
const Tcl_ChannelType *chanTypePtr);
/* 407 */
TCLAPI Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(
const Tcl_ChannelType *chanTypePtr);
/* 408 */
TCLAPI Tcl_DriverWatchProc * Tcl_ChannelWatchProc(
const Tcl_ChannelType *chanTypePtr);
/* 409 */
TCLAPI Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(
const Tcl_ChannelType *chanTypePtr);
/* 410 */
TCLAPI Tcl_DriverFlushProc * Tcl_ChannelFlushProc(
const Tcl_ChannelType *chanTypePtr);
/* 411 */
TCLAPI Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(
const Tcl_ChannelType *chanTypePtr);
/* 412 */
TCLAPI int Tcl_JoinThread(Tcl_ThreadId threadId, int *result);
/* 413 */
TCLAPI int Tcl_IsChannelShared(Tcl_Channel channel);
/* 414 */
TCLAPI int Tcl_IsChannelRegistered(Tcl_Interp *interp,
Tcl_Channel channel);
/* 415 */
TCLAPI void Tcl_CutChannel(Tcl_Channel channel);
/* 416 */
TCLAPI void Tcl_SpliceChannel(Tcl_Channel channel);
/* 417 */
TCLAPI void Tcl_ClearChannelHandlers(Tcl_Channel channel);
/* 418 */
TCLAPI int Tcl_IsChannelExisting(const char *channelName);
/* 419 */
TCLAPI int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
const Tcl_UniChar *uct, size_t numChars);
/* 420 */
TCLAPI int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
const Tcl_UniChar *uniPattern, int nocase);
/* Slot 421 is reserved */
/* Slot 422 is reserved */
/* 423 */
TCLAPI void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
int keyType, const Tcl_HashKeyType *typePtr);
/* 424 */
TCLAPI void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr);
/* 425 */
TCLAPI ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp,
const char *varName, int flags,
Tcl_CommandTraceProc *procPtr,
ClientData prevClientData);
/* 426 */
TCLAPI int Tcl_TraceCommand(Tcl_Interp *interp,
const char *varName, int flags,
Tcl_CommandTraceProc *proc,
ClientData clientData);
/* 427 */
TCLAPI void Tcl_UntraceCommand(Tcl_Interp *interp,
const char *varName, int flags,
Tcl_CommandTraceProc *proc,
ClientData clientData);
/* 428 */
TCLAPI char * Tcl_AttemptAlloc(unsigned int size);
/* 429 */
TCLAPI char * Tcl_AttemptDbCkalloc(unsigned int size,
const char *file, int line);
/* 430 */
TCLAPI char * Tcl_AttemptRealloc(char *ptr, unsigned int size);
/* 431 */
TCLAPI char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
const char *file, int line);
/* 432 */
TCLAPI int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);
/* 433 */
TCLAPI Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
TCLAPI Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
int *lengthPtr);
/* Slot 435 is reserved */
/* Slot 436 is reserved */
/* 437 */
TCLAPI Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags);
/* 438 */
TCLAPI int Tcl_DetachChannel(Tcl_Interp *interp,
Tcl_Channel channel);
/* 439 */
TCLAPI int Tcl_IsStandardChannel(Tcl_Channel channel);
/* 440 */
TCLAPI int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr,
Tcl_Obj *destPathPtr);
/* 441 */
TCLAPI int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr,
Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
/* 442 */
TCLAPI int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr);
/* 443 */
TCLAPI int Tcl_FSDeleteFile(Tcl_Obj *pathPtr);
/* 444 */
TCLAPI int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
const char *sym1, const char *sym2,
Tcl_PackageInitProc **proc1Ptr,
Tcl_PackageInitProc **proc2Ptr,
Tcl_LoadHandle *handlePtr,
Tcl_FSUnloadFileProc **unloadProcPtr);
/* 445 */
TCLAPI int Tcl_FSMatchInDirectory(Tcl_Interp *interp,
Tcl_Obj *result, Tcl_Obj *pathPtr,
const char *pattern, Tcl_GlobTypeData *types);
/* 446 */
TCLAPI Tcl_Obj * Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
int linkAction);
/* 447 */
TCLAPI int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr,
int recursive, Tcl_Obj **errorPtr);
/* 448 */
TCLAPI int Tcl_FSRenameFile(Tcl_Obj *srcPathPtr,
Tcl_Obj *destPathPtr);
/* 449 */
TCLAPI int Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
/* 450 */
TCLAPI int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
/* 451 */
TCLAPI int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index,
Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
/* 452 */
TCLAPI int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index,
Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
/* 453 */
TCLAPI const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
Tcl_Obj **objPtrRef);
/* 454 */
TCLAPI int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
/* 455 */
TCLAPI int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode);
/* 456 */
TCLAPI Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp,
Tcl_Obj *pathPtr, const char *modeString,
int permissions);
/* 457 */
TCLAPI Tcl_Obj * Tcl_FSGetCwd(Tcl_Interp *interp);
/* 458 */
TCLAPI int Tcl_FSChdir(Tcl_Obj *pathPtr);
/* 459 */
TCLAPI int Tcl_FSConvertToPathType(Tcl_Interp *interp,
Tcl_Obj *pathPtr);
/* 460 */
TCLAPI Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, int elements);
/* 461 */
TCLAPI Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
/* 462 */
TCLAPI int Tcl_FSEqualPaths(Tcl_Obj *firstPtr,
Tcl_Obj *secondPtr);
/* 463 */
TCLAPI Tcl_Obj * Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
Tcl_Obj *pathPtr);
/* 464 */
TCLAPI Tcl_Obj * Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
Tcl_Obj *const objv[]);
/* 465 */
TCLAPI ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
const Tcl_Filesystem *fsPtr);
/* 466 */
TCLAPI Tcl_Obj * Tcl_FSGetTranslatedPath(Tcl_Interp *interp,
Tcl_Obj *pathPtr);
/* 467 */
TCLAPI int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName);
/* 468 */
TCLAPI Tcl_Obj * Tcl_FSNewNativePath(
const Tcl_Filesystem *fromFilesystem,
ClientData clientData);
/* 469 */
TCLAPI const void * Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
/* 470 */
TCLAPI Tcl_Obj * Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr);
/* 471 */
TCLAPI Tcl_Obj * Tcl_FSPathSeparator(Tcl_Obj *pathPtr);
/* 472 */
TCLAPI Tcl_Obj * Tcl_FSListVolumes(void);
/* 473 */
TCLAPI int Tcl_FSRegister(ClientData clientData,
const Tcl_Filesystem *fsPtr);
/* 474 */
TCLAPI int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr);
/* 475 */
TCLAPI ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr);
/* 476 */
TCLAPI const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
Tcl_Obj *pathPtr);
/* 477 */
TCLAPI const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
/* 478 */
TCLAPI Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr);
/* 479 */
TCLAPI int Tcl_OutputBuffered(Tcl_Channel chan);
/* 480 */
TCLAPI void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr);
/* 481 */
TCLAPI int Tcl_EvalTokensStandard(Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count);
/* 482 */
TCLAPI void Tcl_GetTime(Tcl_Time *timeBuf);
/* 483 */
TCLAPI Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level,
int flags, Tcl_CmdObjTraceProc *objProc,
ClientData clientData,
Tcl_CmdObjTraceDeleteProc *delProc);
/* 484 */
TCLAPI int Tcl_GetCommandInfoFromToken(Tcl_Command token,
Tcl_CmdInfo *infoPtr);
/* 485 */
TCLAPI int Tcl_SetCommandInfoFromToken(Tcl_Command token,
const Tcl_CmdInfo *infoPtr);
/* 486 */
TCLAPI Tcl_Obj * Tcl_DbNewWideIntObj(Tcl_WideInt wideValue,
const char *file, int line);
/* 487 */
TCLAPI int Tcl_GetWideIntFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
/* 488 */
TCLAPI Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue);
/* 489 */
TCLAPI void Tcl_SetWideIntObj(Tcl_Obj *objPtr,
Tcl_WideInt wideValue);
/* 490 */
TCLAPI Tcl_StatBuf * Tcl_AllocStatBuf(void);
/* 491 */
TCLAPI Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset,
int mode);
/* 492 */
TCLAPI Tcl_WideInt Tcl_Tell(Tcl_Channel chan);
/* 493 */
TCLAPI Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
const Tcl_ChannelType *chanTypePtr);
/* 494 */
TCLAPI int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
Tcl_Obj *keyPtr, Tcl_Obj *valuePtr);
/* 495 */
TCLAPI int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr,
Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr);
/* 496 */
TCLAPI int Tcl_DictObjRemove(Tcl_Interp *interp,
Tcl_Obj *dictPtr, Tcl_Obj *keyPtr);
/* 497 */
TCLAPI int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
int *sizePtr);
/* 498 */
TCLAPI int Tcl_DictObjFirst(Tcl_Interp *interp,
Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr,
Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
int *donePtr);
/* 499 */
TCLAPI void Tcl_DictObjNext(Tcl_DictSearch *searchPtr,
Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
int *donePtr);
/* 500 */
TCLAPI void Tcl_DictObjDone(Tcl_DictSearch *searchPtr);
/* 501 */
TCLAPI int Tcl_DictObjPutKeyList(Tcl_Interp *interp,
Tcl_Obj *dictPtr, int keyc,
Tcl_Obj *const *keyv, Tcl_Obj *valuePtr);
/* 502 */
TCLAPI int Tcl_DictObjRemoveKeyList(Tcl_Interp *interp,
Tcl_Obj *dictPtr, int keyc,
Tcl_Obj *const *keyv);
/* 503 */
TCLAPI Tcl_Obj * Tcl_NewDictObj(void);
/* 504 */
TCLAPI Tcl_Obj * Tcl_DbNewDictObj(const char *file, int line);
/* 505 */
TCLAPI void Tcl_RegisterConfig(Tcl_Interp *interp,
const char *pkgName,
const Tcl_Config *configuration,
const char *valEncoding);
/* 506 */
TCLAPI Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp,
const char *name, ClientData clientData,
Tcl_NamespaceDeleteProc *deleteProc);
/* 507 */
TCLAPI void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
/* 508 */
TCLAPI int Tcl_AppendExportList(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 509 */
TCLAPI int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int resetListFirst);
/* 510 */
TCLAPI int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int allowOverwrite);
/* 511 */
TCLAPI int Tcl_ForgetImport(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, const char *pattern);
/* 512 */
TCLAPI Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp);
/* 513 */
TCLAPI Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp);
/* 514 */
TCLAPI Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 515 */
TCLAPI Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 516 */
TCLAPI Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 517 */
TCLAPI void Tcl_GetCommandFullName(Tcl_Interp *interp,
Tcl_Command command, Tcl_Obj *objPtr);
/* 518 */
TCLAPI int Tcl_FSEvalFileEx(Tcl_Interp *interp,
Tcl_Obj *fileName, const char *encodingName);
/* 519 */
TCLAPI Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
/* 520 */
TCLAPI void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
Tcl_LimitHandlerProc *handlerProc,
ClientData clientData,
Tcl_LimitHandlerDeleteProc *deleteProc);
/* 521 */
TCLAPI void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
Tcl_LimitHandlerProc *handlerProc,
ClientData clientData);
/* 522 */
TCLAPI int Tcl_LimitReady(Tcl_Interp *interp);
/* 523 */
TCLAPI int Tcl_LimitCheck(Tcl_Interp *interp);
/* 524 */
TCLAPI int Tcl_LimitExceeded(Tcl_Interp *interp);
/* 525 */
TCLAPI void Tcl_LimitSetCommands(Tcl_Interp *interp,
int commandLimit);
/* 526 */
TCLAPI void Tcl_LimitSetTime(Tcl_Interp *interp,
Tcl_Time *timeLimitPtr);
/* 527 */
TCLAPI void Tcl_LimitSetGranularity(Tcl_Interp *interp, int type,
int granularity);
/* 528 */
TCLAPI int Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type);
/* 529 */
TCLAPI int Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type);
/* 530 */
TCLAPI void Tcl_LimitTypeSet(Tcl_Interp *interp, int type);
/* 531 */
TCLAPI void Tcl_LimitTypeReset(Tcl_Interp *interp, int type);
/* 532 */
TCLAPI int Tcl_LimitGetCommands(Tcl_Interp *interp);
/* 533 */
TCLAPI void Tcl_LimitGetTime(Tcl_Interp *interp,
Tcl_Time *timeLimitPtr);
/* 534 */
TCLAPI int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type);
/* 535 */
TCLAPI Tcl_InterpState Tcl_SaveInterpState(Tcl_Interp *interp, int status);
/* 536 */
TCLAPI int Tcl_RestoreInterpState(Tcl_Interp *interp,
Tcl_InterpState state);
/* 537 */
TCLAPI void Tcl_DiscardInterpState(Tcl_InterpState state);
/* 538 */
TCLAPI int Tcl_SetReturnOptions(Tcl_Interp *interp,
Tcl_Obj *options);
/* 539 */
TCLAPI Tcl_Obj * Tcl_GetReturnOptions(Tcl_Interp *interp, int result);
/* 540 */
TCLAPI int Tcl_IsEnsemble(Tcl_Command token);
/* 541 */
TCLAPI Tcl_Command Tcl_CreateEnsemble(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *namespacePtr, int flags);
/* 542 */
TCLAPI Tcl_Command Tcl_FindEnsemble(Tcl_Interp *interp,
Tcl_Obj *cmdNameObj, int flags);
/* 543 */
TCLAPI int Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp,
Tcl_Command token, Tcl_Obj *subcmdList);
/* 544 */
TCLAPI int Tcl_SetEnsembleMappingDict(Tcl_Interp *interp,
Tcl_Command token, Tcl_Obj *mapDict);
/* 545 */
TCLAPI int Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp,
Tcl_Command token, Tcl_Obj *unknownList);
/* 546 */
TCLAPI int Tcl_SetEnsembleFlags(Tcl_Interp *interp,
Tcl_Command token, int flags);
/* 547 */
TCLAPI int Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp,
Tcl_Command token, Tcl_Obj **subcmdListPtr);
/* 548 */
TCLAPI int Tcl_GetEnsembleMappingDict(Tcl_Interp *interp,
Tcl_Command token, Tcl_Obj **mapDictPtr);
/* 549 */
TCLAPI int Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp,
Tcl_Command token, Tcl_Obj **unknownListPtr);
/* 550 */
TCLAPI int Tcl_GetEnsembleFlags(Tcl_Interp *interp,
Tcl_Command token, int *flagsPtr);
/* 551 */
TCLAPI int Tcl_GetEnsembleNamespace(Tcl_Interp *interp,
Tcl_Command token,
Tcl_Namespace **namespacePtrPtr);
/* 552 */
TCLAPI void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
Tcl_ScaleTimeProc *scaleProc,
ClientData clientData);
/* 553 */
TCLAPI void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
Tcl_ScaleTimeProc **scaleProc,
ClientData *clientData);
/* 554 */
TCLAPI Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc(
const Tcl_ChannelType *chanTypePtr);
/* 555 */
TCLAPI Tcl_Obj * Tcl_NewBignumObj(mp_int *value);
/* 556 */
TCLAPI Tcl_Obj * Tcl_DbNewBignumObj(mp_int *value, const char *file,
int line);
/* 557 */
TCLAPI void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value);
/* 558 */
TCLAPI int Tcl_GetBignumFromObj(Tcl_Interp *interp,
Tcl_Obj *obj, mp_int *value);
/* 559 */
TCLAPI int Tcl_TakeBignumFromObj(Tcl_Interp *interp,
Tcl_Obj *obj, mp_int *value);
/* 560 */
TCLAPI int Tcl_TruncateChannel(Tcl_Channel chan,
Tcl_WideInt length);
/* 561 */
TCLAPI Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc(
const Tcl_ChannelType *chanTypePtr);
/* 562 */
TCLAPI void Tcl_SetChannelErrorInterp(Tcl_Interp *interp,
Tcl_Obj *msg);
/* 563 */
TCLAPI void Tcl_GetChannelErrorInterp(Tcl_Interp *interp,
Tcl_Obj **msg);
/* 564 */
TCLAPI void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg);
/* 565 */
TCLAPI void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg);
/* 566 */
TCLAPI int Tcl_InitBignumFromDouble(Tcl_Interp *interp,
double initval, mp_int *toInit);
/* 567 */
TCLAPI Tcl_Obj * Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp,
Tcl_Namespace *nsPtr);
/* 568 */
TCLAPI int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr);
/* 569 */
TCLAPI int Tcl_GetEncodingFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr);
/* 570 */
TCLAPI Tcl_Obj * Tcl_GetEncodingSearchPath(void);
/* 571 */
TCLAPI int Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath);
/* 572 */
TCLAPI const char * Tcl_GetEncodingNameFromEnvironment(
Tcl_DString *bufPtr);
/* 573 */
TCLAPI int Tcl_PkgRequireProc(Tcl_Interp *interp,
const char *name, int objc,
Tcl_Obj *const objv[], void *clientDataPtr);
/* 574 */
TCLAPI void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 575 */
TCLAPI void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr,
const char *bytes, int length, int limit,
const char *ellipsis);
/* 576 */
TCLAPI Tcl_Obj * Tcl_Format(Tcl_Interp *interp, const char *format,
int objc, Tcl_Obj *const objv[]);
/* 577 */
TCLAPI int Tcl_AppendFormatToObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, const char *format,
int objc, Tcl_Obj *const objv[]);
/* 578 */
TCLAPI Tcl_Obj * Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 579 */
TCLAPI void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
const char *format, ...) TCL_FORMAT_PRINTF(2, 3);
/* 580 */
TCLAPI int Tcl_CancelEval(Tcl_Interp *interp,
Tcl_Obj *resultObjPtr, ClientData clientData,
int flags);
/* 581 */
TCLAPI int Tcl_Canceled(Tcl_Interp *interp, int flags);
/* 582 */
TCLAPI int Tcl_CreatePipe(Tcl_Interp *interp,
Tcl_Channel *rchan, Tcl_Channel *wchan,
int flags);
/* 583 */
TCLAPI Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp,
const char *cmdName, Tcl_ObjCmdProc *proc,
Tcl_ObjCmdProc *nreProc,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
/* 584 */
TCLAPI int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags);
/* 585 */
TCLAPI int Tcl_NREvalObjv(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int flags);
/* 586 */
TCLAPI int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd,
int objc, Tcl_Obj *const objv[], int flags);
/* 587 */
TCLAPI void Tcl_NRAddCallback(Tcl_Interp *interp,
Tcl_NRPostProc *postProcPtr,
ClientData data0, ClientData data1,
ClientData data2, ClientData data3);
/* 588 */
TCLAPI int Tcl_NRCallObjProc(Tcl_Interp *interp,
Tcl_ObjCmdProc *objProc,
ClientData clientData, int objc,
Tcl_Obj *const objv[]);
/* 589 */
TCLAPI unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr);
/* 590 */
TCLAPI unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr);
/* 591 */
TCLAPI unsigned Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr);
/* 592 */
TCLAPI int Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr);
/* 593 */
TCLAPI int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr);
/* 594 */
TCLAPI int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr);
/* 595 */
TCLAPI int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr);
/* 596 */
TCLAPI Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr);
/* 597 */
TCLAPI Tcl_WideInt Tcl_GetModificationTimeFromStat(
const Tcl_StatBuf *statPtr);
/* 598 */
TCLAPI Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr);
/* 599 */
TCLAPI Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr);
/* 600 */
TCLAPI Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr);
/* 601 */
TCLAPI unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr);
/* 602 */
TCLAPI int Tcl_SetEnsembleParameterList(Tcl_Interp *interp,
Tcl_Command token, Tcl_Obj *paramList);
/* 603 */
TCLAPI int Tcl_GetEnsembleParameterList(Tcl_Interp *interp,
Tcl_Command token, Tcl_Obj **paramListPtr);
/* 604 */
TCLAPI int Tcl_ParseArgsObjv(Tcl_Interp *interp,
const Tcl_ArgvInfo *argTable, int *objcPtr,
Tcl_Obj *const *objv, Tcl_Obj ***remObjv);
/* 605 */
TCLAPI int Tcl_GetErrorLine(Tcl_Interp *interp);
/* 606 */
TCLAPI void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum);
/* 607 */
TCLAPI void Tcl_TransferResult(Tcl_Interp *sourceInterp,
int result, Tcl_Interp *targetInterp);
/* 608 */
TCLAPI int Tcl_InterpActive(Tcl_Interp *interp);
/* 609 */
TCLAPI void Tcl_BackgroundException(Tcl_Interp *interp, int code);
/* 610 */
TCLAPI int Tcl_ZlibDeflate(Tcl_Interp *interp, int format,
Tcl_Obj *data, int level,
Tcl_Obj *gzipHeaderDictObj);
/* 611 */
TCLAPI int Tcl_ZlibInflate(Tcl_Interp *interp, int format,
Tcl_Obj *data, int buffersize,
Tcl_Obj *gzipHeaderDictObj);
/* 612 */
TCLAPI unsigned int Tcl_ZlibCRC32(unsigned int crc,
const unsigned char *buf, int len);
/* 613 */
TCLAPI unsigned int Tcl_ZlibAdler32(unsigned int adler,
const unsigned char *buf, int len);
/* 614 */
TCLAPI int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode,
int format, int level, Tcl_Obj *dictObj,
Tcl_ZlibStream *zshandle);
/* 615 */
TCLAPI Tcl_Obj * Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle);
/* 616 */
TCLAPI int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle);
/* 617 */
TCLAPI int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle);
/* 618 */
TCLAPI int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle,
Tcl_Obj *data, int flush);
/* 619 */
TCLAPI int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle,
Tcl_Obj *data, int count);
/* 620 */
TCLAPI int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle);
/* 621 */
TCLAPI int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle);
/* 622 */
TCLAPI void Tcl_SetStartupScript(Tcl_Obj *path,
const char *encoding);
/* 623 */
TCLAPI Tcl_Obj * Tcl_GetStartupScript(const char **encodingPtr);
/* 624 */
TCLAPI int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan,
int flags);
/* 625 */
TCLAPI int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Obj *resultPtr);
/* 626 */
TCLAPI int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags);
/* 627 */
TCLAPI int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
const char *const symv[], int flags,
void *procPtrs, Tcl_LoadHandle *handlePtr);
/* 628 */
TCLAPI void * Tcl_FindSymbol(Tcl_Interp *interp,
Tcl_LoadHandle handle, const char *symbol);
/* 629 */
TCLAPI int Tcl_FSUnloadFile(Tcl_Interp *interp,
Tcl_LoadHandle handlePtr);
/* 630 */
TCLAPI void Tcl_ZlibStreamSetCompressionDictionary(
Tcl_ZlibStream zhandle,
Tcl_Obj *compressionDictionaryObj);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
const struct TclIntStubs *tclIntStubs;
const struct TclIntPlatStubs *tclIntPlatStubs;
const struct TclOOStubs *tclOOStubs;
const struct TclOOIntStubs *tclOOIntStubs;
} TclStubHooks;
typedef struct TclStubs {
int magic;
const TclStubHooks *hooks;
int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
char * (*tcl_Alloc) (unsigned int size); /* 3 */
void (*tcl_Free) (char *ptr); /* 4 */
char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */
char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */
void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */
char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */
|
| ︙ | ︙ | |||
1875 1876 1877 1878 1879 1880 1881 |
Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */
int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
| | | | 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 |
Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */
int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
void (*reserved36)(void);
int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
|
| ︙ | ︙ | |||
1906 1907 1908 1909 1910 1911 1912 |
void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
| | | | | | | 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 |
void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
void (*reserved67)(void);
void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */
void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */
void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */
int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */
void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
int (*tcl_AsyncReady) (void); /* 75 */
void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
void (*reserved77)(void);
int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
int (*tcl_CommandComplete) (const char *cmd); /* 82 */
char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */
int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */
int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */
int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */
void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
void (*reserved95)(void);
Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */
void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */
|
| ︙ | ︙ | |||
1966 1967 1968 1969 1970 1971 1972 |
void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */
void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */
void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */
void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */
void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 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 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 |
void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */
void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */
void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */
void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */
void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
const char * (*tcl_ErrnoId) (void); /* 127 */
const char * (*tcl_ErrnoMsg) (int err); /* 128 */
void (*reserved129)(void);
void (*reserved130)(void);
void (*reserved131)(void);
void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */
int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */
int (*tcl_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */
int (*tcl_ExprLong) (Tcl_Interp *interp, const char *expr, long *ptr); /* 139 */
int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */
int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
void (*tcl_Finalize) (void); /* 143 */
void (*reserved144)(void);
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */
ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
int (*tcl_GetErrno) (void); /* 161 */
const char * (*tcl_GetHostName) (void); /* 162 */
int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
void (*reserved167)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* MACOSX */
Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */
int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
int (*tcl_GetServiceMode) (void); /* 171 */
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
void (*reserved175)(void);
const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
void (*reserved177)(void);
void (*reserved178)(void);
int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */
int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */
void (*reserved188)(void);
Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */
Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */
Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */
void (*tcl_Preserve) (ClientData data); /* 201 */
void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
int (*tcl_PutEnv) (const char *assignment); /* 203 */
const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
void (*tcl_ReapDetachedProcs) (void); /* 207 */
int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */
int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */
void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 210 */
void (*tcl_RegisterObjType) (const Tcl_ObjType *typePtr); /* 211 */
Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */
int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */
int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */
void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */
void (*tcl_Release) (ClientData clientData); /* 216 */
void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
void (*reserved220)(void);
int (*tcl_ServiceAll) (void); /* 221 */
int (*tcl_ServiceEvent) (int flags); /* 222 */
void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */
int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */
int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */
void (*tcl_SetErrno) (int err); /* 227 */
void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
void (*reserved230)(void);
int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */
int (*tcl_SetServiceMode) (int mode); /* 233 */
void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
void (*reserved237)(void);
const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
const char * (*tcl_SignalId) (int sig); /* 239 */
const char * (*tcl_SignalMsg) (int sig); /* 240 */
void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
void (*reserved246)(void);
void (*reserved247)(void);
int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */
void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
void (*reserved253)(void);
int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
void (*reserved255)(void);
void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
void (*reserved258)(void);
int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */
void (*reserved260)(void);
void (*reserved261)(void);
ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */
void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
void (*reserved271)(void);
const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
int (*tclPkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
void (*reserved274)(void);
void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
void (*reserved276)(void);
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */
Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */
void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */
void (*reserved285)(void);
void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */
Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */
void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */
void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */
void (*reserved290)(void);
int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */
int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */
int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */
void (*tcl_ExitThread) (int status); /* 294 */
int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */
char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */
void (*tcl_FinalizeThread) (void); /* 297 */
void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */
void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */
void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */
ClientData (*tcl_InitNotifier) (void); /* 307 */
void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */
void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */
void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */
void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */
int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */
int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */
void (*reserved314)(void);
void (*reserved315)(void);
int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */
Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */
Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */
Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */
Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */
Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */
int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */
int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
const char * (*tcl_UtfNext) (const char *src); /* 330 */
const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */
int (*tcl_UtfToLower) (char *src); /* 334 */
int (*tcl_UtfToTitle) (char *src); /* 335 */
int (*tcl_UtfToUniChar) (const char *src, Tcl_UniChar *chPtr); /* 336 */
int (*tcl_UtfToUpper) (char *src); /* 337 */
int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
void (*reserved341)(void);
void (*reserved342)(void);
void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
void (*tcl_ServiceModeHook) (int mode); /* 344 */
int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
int (*tcl_UniCharIsDigit) (int ch); /* 347 */
int (*tcl_UniCharIsLower) (int ch); /* 348 */
int (*tcl_UniCharIsSpace) (int ch); /* 349 */
int (*tcl_UniCharIsUpper) (int ch); /* 350 */
int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */
int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 353 */
char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
void (*reserved357)(void);
void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */
int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */
int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */
int (*tcl_Chdir) (const char *dirName); /* 366 */
int (*tcl_Access) (const char *path, int mode); /* 367 */
int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */
int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */
int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */
int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */
int (*tcl_UniCharIsControl) (int ch); /* 372 */
int (*tcl_UniCharIsGraph) (int ch); /* 373 */
int (*tcl_UniCharIsPrint) (int ch); /* 374 */
int (*tcl_UniCharIsPunct) (int ch); /* 375 */
int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */
void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */
|
| ︙ | ︙ | |||
2245 2246 2247 2248 2249 2250 2251 |
void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */
int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */
int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */
Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
| | | | | | | | | 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 |
void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */
int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */
int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */
Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */
Tcl_DriverInputProc * (*tcl_ChannelInputProc) (const Tcl_ChannelType *chanTypePtr); /* 403 */
Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (const Tcl_ChannelType *chanTypePtr); /* 404 */
Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 405 */
Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 406 */
Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 407 */
Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) (const Tcl_ChannelType *chanTypePtr); /* 408 */
Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) (const Tcl_ChannelType *chanTypePtr); /* 409 */
Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) (const Tcl_ChannelType *chanTypePtr); /* 410 */
Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) (const Tcl_ChannelType *chanTypePtr); /* 411 */
int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result); /* 412 */
int (*tcl_IsChannelShared) (Tcl_Channel channel); /* 413 */
int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */
void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */
void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */
void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */
int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */
int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 419 */
int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */
void (*reserved421)(void);
void (*reserved422)(void);
void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */
int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */
void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */
char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */
char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */
char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */
char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */
int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
void (*reserved435)(void);
void (*reserved436)(void);
Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */
int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */
int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */
int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */
int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 444 */
int (*tcl_FSMatchInDirectory) (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); /* 445 */
Tcl_Obj * (*tcl_FSLink) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction); /* 446 */
int (*tcl_FSRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 447 */
int (*tcl_FSRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 448 */
int (*tcl_FSLstat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 449 */
int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */
int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */
int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */
const char *const * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */
int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */
Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */
Tcl_Obj * (*tcl_FSGetCwd) (Tcl_Interp *interp); /* 457 */
int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */
int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */
Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, int elements); /* 460 */
|
| ︙ | ︙ | |||
2324 2325 2326 2327 2328 2329 2330 |
Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */
Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */
Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */
int (*tcl_FSRegister) (ClientData clientData, const Tcl_Filesystem *fsPtr); /* 473 */
int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */
ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */
const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
| | | 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 |
Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */
Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */
Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */
int (*tcl_FSRegister) (ClientData clientData, const Tcl_Filesystem *fsPtr); /* 473 */
int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */
ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */
const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */
int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */
int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 481 */
void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */
Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */
int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */
|
| ︙ | ︙ | |||
2576 2577 2578 2579 2580 2581 2582 | (tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */ #define Tcl_GetByteArrayFromObj \ (tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */ #define Tcl_GetDouble \ (tclStubsPtr->tcl_GetDouble) /* 34 */ #define Tcl_GetDoubleFromObj \ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */ | | < | 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 | (tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */ #define Tcl_GetByteArrayFromObj \ (tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */ #define Tcl_GetDouble \ (tclStubsPtr->tcl_GetDouble) /* 34 */ #define Tcl_GetDoubleFromObj \ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */ /* Slot 36 is reserved */ #define Tcl_GetInt \ (tclStubsPtr->tcl_GetInt) /* 37 */ #define Tcl_GetIntFromObj \ (tclStubsPtr->tcl_GetIntFromObj) /* 38 */ #define Tcl_GetLongFromObj \ (tclStubsPtr->tcl_GetLongFromObj) /* 39 */ #define Tcl_GetObjType \ |
| ︙ | ︙ | |||
2638 2639 2640 2641 2642 2643 2644 | (tclStubsPtr->tcl_SetLongObj) /* 63 */ #define Tcl_SetObjLength \ (tclStubsPtr->tcl_SetObjLength) /* 64 */ #define Tcl_SetStringObj \ (tclStubsPtr->tcl_SetStringObj) /* 65 */ #define Tcl_AddErrorInfo \ (tclStubsPtr->tcl_AddErrorInfo) /* 66 */ | | < < | | 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 | (tclStubsPtr->tcl_SetLongObj) /* 63 */ #define Tcl_SetObjLength \ (tclStubsPtr->tcl_SetObjLength) /* 64 */ #define Tcl_SetStringObj \ (tclStubsPtr->tcl_SetStringObj) /* 65 */ #define Tcl_AddErrorInfo \ (tclStubsPtr->tcl_AddErrorInfo) /* 66 */ /* Slot 67 is reserved */ #define Tcl_AllowExceptions \ (tclStubsPtr->tcl_AllowExceptions) /* 68 */ #define Tcl_AppendElement \ (tclStubsPtr->tcl_AppendElement) /* 69 */ #define Tcl_AppendResult \ (tclStubsPtr->tcl_AppendResult) /* 70 */ #define Tcl_AsyncCreate \ (tclStubsPtr->tcl_AsyncCreate) /* 71 */ #define Tcl_AsyncDelete \ (tclStubsPtr->tcl_AsyncDelete) /* 72 */ #define Tcl_AsyncInvoke \ (tclStubsPtr->tcl_AsyncInvoke) /* 73 */ #define Tcl_AsyncMark \ (tclStubsPtr->tcl_AsyncMark) /* 74 */ #define Tcl_AsyncReady \ (tclStubsPtr->tcl_AsyncReady) /* 75 */ #define Tcl_BackgroundError \ (tclStubsPtr->tcl_BackgroundError) /* 76 */ /* Slot 77 is reserved */ #define Tcl_BadChannelOption \ (tclStubsPtr->tcl_BadChannelOption) /* 78 */ #define Tcl_CallWhenDeleted \ (tclStubsPtr->tcl_CallWhenDeleted) /* 79 */ #define Tcl_CancelIdleCall \ (tclStubsPtr->tcl_CancelIdleCall) /* 80 */ #define Tcl_Close \ |
| ︙ | ︙ | |||
2694 2695 2696 2697 2698 2699 2700 | (tclStubsPtr->tcl_CreateCommand) /* 91 */ #define Tcl_CreateEventSource \ (tclStubsPtr->tcl_CreateEventSource) /* 92 */ #define Tcl_CreateExitHandler \ (tclStubsPtr->tcl_CreateExitHandler) /* 93 */ #define Tcl_CreateInterp \ (tclStubsPtr->tcl_CreateInterp) /* 94 */ | | < | 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 | (tclStubsPtr->tcl_CreateCommand) /* 91 */ #define Tcl_CreateEventSource \ (tclStubsPtr->tcl_CreateEventSource) /* 92 */ #define Tcl_CreateExitHandler \ (tclStubsPtr->tcl_CreateExitHandler) /* 93 */ #define Tcl_CreateInterp \ (tclStubsPtr->tcl_CreateInterp) /* 94 */ /* Slot 95 is reserved */ #define Tcl_CreateObjCommand \ (tclStubsPtr->tcl_CreateObjCommand) /* 96 */ #define Tcl_CreateSlave \ (tclStubsPtr->tcl_CreateSlave) /* 97 */ #define Tcl_CreateTimerHandler \ (tclStubsPtr->tcl_CreateTimerHandler) /* 98 */ #define Tcl_CreateTrace \ |
| ︙ | ︙ | |||
2762 2763 2764 2765 2766 2767 2768 | (tclStubsPtr->tcl_DStringStartSublist) /* 125 */ #define Tcl_Eof \ (tclStubsPtr->tcl_Eof) /* 126 */ #define Tcl_ErrnoId \ (tclStubsPtr->tcl_ErrnoId) /* 127 */ #define Tcl_ErrnoMsg \ (tclStubsPtr->tcl_ErrnoMsg) /* 128 */ | < | < | < | | 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 | (tclStubsPtr->tcl_DStringStartSublist) /* 125 */ #define Tcl_Eof \ (tclStubsPtr->tcl_Eof) /* 126 */ #define Tcl_ErrnoId \ (tclStubsPtr->tcl_ErrnoId) /* 127 */ #define Tcl_ErrnoMsg \ (tclStubsPtr->tcl_ErrnoMsg) /* 128 */ /* Slot 129 is reserved */ /* Slot 130 is reserved */ /* Slot 131 is reserved */ #define Tcl_EventuallyFree \ (tclStubsPtr->tcl_EventuallyFree) /* 132 */ #define Tcl_Exit \ (tclStubsPtr->tcl_Exit) /* 133 */ #define Tcl_ExposeCommand \ (tclStubsPtr->tcl_ExposeCommand) /* 134 */ #define Tcl_ExprBoolean \ |
| ︙ | ︙ | |||
2792 2793 2794 2795 2796 2797 2798 | (tclStubsPtr->tcl_ExprLongObj) /* 140 */ #define Tcl_ExprObj \ (tclStubsPtr->tcl_ExprObj) /* 141 */ #define Tcl_ExprString \ (tclStubsPtr->tcl_ExprString) /* 142 */ #define Tcl_Finalize \ (tclStubsPtr->tcl_Finalize) /* 143 */ | < | | 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 | (tclStubsPtr->tcl_ExprLongObj) /* 140 */ #define Tcl_ExprObj \ (tclStubsPtr->tcl_ExprObj) /* 141 */ #define Tcl_ExprString \ (tclStubsPtr->tcl_ExprString) /* 142 */ #define Tcl_Finalize \ (tclStubsPtr->tcl_Finalize) /* 143 */ /* Slot 144 is reserved */ #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #define Tcl_Flush \ (tclStubsPtr->tcl_Flush) /* 146 */ #define Tcl_FreeResult \ (tclStubsPtr->tcl_FreeResult) /* 147 */ #define Tcl_GetAlias \ |
| ︙ | ︙ | |||
2860 2861 2862 2863 2864 2865 2866 | (tclStubsPtr->tcl_GetServiceMode) /* 171 */ #define Tcl_GetSlave \ (tclStubsPtr->tcl_GetSlave) /* 172 */ #define Tcl_GetStdChannel \ (tclStubsPtr->tcl_GetStdChannel) /* 173 */ #define Tcl_GetStringResult \ (tclStubsPtr->tcl_GetStringResult) /* 174 */ | < | < | < | | 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 | (tclStubsPtr->tcl_GetServiceMode) /* 171 */ #define Tcl_GetSlave \ (tclStubsPtr->tcl_GetSlave) /* 172 */ #define Tcl_GetStdChannel \ (tclStubsPtr->tcl_GetStdChannel) /* 173 */ #define Tcl_GetStringResult \ (tclStubsPtr->tcl_GetStringResult) /* 174 */ /* Slot 175 is reserved */ #define Tcl_GetVar2 \ (tclStubsPtr->tcl_GetVar2) /* 176 */ /* Slot 177 is reserved */ /* Slot 178 is reserved */ #define Tcl_HideCommand \ (tclStubsPtr->tcl_HideCommand) /* 179 */ #define Tcl_Init \ (tclStubsPtr->tcl_Init) /* 180 */ #define Tcl_InitHashTable \ (tclStubsPtr->tcl_InitHashTable) /* 181 */ #define Tcl_InputBlocked \ |
| ︙ | ︙ | |||
2949 2950 2951 2952 2953 2954 2955 | (tclStubsPtr->tcl_Release) /* 216 */ #define Tcl_ResetResult \ (tclStubsPtr->tcl_ResetResult) /* 217 */ #define Tcl_ScanElement \ (tclStubsPtr->tcl_ScanElement) /* 218 */ #define Tcl_ScanCountedElement \ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */ | < | < | < | < | < | < | < | < | < | < | | < | | < | < | | 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 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 | (tclStubsPtr->tcl_Release) /* 216 */ #define Tcl_ResetResult \ (tclStubsPtr->tcl_ResetResult) /* 217 */ #define Tcl_ScanElement \ (tclStubsPtr->tcl_ScanElement) /* 218 */ #define Tcl_ScanCountedElement \ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */ /* Slot 220 is reserved */ #define Tcl_ServiceAll \ (tclStubsPtr->tcl_ServiceAll) /* 221 */ #define Tcl_ServiceEvent \ (tclStubsPtr->tcl_ServiceEvent) /* 222 */ #define Tcl_SetAssocData \ (tclStubsPtr->tcl_SetAssocData) /* 223 */ #define Tcl_SetChannelBufferSize \ (tclStubsPtr->tcl_SetChannelBufferSize) /* 224 */ #define Tcl_SetChannelOption \ (tclStubsPtr->tcl_SetChannelOption) /* 225 */ #define Tcl_SetCommandInfo \ (tclStubsPtr->tcl_SetCommandInfo) /* 226 */ #define Tcl_SetErrno \ (tclStubsPtr->tcl_SetErrno) /* 227 */ #define Tcl_SetErrorCode \ (tclStubsPtr->tcl_SetErrorCode) /* 228 */ #define Tcl_SetMaxBlockTime \ (tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */ /* Slot 230 is reserved */ #define Tcl_SetRecursionLimit \ (tclStubsPtr->tcl_SetRecursionLimit) /* 231 */ #define Tcl_SetResult \ (tclStubsPtr->tcl_SetResult) /* 232 */ #define Tcl_SetServiceMode \ (tclStubsPtr->tcl_SetServiceMode) /* 233 */ #define Tcl_SetObjErrorCode \ (tclStubsPtr->tcl_SetObjErrorCode) /* 234 */ #define Tcl_SetObjResult \ (tclStubsPtr->tcl_SetObjResult) /* 235 */ #define Tcl_SetStdChannel \ (tclStubsPtr->tcl_SetStdChannel) /* 236 */ /* Slot 237 is reserved */ #define Tcl_SetVar2 \ (tclStubsPtr->tcl_SetVar2) /* 238 */ #define Tcl_SignalId \ (tclStubsPtr->tcl_SignalId) /* 239 */ #define Tcl_SignalMsg \ (tclStubsPtr->tcl_SignalMsg) /* 240 */ #define Tcl_SourceRCFile \ (tclStubsPtr->tcl_SourceRCFile) /* 241 */ #define Tcl_SplitList \ (tclStubsPtr->tcl_SplitList) /* 242 */ #define Tcl_SplitPath \ (tclStubsPtr->tcl_SplitPath) /* 243 */ #define Tcl_StaticPackage \ (tclStubsPtr->tcl_StaticPackage) /* 244 */ #define Tcl_StringMatch \ (tclStubsPtr->tcl_StringMatch) /* 245 */ /* Slot 246 is reserved */ /* Slot 247 is reserved */ #define Tcl_TraceVar2 \ (tclStubsPtr->tcl_TraceVar2) /* 248 */ #define Tcl_TranslateFileName \ (tclStubsPtr->tcl_TranslateFileName) /* 249 */ #define Tcl_Ungets \ (tclStubsPtr->tcl_Ungets) /* 250 */ #define Tcl_UnlinkVar \ (tclStubsPtr->tcl_UnlinkVar) /* 251 */ #define Tcl_UnregisterChannel \ (tclStubsPtr->tcl_UnregisterChannel) /* 252 */ /* Slot 253 is reserved */ #define Tcl_UnsetVar2 \ (tclStubsPtr->tcl_UnsetVar2) /* 254 */ /* Slot 255 is reserved */ #define Tcl_UntraceVar2 \ (tclStubsPtr->tcl_UntraceVar2) /* 256 */ #define Tcl_UpdateLinkedVar \ (tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */ /* Slot 258 is reserved */ #define Tcl_UpVar2 \ (tclStubsPtr->tcl_UpVar2) /* 259 */ /* Slot 260 is reserved */ /* Slot 261 is reserved */ #define Tcl_VarTraceInfo2 \ (tclStubsPtr->tcl_VarTraceInfo2) /* 262 */ #define Tcl_Write \ (tclStubsPtr->tcl_Write) /* 263 */ #define Tcl_WrongNumArgs \ (tclStubsPtr->tcl_WrongNumArgs) /* 264 */ #define Tcl_DumpActiveMemory \ (tclStubsPtr->tcl_DumpActiveMemory) /* 265 */ #define Tcl_ValidateAllMemory \ (tclStubsPtr->tcl_ValidateAllMemory) /* 266 */ #define Tcl_AppendResultVA \ (tclStubsPtr->tcl_AppendResultVA) /* 267 */ #define Tcl_AppendStringsToObjVA \ (tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */ #define Tcl_HashStats \ (tclStubsPtr->tcl_HashStats) /* 269 */ #define Tcl_ParseVar \ (tclStubsPtr->tcl_ParseVar) /* 270 */ /* Slot 271 is reserved */ #define Tcl_PkgPresentEx \ (tclStubsPtr->tcl_PkgPresentEx) /* 272 */ #define TclPkgProvide \ (tclStubsPtr->tclPkgProvide) /* 273 */ /* Slot 274 is reserved */ #define Tcl_SetErrorCodeVA \ (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */ /* Slot 276 is reserved */ #define Tcl_WaitPid \ (tclStubsPtr->tcl_WaitPid) /* 277 */ #define Tcl_PanicVA \ (tclStubsPtr->tcl_PanicVA) /* 278 */ #define Tcl_GetVersion \ (tclStubsPtr->tcl_GetVersion) /* 279 */ #define Tcl_InitMemory \ |
| ︙ | ︙ | |||
3088 3089 3090 3091 3092 3093 3094 | (tclStubsPtr->tcl_AppendObjToObj) /* 286 */ #define Tcl_CreateEncoding \ (tclStubsPtr->tcl_CreateEncoding) /* 287 */ #define Tcl_CreateThreadExitHandler \ (tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */ #define Tcl_DeleteThreadExitHandler \ (tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */ | < | | 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 | (tclStubsPtr->tcl_AppendObjToObj) /* 286 */ #define Tcl_CreateEncoding \ (tclStubsPtr->tcl_CreateEncoding) /* 287 */ #define Tcl_CreateThreadExitHandler \ (tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */ #define Tcl_DeleteThreadExitHandler \ (tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */ /* Slot 290 is reserved */ #define Tcl_EvalEx \ (tclStubsPtr->tcl_EvalEx) /* 291 */ #define Tcl_EvalObjv \ (tclStubsPtr->tcl_EvalObjv) /* 292 */ #define Tcl_EvalObjEx \ (tclStubsPtr->tcl_EvalObjEx) /* 293 */ #define Tcl_ExitThread \ |
| ︙ | ︙ | |||
3136 3137 3138 3139 3140 3141 3142 | (tclStubsPtr->tcl_ConditionNotify) /* 310 */ #define Tcl_ConditionWait \ (tclStubsPtr->tcl_ConditionWait) /* 311 */ #define Tcl_NumUtfChars \ (tclStubsPtr->tcl_NumUtfChars) /* 312 */ #define Tcl_ReadChars \ (tclStubsPtr->tcl_ReadChars) /* 313 */ | < | < | | 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 | (tclStubsPtr->tcl_ConditionNotify) /* 310 */ #define Tcl_ConditionWait \ (tclStubsPtr->tcl_ConditionWait) /* 311 */ #define Tcl_NumUtfChars \ (tclStubsPtr->tcl_NumUtfChars) /* 312 */ #define Tcl_ReadChars \ (tclStubsPtr->tcl_ReadChars) /* 313 */ /* Slot 314 is reserved */ /* Slot 315 is reserved */ #define Tcl_SetSystemEncoding \ (tclStubsPtr->tcl_SetSystemEncoding) /* 316 */ #define Tcl_SetVar2Ex \ (tclStubsPtr->tcl_SetVar2Ex) /* 317 */ #define Tcl_ThreadAlert \ (tclStubsPtr->tcl_ThreadAlert) /* 318 */ #define Tcl_ThreadQueueEvent \ |
| ︙ | ︙ | |||
3190 3191 3192 3193 3194 3195 3196 | (tclStubsPtr->tcl_UtfToUpper) /* 337 */ #define Tcl_WriteChars \ (tclStubsPtr->tcl_WriteChars) /* 338 */ #define Tcl_WriteObj \ (tclStubsPtr->tcl_WriteObj) /* 339 */ #define Tcl_GetString \ (tclStubsPtr->tcl_GetString) /* 340 */ | < | < | | 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 | (tclStubsPtr->tcl_UtfToUpper) /* 337 */ #define Tcl_WriteChars \ (tclStubsPtr->tcl_WriteChars) /* 338 */ #define Tcl_WriteObj \ (tclStubsPtr->tcl_WriteObj) /* 339 */ #define Tcl_GetString \ (tclStubsPtr->tcl_GetString) /* 340 */ /* Slot 341 is reserved */ /* Slot 342 is reserved */ #define Tcl_AlertNotifier \ (tclStubsPtr->tcl_AlertNotifier) /* 343 */ #define Tcl_ServiceModeHook \ (tclStubsPtr->tcl_ServiceModeHook) /* 344 */ #define Tcl_UniCharIsAlnum \ (tclStubsPtr->tcl_UniCharIsAlnum) /* 345 */ #define Tcl_UniCharIsAlpha \ |
| ︙ | ︙ | |||
3222 3223 3224 3225 3226 3227 3228 | (tclStubsPtr->tcl_UniCharNcmp) /* 353 */ #define Tcl_UniCharToUtfDString \ (tclStubsPtr->tcl_UniCharToUtfDString) /* 354 */ #define Tcl_UtfToUniCharDString \ (tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */ #define Tcl_GetRegExpFromObj \ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */ | < | | 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 | (tclStubsPtr->tcl_UniCharNcmp) /* 353 */ #define Tcl_UniCharToUtfDString \ (tclStubsPtr->tcl_UniCharToUtfDString) /* 354 */ #define Tcl_UtfToUniCharDString \ (tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */ #define Tcl_GetRegExpFromObj \ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */ /* Slot 357 is reserved */ #define Tcl_FreeParse \ (tclStubsPtr->tcl_FreeParse) /* 358 */ #define Tcl_LogCommandInfo \ (tclStubsPtr->tcl_LogCommandInfo) /* 359 */ #define Tcl_ParseBraces \ (tclStubsPtr->tcl_ParseBraces) /* 360 */ #define Tcl_ParseCommand \ |
| ︙ | ︙ | |||
3350 3351 3352 3353 3354 3355 3356 | (tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */ #define Tcl_IsChannelExisting \ (tclStubsPtr->tcl_IsChannelExisting) /* 418 */ #define Tcl_UniCharNcasecmp \ (tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */ #define Tcl_UniCharCaseMatch \ (tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */ | < | < | | 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 | (tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */ #define Tcl_IsChannelExisting \ (tclStubsPtr->tcl_IsChannelExisting) /* 418 */ #define Tcl_UniCharNcasecmp \ (tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */ #define Tcl_UniCharCaseMatch \ (tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */ /* Slot 421 is reserved */ /* Slot 422 is reserved */ #define Tcl_InitCustomHashTable \ (tclStubsPtr->tcl_InitCustomHashTable) /* 423 */ #define Tcl_InitObjHashTable \ (tclStubsPtr->tcl_InitObjHashTable) /* 424 */ #define Tcl_CommandTraceInfo \ (tclStubsPtr->tcl_CommandTraceInfo) /* 425 */ #define Tcl_TraceCommand \ |
| ︙ | ︙ | |||
3378 3379 3380 3381 3382 3383 3384 | (tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */ #define Tcl_AttemptSetObjLength \ (tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */ #define Tcl_GetChannelThread \ (tclStubsPtr->tcl_GetChannelThread) /* 433 */ #define Tcl_GetUnicodeFromObj \ (tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */ | < | < | | 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 | (tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */ #define Tcl_AttemptSetObjLength \ (tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */ #define Tcl_GetChannelThread \ (tclStubsPtr->tcl_GetChannelThread) /* 433 */ #define Tcl_GetUnicodeFromObj \ (tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */ /* Slot 435 is reserved */ /* Slot 436 is reserved */ #define Tcl_SubstObj \ (tclStubsPtr->tcl_SubstObj) /* 437 */ #define Tcl_DetachChannel \ (tclStubsPtr->tcl_DetachChannel) /* 438 */ #define Tcl_IsStandardChannel \ (tclStubsPtr->tcl_IsStandardChannel) /* 439 */ #define Tcl_FSCopyFile \ |
| ︙ | ︙ | |||
3780 3781 3782 3783 3784 3785 3786 | /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) # undef Tcl_CreateInterp # undef Tcl_FindExecutable # undef Tcl_GetStringResult # undef Tcl_Init | < < < < < < < < < < < < < < < < > > | > | | | > > > > > > > > > > > > > > > > > > < < < < < < < < < < < < < < < < < < | | | < | | > | 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 |
/* !END!: Do not edit above this line. */
#if defined(USE_TCL_STUBS)
# undef Tcl_CreateInterp
# undef Tcl_FindExecutable
# undef Tcl_GetStringResult
# undef Tcl_Init
# undef Tcl_ObjSetVar2
# undef Tcl_StaticPackage
# undef TclFSGetNativePath
# define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
# define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
# define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
# define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
(tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags))
#endif
#if defined(_WIN32) && defined(UNICODE)
# define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
# define Tcl_MainEx Tcl_MainExW
#endif
#define Tcl_PkgPresent(interp, name, version, exact) \
Tcl_PkgPresentEx(interp, name, version, exact, NULL)
#define Tcl_PkgProvide(interp, name, version) \
Tcl_PkgProvideEx(interp, name, version, NULL)
#define Tcl_PkgRequire(interp, name, version, exact) \
Tcl_PkgRequireEx(interp, name, version, exact, NULL)
#define Tcl_Eval(interp,objPtr) \
Tcl_EvalEx((interp),(objPtr),-1,0)
#define Tcl_GlobalEval(interp,objPtr) \
Tcl_EvalEx((interp),(objPtr),-1,TCL_EVAL_GLOBAL)
#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \
Tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), \
sizeof(char *), (msg), (flags), (indexPtr))
#undef Tcl_NewBooleanObj
#define Tcl_NewBooleanObj(boolValue) \
Tcl_NewIntObj((boolValue)!=0)
#undef Tcl_DbNewBooleanObj
#define Tcl_DbNewBooleanObj(boolValue, file, line) \
Tcl_DbNewLongObj((boolValue)!=0, file, line)
#undef Tcl_SetBooleanObj
#define Tcl_SetBooleanObj(objPtr, boolValue) \
Tcl_SetIntObj((objPtr), (boolValue)!=0)
#undef Tcl_AddErrorInfo
#define Tcl_AddErrorInfo(interp, message) \
Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), -1))
#define Tcl_AddObjErrorInfo(interp, message, length) \
Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), length))
#define Tcl_SaveResult(interp, statePtr) \
do { \
*(statePtr) = Tcl_GetObjResult(interp); \
Tcl_IncrRefCount(*(statePtr)); \
Tcl_SetObjResult((interp), Tcl_NewObj()); \
} while(0)
#define Tcl_RestoreResult(interp, statePtr) \
do { \
Tcl_ResetResult(interp); \
Tcl_SetObjResult((interp), *(statePtr)); \
Tcl_DecrRefCount(*(statePtr)); \
} while(0)
#define Tcl_DiscardResult(statePtr) \
Tcl_DecrRefCount(*(statePtr))
#define Tcl_SetVar(interp, varName, newValue, flags) \
Tcl_SetVar2(interp, varName, NULL, newValue, flags)
#define Tcl_UnsetVar(interp, varName, flags) \
Tcl_UnsetVar2(interp, varName, NULL, flags)
#define Tcl_GetVar(interp, varName, flags) \
Tcl_GetVar2(interp, varName, NULL, flags)
#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \
Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData)
#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \
Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData)
#define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \
Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData)
#define Tcl_UpVar(interp, frameName, varName, localName, flags) \
Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags)
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
# if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
* we have to make sure that all stub entries on Cygwin64 follow the
* Win64 signature. Cygwin64 stubbed extensions cannot use those stub
* entries any more, they should use the 64-bit alternatives where
* possible. Tcl 9 must find a better solution, but that cannot be done
* without introducing a binary incompatibility.
*/
# undef Tcl_DbNewLongObj
# undef Tcl_GetLongFromObj
# undef Tcl_NewLongObj
# undef Tcl_SetLongObj
# undef Tcl_ExprLong
# undef Tcl_ExprLongObj
# define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj)
# define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj)
# define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj)
# define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))Tcl_SetWideIntObj)
# define Tcl_ExprLong TclExprLong
static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){
int intValue;
int result = tclStubsPtr->tcl_ExprLong(interp, string, (long *)&intValue);
if (result == TCL_OK) *ptr = (long)intValue;
return result;
}
# define Tcl_ExprLongObj TclExprLongObj
static inline int TclExprLongObj(Tcl_Interp *interp, Tcl_Obj *obj, long *ptr){
int intValue;
int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue);
if (result == TCL_OK) *ptr = (long)intValue;
return result;
}
# endif
#endif
/*
* Deprecated Tcl procedures:
*/
#ifndef TCL_NO_DEPRECATED
# define Tcl_EvalObj(interp,objPtr) \
Tcl_EvalObjEx((interp),(objPtr),0)
# define Tcl_GlobalEvalObj(interp,objPtr) \
Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
#endif /* !TCL_NO_DEPRECATED */
#endif /* _TCLDECLS */
|
Changes to generic/tclDictObj.c.
| ︙ | ︙ | |||
484 485 486 487 488 489 490 |
*----------------------------------------------------------------------
*/
static void
UpdateStringOfDict(
Tcl_Obj *dictPtr)
{
| | | < | 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 |
*----------------------------------------------------------------------
*/
static void
UpdateStringOfDict(
Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
Dict *dict = DICT(dictPtr);
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
int i, length, bytesNeeded = 0;
const char *elem;
char *dst;
/*
* This field is the most useful one in the whole hash structure, and it
* is not exposed by any API function...
*/
int numElems = dict->table.numEntries * 2;
|
| ︙ | ︙ | |||
514 515 516 517 518 519 520 |
/*
* Pass 1: estimate space, gather flags.
*/
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
| < < | | 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 |
/*
* Pass 1: estimate space, gather flags.
*/
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
flagPtr = ckalloc(numElems);
}
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
/*
* Assume that cPtr is never NULL since we know the number of array
* elements already.
*/
|
| ︙ | ︙ | |||
1948 1949 1950 1951 1952 1953 1954 |
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
return TCL_ERROR;
}
result = Tcl_DictObjSize(interp, objv[1], &size);
if (result == TCL_OK) {
| | | 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 |
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
return TCL_ERROR;
}
result = Tcl_DictObjSize(interp, objv[1], &size);
if (result == TCL_OK) {
Tcl_SetObjResult(interp, Tcl_NewLongObj(size));
}
return result;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1990 1991 1992 1993 1994 1995 1996 |
}
dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2,
DICT_PATH_EXISTS);
if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT
|| Tcl_DictObjGet(interp, dictPtr, objv[objc-1],
&valuePtr) != TCL_OK) {
| | | | 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 |
}
dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2,
DICT_PATH_EXISTS);
if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT
|| Tcl_DictObjGet(interp, dictPtr, objv[objc-1],
&valuePtr) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
} else {
Tcl_SetObjResult(interp, Tcl_NewLongObj(valuePtr != NULL));
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
2143 2144 2145 2146 2147 2148 2149 |
if (Tcl_IsShared(valuePtr)) {
valuePtr = Tcl_DuplicateObj(valuePtr);
Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
}
if (objc == 4) {
code = TclIncrObj(interp, valuePtr, objv[3]);
} else {
| | | 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 |
if (Tcl_IsShared(valuePtr)) {
valuePtr = Tcl_DuplicateObj(valuePtr);
Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
}
if (objc == 4) {
code = TclIncrObj(interp, valuePtr, objv[3]);
} else {
Tcl_Obj *incrPtr = Tcl_NewLongObj(1);
Tcl_IncrRefCount(incrPtr);
code = TclIncrObj(interp, valuePtr, incrPtr);
TclDecrRefCount(incrPtr);
}
}
if (code == TCL_OK) {
|
| ︙ | ︙ | |||
2917 2918 2919 2920 2921 2922 2923 |
int index, varc, done, result, satisfied;
const char *pattern;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
return TCL_ERROR;
}
| | | | 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 |
int index, varc, done, result, satisfied;
const char *pattern;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[2], filters,
sizeof(char *), "filterType", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum FilterTypes) index) {
case FILTER_KEYS:
/*
* Create a dictionary whose keys all match a certain pattern.
|
| ︙ | ︙ |
Changes to generic/tclEncoding.c.
| ︙ | ︙ | |||
14 15 16 17 18 19 20 | typedef size_t (LengthProc)(const char *src); /* * The following data structure represents an encoding, which describes how to * convert between various character sets and UTF-8. */ | | | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 |
typedef size_t (LengthProc)(const char *src);
/*
* The following data structure represents an encoding, which describes how to
* convert between various character sets and UTF-8.
*/
typedef struct {
char *name; /* Name of encoding. Malloced because (1) hash
* table entry that owns this encoding may be
* freed prior to this encoding being freed,
* (2) string passed in the Tcl_EncodingType
* structure may not be persistent. */
Tcl_EncodingConvertProc *toUtfProc;
/* Function to convert from external encoding
|
| ︙ | ︙ | |||
53 54 55 56 57 58 59 | /* * The following structure is the clientData for a dynamically-loaded, * table-driven encoding created by LoadTableEncoding(). It maps between * Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only) * encoding. */ | | | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 |
/*
* The following structure is the clientData for a dynamically-loaded,
* table-driven encoding created by LoadTableEncoding(). It maps between
* Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only)
* encoding.
*/
typedef struct {
int fallback; /* Character (in this encoding) to substitute
* when this encoding cannot represent a UTF-8
* character. */
char prefixBytes[256]; /* If a byte in the input stream is a lead
* byte for a 2-byte sequence, the
* corresponding entry in this array is 1,
* otherwise it is 0. */
|
| ︙ | ︙ | |||
87 88 89 90 91 92 93 | * escape-driven encoding that is itself comprised of other simpler encodings. * An example is "iso-2022-jp", which uses escape sequences to switch between * ascii, jis0208, jis0212, gb2312, and ksc5601. Note that "escape-driven" * does not necessarily mean that the ESCAPE character is the character used * for switching character sets. */ | | | | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 |
* escape-driven encoding that is itself comprised of other simpler encodings.
* An example is "iso-2022-jp", which uses escape sequences to switch between
* ascii, jis0208, jis0212, gb2312, and ksc5601. Note that "escape-driven"
* does not necessarily mean that the ESCAPE character is the character used
* for switching character sets.
*/
typedef struct {
unsigned sequenceLen; /* Length of following string. */
char sequence[16]; /* Escape code that marks this encoding. */
char name[32]; /* Name for encoding. */
Encoding *encodingPtr; /* Encoding loaded using above name, or NULL
* if this sub-encoding has not been needed
* yet. */
} EscapeSubTable;
typedef struct {
int fallback; /* Character (in this encoding) to substitute
* when this encoding cannot represent a UTF-8
* character. */
unsigned initLen; /* Length of following string. */
char init[16]; /* String to emit or expect before first char
* in conversion. */
unsigned finalLen; /* Length of following string. */
|
| ︙ | ︙ | |||
670 671 672 673 674 675 676 |
FreeEncoding(Tcl_GetHashValue(hPtr));
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
}
Tcl_DeleteHashTable(&encodingTable);
Tcl_MutexUnlock(&encodingMutex);
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 670 671 672 673 674 675 676 677 678 679 680 681 682 683 |
FreeEncoding(Tcl_GetHashValue(hPtr));
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
}
Tcl_DeleteHashTable(&encodingTable);
Tcl_MutexUnlock(&encodingMutex);
}
/*
*-------------------------------------------------------------------------
*
* Tcl_GetEncoding --
*
* Given the name of a encoding, find the corresponding Tcl_Encoding
|
| ︙ | ︙ |
Changes to generic/tclEnsemble.c.
| ︙ | ︙ | |||
162 163 164 165 166 167 168 |
return TCL_ERROR;
}
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
return TCL_ERROR;
}
| | | | 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 |
return TCL_ERROR;
}
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], ensembleSubcommands,
sizeof(char *), "subcommand", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum EnsSubcmds) index) {
case ENS_CREATE: {
const char *name;
int len, allocatedMapFlag = 0;
|
| ︙ | ︙ | |||
207 208 209 210 211 212 213 |
* Parse the option list, applying type checks as we go. Note that we
* are not incrementing any reference counts in the objects at this
* stage, so the presence of an option multiple times won't cause any
* memory leaks.
*/
for (; objc>1 ; objc-=2,objv+=2) {
| | | | 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 |
* Parse the option list, applying type checks as we go. Note that we
* are not incrementing any reference counts in the objects at this
* stage, so the presence of an option multiple times won't cause any
* memory leaks.
*/
for (; objc>1 ; objc-=2,objv+=2) {
if (Tcl_GetIndexFromObjStruct(interp, objv[0], ensembleCreateOptions,
sizeof(char *), "option", 0, &index) != TCL_OK) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
return TCL_ERROR;
}
switch ((enum EnsCreateOpts) index) {
case CRT_CMD:
|
| ︙ | ︙ | |||
381 382 383 384 385 386 387 |
if (token == NULL) {
return TCL_ERROR;
}
if (objc == 4) {
Tcl_Obj *resultObj = NULL; /* silence gcc 4 warning */
| | | | 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 |
if (token == NULL) {
return TCL_ERROR;
}
if (objc == 4) {
Tcl_Obj *resultObj = NULL; /* silence gcc 4 warning */
if (Tcl_GetIndexFromObjStruct(interp, objv[3], ensembleConfigOptions,
sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum EnsConfigOpts) index) {
case CONF_SUBCMDS:
Tcl_GetEnsembleSubcommandList(NULL, token, &resultObj);
if (resultObj != NULL) {
Tcl_SetObjResult(interp, resultObj);
|
| ︙ | ︙ | |||
502 503 504 505 506 507 508 |
* Parse the option list, applying type checks as we go. Note that
* we are not incrementing any reference counts in the objects at
* this stage, so the presence of an option multiple times won't
* cause any memory leaks.
*/
for (; objc>0 ; objc-=2,objv+=2) {
| | | | 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 |
* Parse the option list, applying type checks as we go. Note that
* we are not incrementing any reference counts in the objects at
* this stage, so the presence of an option multiple times won't
* cause any memory leaks.
*/
for (; objc>0 ; objc-=2,objv+=2) {
if (Tcl_GetIndexFromObjStruct(interp, objv[0],ensembleConfigOptions,
sizeof(char *), "option", 0, &index) != TCL_OK) {
freeMapAndError:
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
return TCL_ERROR;
}
switch ((enum EnsConfigOpts) index) {
|
| ︙ | ︙ |
Changes to generic/tclEvent.c.
| ︙ | ︙ | |||
33 34 35 36 37 38 39 | /* * One of the structures below is associated with the "tclBgError" assoc data * for each interpreter. It keeps track of the head and tail of the list of * pending background errors for the interpreter. */ | | | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
/*
* One of the structures below is associated with the "tclBgError" assoc data
* for each interpreter. It keeps track of the head and tail of the list of
* pending background errors for the interpreter.
*/
typedef struct {
Tcl_Interp *interp; /* Interpreter in which error occurred. */
Tcl_Obj *cmdPrefix; /* First word(s) of the handler command */
BgError *firstBgPtr; /* First in list of all background errors
* waiting to be processed for this
* interpreter (NULL if none). */
BgError *lastBgPtr; /* Last in list of all background errors
* waiting to be processed for this
|
| ︙ | ︙ | |||
1499 1500 1501 1502 1503 1504 1505 |
int flags = 0; /* Initialized to avoid compiler warning. */
static const char *const updateOptions[] = {"idletasks", NULL};
enum updateOptions {OPT_IDLETASKS};
if (objc == 1) {
flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
} else if (objc == 2) {
| | | | 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 |
int flags = 0; /* Initialized to avoid compiler warning. */
static const char *const updateOptions[] = {"idletasks", NULL};
enum updateOptions {OPT_IDLETASKS};
if (objc == 1) {
flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
} else if (objc == 2) {
if (Tcl_GetIndexFromObjStruct(interp, objv[1], updateOptions,
sizeof(char *), "option", 0, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum updateOptions) optionIndex) {
case OPT_IDLETASKS:
flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
break;
default:
|
| ︙ | ︙ |
Changes to generic/tclExecute.c.
| ︙ | ︙ | |||
98 99 100 101 102 103 104 |
#ifdef TCL_COMPILE_STATS
long tclObjsAlloced = 0;
long tclObjsFreed = 0;
long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */
| < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 |
#ifdef TCL_COMPILE_STATS
long tclObjsAlloced = 0;
long tclObjsFreed = 0;
long 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.
*/
typedef struct {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
ptrdiff_t *catchTop; /* These fields are used on return TO this */
Tcl_Obj *auxObjList; /* this level: they record the state when a */
CmdFrame cmdFrame; /* new codePtr was received for NR */
/* execution. */
void *stack[1]; /* Start of the actual combined catch and obj
|
| ︙ | ︙ | |||
321 322 323 324 325 326 327 |
NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
case INST_JUMP_FALSE4: \
NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
case INST_JUMP_TRUE4: \
NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
default: \
if ((condition) < 0) { \
| | | | | | 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 |
NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
case INST_JUMP_FALSE4: \
NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
case INST_JUMP_TRUE4: \
NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
default: \
if ((condition) < 0) { \
TclNewLongObj(objResultPtr, -1); \
} else { \
objResultPtr = TCONST((condition) > 0); \
} \
NEXT_INST_F(0, (cleanup), 1); \
} \
} while (0)
#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
do { \
pc += (pcAdjustment); \
switch (*pc) { \
case INST_JUMP_FALSE1: \
NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
case INST_JUMP_TRUE1: \
NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
case INST_JUMP_FALSE4: \
NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
case INST_JUMP_TRUE4: \
NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
default: \
if ((condition) < 0) { \
TclNewLongObj(objResultPtr, -1); \
} else { \
objResultPtr = TCONST((condition) > 0); \
} \
NEXT_INST_V(0, (cleanup), 1); \
} \
} while (0)
#else /* TCL_COMPILE_DEBUG */
#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
do{ \
if ((condition) < 0) { \
TclNewLongObj(objResultPtr, -1); \
} else { \
objResultPtr = TCONST((condition) > 0); \
} \
NEXT_INST_F((pcAdjustment), (cleanup), 1); \
} while (0)
#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
do{ \
if ((condition) < 0) { \
TclNewLongObj(objResultPtr, -1); \
} else { \
objResultPtr = TCONST((condition) > 0); \
} \
NEXT_INST_V((pcAdjustment), (cleanup), 1); \
} while (0)
#endif
|
| ︙ | ︙ | |||
906 907 908 909 910 911 912 |
* [sizeof(Tcl_Obj*)] */
{
ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
ExecStack *esPtr = ckalloc(sizeof(ExecStack)
+ (size_t) (size-1) * sizeof(Tcl_Obj *));
eePtr->execStackPtr = esPtr;
| | | | 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 |
* [sizeof(Tcl_Obj*)] */
{
ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
ExecStack *esPtr = ckalloc(sizeof(ExecStack)
+ (size_t) (size-1) * sizeof(Tcl_Obj *));
eePtr->execStackPtr = esPtr;
TclNewLongObj(eePtr->constants[0], 0);
Tcl_IncrRefCount(eePtr->constants[0]);
TclNewLongObj(eePtr->constants[1], 1);
Tcl_IncrRefCount(eePtr->constants[1]);
eePtr->interp = interp;
eePtr->callbackPtr = NULL;
eePtr->corPtr = NULL;
eePtr->rewind = 0;
esPtr->prevPtr = NULL;
|
| ︙ | ︙ | |||
2901 2902 2903 2904 2905 2906 2907 | DECACHE_STACK_INFO(); pc += pcAdjustment; TEBC_YIELD(); return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); | < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < | 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 |
DECACHE_STACK_INFO();
pc += pcAdjustment;
TEBC_YIELD();
return TclNREvalObjv(interp, objc, objv,
TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
/*
* INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
* changes to add a ::tcl::mathfunc namespace in 8.5.
*/
case INST_CALL_BUILTIN_FUNC1:
Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
case INST_CALL_FUNC1:
Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
case INST_INVOKE_REPLACE:
objc = TclGetUInt4AtPtr(pc+1);
opnd = TclGetUInt1AtPtr(pc+5);
objPtr = POP_OBJECT();
objv = &OBJ_AT_DEPTH(objc-1);
cleanup = objc;
|
| ︙ | ︙ | |||
4525 4526 4527 4528 4529 4530 4531 |
Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr,
objResultPtr);
}
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
}
case INST_INFO_LEVEL_NUM:
| | | 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 |
Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr,
objResultPtr);
}
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
}
case INST_INFO_LEVEL_NUM:
TclNewLongObj(objResultPtr, iPtr->varFramePtr->level);
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
case INST_INFO_LEVEL_ARGS: {
int level;
register CallFrame *framePtr = iPtr->varFramePtr;
register CallFrame *rootFramePtr = iPtr->rootFramePtr;
|
| ︙ | ︙ | |||
4894 4895 4896 4897 4898 4899 4900 |
case INST_LIST_LENGTH:
TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
| | | 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 |
case INST_LIST_LENGTH:
TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
TclNewLongObj(objResultPtr, length);
TRACE_APPEND(("%d\n", length));
NEXT_INST_F(1, 1, 1);
case INST_LIST_INDEX: /* lindex with objc == 3 */
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
|
| ︙ | ︙ | |||
5365 5366 5367 5368 5369 5370 5371 |
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;
length = Tcl_GetCharLength(valuePtr);
| | | 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 |
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;
length = Tcl_GetCharLength(valuePtr);
TclNewLongObj(objResultPtr, length);
TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
case INST_STR_UPPER:
valuePtr = OBJ_AT_TOS;
TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if (Tcl_IsShared(valuePtr)) {
|
| ︙ | ︙ | |||
5720 5721 5722 5723 5724 5725 5726 |
NEXT_INST_V(1, 3, 1);
case INST_STR_FIND:
match = TclStringFind(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
| | | | 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 |
NEXT_INST_V(1, 3, 1);
case INST_STR_FIND:
match = TclStringFind(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
TclNewLongObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
case INST_STR_FIND_LAST:
match = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
TclNewLongObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
case INST_STR_CLASS:
opnd = TclGetInt1AtPtr(pc+1);
valuePtr = OBJ_AT_TOS;
TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
O2S(valuePtr)));
|
| ︙ | ︙ | |||
5932 5933 5934 5935 5936 5937 5938 |
/* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
Tcl_WideInt w;
if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
type1 = TCL_NUMBER_WIDE;
}
}
| | | 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 |
/* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
Tcl_WideInt w;
if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
type1 = TCL_NUMBER_WIDE;
}
}
TclNewLongObj(objResultPtr, type1);
TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
NEXT_INST_F(1, 1, 1);
case INST_EQ:
case INST_NEQ:
case INST_LT:
case INST_GT:
|
| ︙ | ︙ | |||
6139 6140 6141 6142 6143 6144 6145 |
* 4e9 and the latter 32 or 64...
*/
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
if (l1 > 0L) {
objResultPtr = TCONST(0);
} else {
| | | 6007 6008 6009 6010 6011 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 |
* 4e9 and the latter 32 or 64...
*/
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
if (l1 > 0L) {
objResultPtr = TCONST(0);
} else {
TclNewLongObj(objResultPtr, -1);
}
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
/*
* Handle shifts within the native long range.
|
| ︙ | ︙ | |||
6336 6337 6338 6339 6340 6341 6342 | goto wideResultOfArithmetic; case INST_SUB: w1 = (Tcl_WideInt) l1; w2 = (Tcl_WideInt) l2; wResult = w1 - w2; #ifdef TCL_WIDE_INT_IS_LONG | < < < < < < < < < < | 6204 6205 6206 6207 6208 6209 6210 6211 6212 6213 6214 6215 6216 6217 |
goto wideResultOfArithmetic;
case INST_SUB:
w1 = (Tcl_WideInt) l1;
w2 = (Tcl_WideInt) l2;
wResult = w1 - w2;
#ifdef TCL_WIDE_INT_IS_LONG
if (Overflowing(w1, ~w2, wResult)) {
goto overflow;
}
#endif
wideResultOfArithmetic:
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
if (Tcl_IsShared(valuePtr)) {
|
| ︙ | ︙ | |||
7039 7040 7041 7042 7043 7044 7045 |
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
iPtr->objResultPtr = objPtr;
NEXT_INST_F(1, 0, -1);
case INST_PUSH_RETURN_CODE:
| | | 6897 6898 6899 6900 6901 6902 6903 6904 6905 6906 6907 6908 6909 6910 6911 |
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
iPtr->objResultPtr = objPtr;
NEXT_INST_F(1, 0, -1);
case INST_PUSH_RETURN_CODE:
TclNewLongObj(objResultPtr, result);
TRACE(("=> %u\n", result));
NEXT_INST_F(1, 0, 1);
case INST_PUSH_RETURN_OPTIONS:
DECACHE_STACK_INFO();
objResultPtr = Tcl_GetReturnOptions(interp, result);
CACHE_STACK_INFO();
|
| ︙ | ︙ | |||
9603 9604 9605 9606 9607 9608 9609 |
if (opcode == INST_EXPON) {
operator = "**";
} else if (opcode <= INST_LNOT) {
operator = operatorStrings[opcode - INST_LOR];
}
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
| < < < < < < < < | < | > | 9461 9462 9463 9464 9465 9466 9467 9468 9469 9470 9471 9472 9473 9474 9475 9476 9477 9478 9479 9480 9481 9482 9483 9484 9485 9486 9487 |
if (opcode == INST_EXPON) {
operator = "**";
} else if (opcode <= INST_LNOT) {
operator = operatorStrings[opcode - INST_LOR];
}
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
description = "non-numeric string";
} else if (type == TCL_NUMBER_NAN) {
description = "non-numeric floating-point value";
} else if (type == TCL_NUMBER_DOUBLE) {
description = "floating-point value";
} else {
/* TODO: No caller needs this. Eliminate? */
description = "(big) integer";
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't use %s \"%s\" as operand of \"%s\"", description,
Tcl_GetString(opndPtr), operator));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
}
/*
*----------------------------------------------------------------------
*
* TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --
|
| ︙ | ︙ |
Changes to generic/tclFCmd.c.
| ︙ | ︙ | |||
824 825 826 827 828 829 830 |
};
force = 0;
for (i = 0; i < objc; i++) {
if (TclGetString(objv[i])[0] != '-') {
break;
}
| | | | 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 |
};
force = 0;
for (i = 0; i < objc; i++) {
if (TclGetString(objv[i])[0] != '-') {
break;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
sizeof(char *), "option", TCL_EXACT, &idx) != TCL_OK) {
return -1;
}
if (idx == 0 /* -force */) {
force = 1;
} else { /* -- */
i++;
break;
|
| ︙ | ︙ | |||
1074 1075 1076 1077 1078 1079 1080 | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\", there are no file attributes in this" " filesystem", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL); goto end; } | | | | 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 |
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\", there are no file attributes in this"
" filesystem", TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
goto end;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[0], attributeStrings,
sizeof(char *), "option", INDEX_TEMP_TABLE, &index) != TCL_OK) {
goto end;
}
if (Tcl_FSFileAttrsGet(interp, index, filePtr,
&objPtr) != TCL_OK) {
goto end;
}
Tcl_SetObjResult(interp, objPtr);
|
| ︙ | ︙ | |||
1099 1100 1101 1102 1103 1104 1105 |
"bad option \"%s\", there are no file attributes in this"
" filesystem", TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
goto end;
}
for (i = 0; i < objc ; i += 2) {
| | | > | 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 |
"bad option \"%s\", there are no file attributes in this"
" filesystem", TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
goto end;
}
for (i = 0; i < objc ; i += 2) {
if (Tcl_GetIndexFromObjStruct(interp, objv[i], attributeStrings,
sizeof(char *), "option", INDEX_TEMP_TABLE, &index)
!= TCL_OK) {
goto end;
}
if (i + 1 == objc) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"value for \"%s\" missing", TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
"NOVALUE", NULL);
|
| ︙ | ︙ |
Changes to generic/tclFileName.c.
| ︙ | ︙ | |||
33 34 35 36 37 38 39 40 41 42 43 44 45 46 | Tcl_PathType *typePtr); static int SkipToChar(char **stringPtr, int match); static Tcl_Obj * SplitWinPath(const char *path); static Tcl_Obj * SplitUnixPath(const char *path); static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr, const char *separators, Tcl_Obj *pathPtr, int flags, char *pattern, Tcl_GlobTypeData *types); /* * When there is no support for getting the block size of a file in a stat() * call, use this as a guess. Allow it to be overridden in the platform- * specific files. */ | > > > > > > > > > | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | Tcl_PathType *typePtr); static int SkipToChar(char **stringPtr, int match); static Tcl_Obj * SplitWinPath(const char *path); static Tcl_Obj * SplitUnixPath(const char *path); static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr, const char *separators, Tcl_Obj *pathPtr, int flags, char *pattern, Tcl_GlobTypeData *types); static int TclGlob(Tcl_Interp *interp, char *pattern, Tcl_Obj *pathPrefix, int globFlags, Tcl_GlobTypeData *types); /* Flag values used by TclGlob() */ #define TCL_GLOBMODE_JOIN 2 #define TCL_GLOBMODE_DIR 4 #define TCL_GLOBMODE_TAILS 8 /* * When there is no support for getting the block size of a file in a stat() * call, use this as a guess. Allow it to be overridden in the platform- * specific files. */ |
| ︙ | ︙ | |||
1243 1244 1245 1246 1247 1248 1249 |
Tcl_GlobTypeData *globTypes = NULL;
globFlags = 0;
join = 0;
dir = PATH_NONE;
typePtr = NULL;
for (i = 1; i < objc; i++) {
| | | | 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 |
Tcl_GlobTypeData *globTypes = NULL;
globFlags = 0;
join = 0;
dir = PATH_NONE;
typePtr = NULL;
for (i = 1; i < objc; i++) {
if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
sizeof(char *), "option", 0, &index) != TCL_OK) {
string = TclGetStringFromObj(objv[i], &length);
if (string[0] == '-') {
/*
* It looks like the command contains an option so signal an
* error.
*/
|
| ︙ | ︙ | |||
1266 1267 1268 1269 1270 1271 1272 |
Tcl_ResetResult(interp);
break;
}
}
switch (index) {
case GLOB_NOCOMPLAIN: /* -nocomplain */
| < > > > > | 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 |
Tcl_ResetResult(interp);
break;
}
}
switch (index) {
case GLOB_NOCOMPLAIN: /* -nocomplain */
/*
* Do nothing; This is normal operations in Tcl 9.
* Keep accepting as a no-op option to accommodate old scripts.
*/
break;
case GLOB_DIR: /* -dir */
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-directory\"", -1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
1617 1618 1619 1620 1621 1622 1623 |
globTypes) != TCL_OK) {
result = TCL_ERROR;
goto endOfGlob;
}
}
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 |
globTypes) != TCL_OK) {
result = TCL_ERROR;
goto endOfGlob;
}
}
}
endOfGlob:
if (join || (dir == PATH_GENERAL)) {
Tcl_DStringFree(&prefix);
}
if (pathOrDir != NULL) {
Tcl_DecrRefCount(pathOrDir);
}
|
| ︙ | ︙ | |||
1702 1703 1704 1705 1706 1707 1708 | * Side effects: * The 'pattern' is written to. * *---------------------------------------------------------------------- */ /* ARGSUSED */ | | | 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 |
* Side effects:
* The 'pattern' is written to.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static int
TclGlob(
Tcl_Interp *interp, /* Interpreter for returning error message or
* appending list of matching file names. */
char *pattern, /* Glob pattern to match. Must not refer to a
* static string. */
Tcl_Obj *pathPrefix, /* Path prefix to glob pattern, if non-null,
* which is considered literally. */
|
| ︙ | ︙ |
Changes to generic/tclHash.c.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 | * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" | < < < < < < < | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* * When there are this many entries per bucket, on average, rebuild the hash * table to make it larger. */ #define REBUILD_MULTIPLIER 3 |
| ︙ | ︙ | |||
206 207 208 209 210 211 212 |
} else {
/*
* The caller has not been rebuilt so the hash table is not extended.
*/
}
}
| < < < < < < < < < < < < < < < < < < < < < < < < < | 199 200 201 202 203 204 205 206 207 208 209 210 211 212 |
} else {
/*
* The caller has not been rebuilt so the hash table is not extended.
*/
}
}
static Tcl_HashEntry *
FindHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
const char *key) /* Key to use to find matching entry. */
{
return CreateHashEntry(tablePtr, key, NULL);
}
|
| ︙ | ︙ | |||
261 262 263 264 265 266 267 | * * Side effects: * A new entry may be added to the hash table. * *---------------------------------------------------------------------- */ | < < < < < < < < < < < | 229 230 231 232 233 234 235 236 237 238 239 240 241 242 |
*
* Side effects:
* A new entry may be added to the hash table.
*
*----------------------------------------------------------------------
*/
static Tcl_HashEntry *
CreateHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
const char *key, /* Key to use to find or create matching
* entry. */
int *newPtr) /* Store info here telling whether a new entry
* was created. */
|
| ︙ | ︙ | |||
776 777 778 779 780 781 782 |
static TCL_HASH_TYPE
HashArrayKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
{
register const int *array = (const int *) keyPtr;
| | | | 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 |
static TCL_HASH_TYPE
HashArrayKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
{
register const int *array = (const int *) keyPtr;
register TCL_HASH_TYPE result;
int count;
for (result = 0, count = tablePtr->keyType; count > 0;
count--, array++) {
result += *array;
}
return result;
}
/*
*----------------------------------------------------------------------
*
* AllocStringEntry --
*
|
| ︙ | ︙ | |||
872 873 874 875 876 877 878 |
static TCL_HASH_TYPE
HashStringKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
{
register const char *string = keyPtr;
| | | 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 |
static TCL_HASH_TYPE
HashStringKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
{
register const char *string = keyPtr;
register TCL_HASH_TYPE result;
register char c;
/*
* I tried a zillion different hash functions and asked many other people
* for advice. Many people had their own favorite functions, all
* different, but no-one had much idea why they were good ones. I chose
* the one below (multiply by 9 and add new character) because of the
|
| ︙ | ︙ | |||
912 913 914 915 916 917 918 |
*/
if ((result = UCHAR(*string)) != 0) {
while ((c = *++string) != 0) {
result += (result << 3) + UCHAR(c);
}
}
| | | 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 |
*/
if ((result = UCHAR(*string)) != 0) {
while ((c = *++string) != 0) {
result += (result << 3) + UCHAR(c);
}
}
return result;
}
/*
*----------------------------------------------------------------------
*
* BogusFind --
*
|
| ︙ | ︙ |
Changes to generic/tclHistory.c.
| ︙ | ︙ | |||
70 71 72 73 74 75 76 | * Call Tcl_RecordAndEvalObj to do the actual work. */ cmdPtr = Tcl_NewStringObj(cmd, length); Tcl_IncrRefCount(cmdPtr); result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); | < < < < < < < | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 |
* Call Tcl_RecordAndEvalObj to do the actual work.
*/
cmdPtr = Tcl_NewStringObj(cmd, length);
Tcl_IncrRefCount(cmdPtr);
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
/*
* Discard the Tcl object created to hold the command.
*/
Tcl_DecrRefCount(cmdPtr);
} else {
/*
|
| ︙ | ︙ |
Changes to generic/tclIO.c.
| ︙ | ︙ | |||
112 113 114 115 116 117 118 | * of the following structure. For multi-threaded implementations, there is * one instance of this structure for each thread. * * Notice that different structures with the same name appear in other files. * The structure defined below is used in this file only. */ | | | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 |
* of the following structure. For multi-threaded implementations, there is
* one instance of this structure for each thread.
*
* Notice that different structures with the same name appear in other files.
* The structure defined below is used in this file only.
*/
typedef struct {
NextChannelHandler *nestedHandlerPtr;
/* This variable holds the list of nested
* Tcl_NotifyChannel invocations. */
ChannelState *firstCSPtr; /* List of all channels currently open,
* indexed by ChannelState, as only one
* ChannelState exists per set of stacked
* channels. */
|
| ︙ | ︙ | |||
3040 3041 3042 3043 3044 3045 3046 |
/*
* Some resources can be cleared only if the bottom channel in a stack is
* closed. All the other channels in the stack are not allowed to remove.
*/
if (chanPtr == statePtr->bottomChanPtr) {
if (statePtr->channelName != NULL) {
| | | 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 |
/*
* Some resources can be cleared only if the bottom channel in a stack is
* closed. All the other channels in the stack are not allowed to remove.
*/
if (chanPtr == statePtr->bottomChanPtr) {
if (statePtr->channelName != NULL) {
ckfree((char *)statePtr->channelName);
statePtr->channelName = NULL;
}
Tcl_FreeEncoding(statePtr->encoding);
}
/*
|
| ︙ | ︙ | |||
7123 7124 7125 7126 7127 7128 7129 |
}
return curPos + outputBuffered;
}
/*
*---------------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 7123 7124 7125 7126 7127 7128 7129 7130 7131 7132 7133 7134 7135 7136 |
}
return curPos + outputBuffered;
}
/*
*---------------------------------------------------------------------------
*
* Tcl_TruncateChannel --
*
* Truncate a channel to the given length.
*
* Results:
* TCL_OK on success, TCL_ERROR if the operation failed (e.g. is not
* supported by the type of channel, or the underlying OS operation
|
| ︙ | ︙ | |||
8920 8921 8922 8923 8924 8925 8926 |
static const char *const modeOptions[] = {"readable", "writable", NULL};
static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
return TCL_ERROR;
}
| | | | 8879 8880 8881 8882 8883 8884 8885 8886 8887 8888 8889 8890 8891 8892 8893 8894 |
static const char *const modeOptions[] = {"readable", "writable", NULL};
static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[2], modeOptions,
sizeof(char *), "event name", 0, &modeIndex) != TCL_OK) {
return TCL_ERROR;
}
mask = maskArray[modeIndex];
chanName = TclGetString(objv[1]);
chan = Tcl_GetChannel(interp, chanName, NULL);
if (chan == NULL) {
|
| ︙ | ︙ | |||
9024 9025 9026 9027 9028 9029 9030 | * Side effects: * May schedule a background copy operation that causes both channels to * be marked busy. * *---------------------------------------------------------------------- */ | < < < < < < < < < < < < | 8983 8984 8985 8986 8987 8988 8989 8990 8991 8992 8993 8994 8995 8996 |
* Side effects:
* May schedule a background copy operation that causes both channels to
* be marked busy.
*
*----------------------------------------------------------------------
*/
int
TclCopyChannel(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Channel inChan, /* Channel to read from. */
Tcl_Channel outChan, /* Channel to write to. */
Tcl_WideInt toRead, /* Amount of data to copy, or -1 for all. */
Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */
|
| ︙ | ︙ |
Changes to generic/tclIOCmd.c.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 | #include "tclInt.h" /* * Callback structure for accept callback in a TCP server. */ | | | | 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 |
#include "tclInt.h"
/*
* Callback structure for accept callback in a TCP server.
*/
typedef struct {
Tcl_Obj *script; /* Script to invoke. */
Tcl_Interp *interp; /* Interpreter in which to run it. */
} AcceptCallback;
/*
* Thread local storage used to maintain a per-thread stdout channel obj.
* It must be per-thread because of std channel limitations.
*/
typedef struct {
int initialized; /* Set to 1 when the module is initialized. */
Tcl_Obj *stdoutObjPtr; /* Cached stdout channel Tcl_Obj */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
|
| ︙ | ︙ | |||
134 135 136 137 138 139 140 |
case 4: /* [puts -nonewline $chan $x] or
* [puts $chan $x nonewline] */
newline = 0;
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
chanObjPtr = objv[2];
string = objv[3];
break;
| < < < < < < < < < < < < < | 134 135 136 137 138 139 140 141 142 143 144 145 146 147 |
case 4: /* [puts -nonewline $chan $x] or
* [puts $chan $x nonewline] */
newline = 0;
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
chanObjPtr = objv[2];
string = objv[3];
break;
}
/* Fall through */
default: /* [puts] or
* [puts some bad number of arguments...] */
Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
436 437 438 439 440 441 442 |
* Compute how many bytes to read.
*/
toRead = -1;
if (i < objc) {
if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
|| (toRead < 0)) {
| < < < < < < < < < < < < < < | 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 |
* Compute how many bytes to read.
*/
toRead = -1;
if (i < objc) {
if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
|| (toRead < 0)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected non-negative integer but got \"%s\"",
TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
return TCL_ERROR;
}
}
resultPtr = Tcl_NewObj();
Tcl_IncrRefCount(resultPtr);
TclChannelPreserve(chan);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
|
| ︙ | ︙ |
Changes to generic/tclIORChan.c.
| ︙ | ︙ | |||
230 231 232 233 234 235 236 | * command handler thread (CT), and the thread managing the channel (MT), * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we * forward an operation code, the argument details, and reference to results. * The command is assembled in the CT and belongs fully to that thread. No * sharing problems. */ | | | 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 |
* command handler thread (CT), and the thread managing the channel (MT),
* executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we
* forward an operation code, the argument details, and reference to results.
* The command is assembled in the CT and belongs fully to that thread. No
* sharing problems.
*/
typedef struct {
int code; /* O: Ok/Fail of the cmd handler */
char *msgStr; /* O: Error message for handler failure */
int mustFree; /* O: True if msgStr is allocated, false if
* otherwise (static). */
} ForwardParamBase;
/*
|
| ︙ | ︙ | |||
305 306 307 308 309 310 311 | typedef struct ForwardingResult ForwardingResult; /* * General event structure, with reference to operation specific data. */ | | | 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 |
typedef struct ForwardingResult ForwardingResult;
/*
* General event structure, with reference to operation specific data.
*/
typedef struct {
Tcl_Event event; /* Basic event data, has to be first item */
ForwardingResult *resultPtr;
ForwardedOperation op; /* Forwarded driver operation */
ReflectedChannel *rcPtr; /* Channel instance */
ForwardParam *param; /* Packaged arguments and return values, a
* ForwardParam pointer. */
} ForwardingEvent;
|
| ︙ | ︙ | |||
342 343 344 345 346 347 348 |
int result; /* TCL_OK or TCL_ERROR */
ForwardingEvent *evPtr; /* Event the result belongs to. */
ForwardingResult *prevPtr, *nextPtr;
/* Links into the list of pending forwarded
* results. */
};
| | | 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 |
int result; /* TCL_OK or TCL_ERROR */
ForwardingEvent *evPtr; /* Event the result belongs to. */
ForwardingResult *prevPtr, *nextPtr;
/* Links into the list of pending forwarded
* results. */
};
typedef struct {
/*
* Table of all reflected channels owned by this thread. This is the
* per-thread version of the per-interpreter map.
*/
ReflectedChannelMap *rcmPtr;
} ThreadSpecificData;
|
| ︙ | ︙ | |||
744 745 746 747 748 749 750 | * Side effects: * Posts events to a reflected channel, invokes event handlers. The * latter implies that arbitrary side effects are possible. * *---------------------------------------------------------------------- */ | | | 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 |
* Side effects:
* Posts events to a reflected channel, invokes event handlers. The
* latter implies that arbitrary side effects are possible.
*
*----------------------------------------------------------------------
*/
typedef struct {
Tcl_Event header;
ReflectedChannel *rcPtr;
int events;
} ReflectEvent;
static int
ReflectEventRun(
|
| ︙ | ︙ |
Changes to generic/tclIORTrans.c.
| ︙ | ︙ | |||
83 84 85 86 87 88 89 | }; /* * Structure of the buffer to hold transform results to be consumed by higher * layers upon reading from the channel, plus the functions to manage such. */ | | | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 |
};
/*
* Structure of the buffer to hold transform results to be consumed by higher
* layers upon reading from the channel, plus the functions to manage such.
*/
typedef struct {
unsigned char *buf; /* Reference to the buffer area. */
int allocated; /* Allocated size of the buffer area. */
int used; /* Number of bytes in the buffer,
* <= allocated. */
} ResultBuffer;
#define ResultLength(r) ((r)->used)
|
| ︙ | ︙ | |||
249 250 251 252 253 254 255 | * command handler thread (CT), and the thread managing the channel (MT), * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we * forward an operation code, the argument details, and reference to results. * The command is assembled in the CT and belongs fully to that thread. No * sharing problems. */ | | | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 |
* command handler thread (CT), and the thread managing the channel (MT),
* executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we
* forward an operation code, the argument details, and reference to results.
* The command is assembled in the CT and belongs fully to that thread. No
* sharing problems.
*/
typedef struct {
int code; /* O: Ok/Fail of the cmd handler */
char *msgStr; /* O: Error message for handler failure */
int mustFree; /* O: True if msgStr is allocated, false if
* otherwise (static). */
} ForwardParamBase;
/*
|
| ︙ | ︙ | |||
294 295 296 297 298 299 300 | typedef struct ForwardingResult ForwardingResult; /* * General event structure, with reference to operation specific data. */ | | | 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 |
typedef struct ForwardingResult ForwardingResult;
/*
* General event structure, with reference to operation specific data.
*/
typedef struct {
Tcl_Event event; /* Basic event data, has to be first item */
ForwardingResult *resultPtr;
ForwardedOperation op; /* Forwarded driver operation */
ReflectedTransform *rtPtr; /* Channel instance */
ForwardParam *param; /* Packaged arguments and return values, a
* ForwardParam pointer. */
} ForwardingEvent;
|
| ︙ | ︙ | |||
325 326 327 328 329 330 331 |
int result; /* TCL_OK or TCL_ERROR */
ForwardingEvent *evPtr; /* Event the result belongs to. */
ForwardingResult *prevPtr, *nextPtr;
/* Links into the list of pending forwarded
* results. */
};
| | | 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 |
int result; /* TCL_OK or TCL_ERROR */
ForwardingEvent *evPtr; /* Event the result belongs to. */
ForwardingResult *prevPtr, *nextPtr;
/* Links into the list of pending forwarded
* results. */
};
typedef struct {
/*
* Table of all reflected transformations owned by this thread.
*/
ReflectedTransformMap *rtmPtr;
} ThreadSpecificData;
|
| ︙ | ︙ | |||
611 612 613 614 615 616 617 |
Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
methods = 0;
while (listc > 0) {
| | | | 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 |
Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
methods = 0;
while (listc > 0) {
if (Tcl_GetIndexFromObjStruct(interp, listv[listc-1], methodNames,
sizeof(char *), "method", TCL_EXACT, &methIndex) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned %s",
Tcl_GetString(cmdObj),
Tcl_GetString(Tcl_GetObjResult(interp))));
Tcl_DecrRefCount(resObj);
goto error;
}
|
| ︙ | ︙ |
Changes to generic/tclIOUtil.c.
| ︙ | ︙ | |||
53 54 55 56 57 58 59 | * This structure holds per-thread private copy of the current directory * maintained by the global cwdPathPtr. This structure holds per-thread * private copies of some global data. This way we avoid most of the * synchronization calls which boosts performance, at cost of having to update * this information each time the corresponding epoch counter changes. */ | | | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 |
* This structure holds per-thread private copy of the current directory
* maintained by the global cwdPathPtr. This structure holds per-thread
* private copies of some global data. This way we avoid most of the
* synchronization calls which boosts performance, at cost of having to update
* this information each time the corresponding epoch counter changes.
*/
typedef struct {
int initialized;
size_t cwdPathEpoch;
size_t filesystemEpoch;
Tcl_Obj *cwdPathPtr;
ClientData cwdClientData;
FilesystemRecord *filesystemList;
size_t claims;
|
| ︙ | ︙ | |||
241 242 243 244 245 246 247 | * a file system by way of making a temporary copy of the file on the native * filesystem. We need to store both the actual unloadProc/clientData * combination which was used, and the original and modified filenames, so * that we can correctly undo the entire operation when we want to unload the * code. */ | | | 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 |
* a file system by way of making a temporary copy of the file on the native
* filesystem. We need to store both the actual unloadProc/clientData
* combination which was used, and the original and modified filenames, so
* that we can correctly undo the entire operation when we want to unload the
* code.
*/
typedef struct {
Tcl_LoadHandle loadHandle;
Tcl_FSUnloadFileProc *unloadProcPtr;
Tcl_Obj *divertedFile;
const Tcl_Filesystem *divertedFilesystem;
ClientData divertedFileNativeRep;
} FsDivertLoad;
|
| ︙ | ︙ | |||
407 408 409 410 411 412 413 |
return NULL;
}
Tcl_DStringInit(cwdPtr);
TclDStringAppendObj(cwdPtr, cwd);
Tcl_DecrRefCount(cwd);
return Tcl_DStringValue(cwdPtr);
}
| < < < < < < < < < < < < < < < < | 407 408 409 410 411 412 413 414 415 416 417 418 419 420 |
return NULL;
}
Tcl_DStringInit(cwdPtr);
TclDStringAppendObj(cwdPtr, cwd);
Tcl_DecrRefCount(cwd);
return Tcl_DStringValue(cwdPtr);
}
/*
* Now move on to the basic filesystem implementation.
*/
static void
FsThrExitProc(
|
| ︙ | ︙ | |||
2501 2502 2503 2504 2505 2506 2507 | /* * It's a constant attribute table, so use T_GIFO. */ Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, -1); int result; | | | | 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 |
/*
* It's a constant attribute table, so use T_GIFO.
*/
Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, -1);
int result;
result = Tcl_GetIndexFromObjStruct(NULL, tmpObj, attrTable,
sizeof(char *), NULL, TCL_EXACT, indexPtr);
TclDecrRefCount(tmpObj);
if (listObj != NULL) {
TclDecrRefCount(listObj);
}
return result;
} else if (listObj != NULL) {
/*
|
| ︙ | ︙ |
Changes to generic/tclIndexObj.c.
| ︙ | ︙ | |||
75 76 77 78 79 80 81 | (&(STRING_AT(table, offset))) #define EXPAND_OF(indexRep) \ STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) /* *---------------------------------------------------------------------- * | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 | (&(STRING_AT(table, offset))) #define EXPAND_OF(indexRep) \ STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) /* *---------------------------------------------------------------------- * * GetIndexFromObjList -- * * This procedure looks up an object's value in a table of strings and * returns the index of the matching string, if any. * * Results: * If the value of objPtr is identical to or a unique abbreviation for |
| ︙ | ︙ | |||
584 585 586 587 588 589 590 |
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?options? table string");
return TCL_ERROR;
}
for (i = 1; i < (objc - 2); i++) {
| | | | 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 |
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?options? table string");
return TCL_ERROR;
}
for (i = 1; i < (objc - 2); i++) {
if (Tcl_GetIndexFromObjStruct(interp, objv[i], matchOptions,
sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum matchOptions) index) {
case PRFMATCH_EXACT:
flags |= TCL_EXACT;
break;
case PRFMATCH_MESSAGE:
|
| ︙ | ︙ | |||
654 655 656 657 658 659 660 |
}
if (Tcl_IsShared(errorPtr)) {
errorPtr = Tcl_DuplicateObj(errorPtr);
}
Tcl_ListObjAppendElement(interp, errorPtr,
Tcl_NewStringObj("-code", 5));
| | | 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 |
}
if (Tcl_IsShared(errorPtr)) {
errorPtr = Tcl_DuplicateObj(errorPtr);
}
Tcl_ListObjAppendElement(interp, errorPtr,
Tcl_NewStringObj("-code", 5));
Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewLongObj(result));
return Tcl_SetReturnOptions(interp, errorPtr);
}
result = Tcl_ListObjIndex(interp, tablePtr, index, &resultPtr);
if (result != TCL_OK) {
return result;
|
| ︙ | ︙ | |||
870 871 872 873 874 875 876 |
Tcl_Obj *const objv[], /* Initial argument objects, which should be
* included in the error message. */
const char *message) /* Error message to print after the leading
* objects in objv. The message may be
* NULL. */
{
Tcl_Obj *objPtr;
| | > < < < < < < < < < < < < < < < < < < < < < < < | 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 |
Tcl_Obj *const objv[], /* Initial argument objects, which should be
* included in the error message. */
const char *message) /* Error message to print after the leading
* objects in objv. The message may be
* NULL. */
{
Tcl_Obj *objPtr;
int i, len, elemLen;
char flags;
Interp *iPtr = (Interp *) interp;
const char *elementStr;
TclNewObj(objPtr);
if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
Tcl_AppendToObj(objPtr, " or \"", -1);
} else {
Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
|
| ︙ | ︙ | |||
963 964 965 966 967 968 969 |
elemLen = strlen(elementStr);
} else {
elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
}
flags = 0;
len = TclScanElement(elementStr, elemLen, &flags);
| | < < | 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 |
elemLen = strlen(elementStr);
} else {
elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
}
flags = 0;
len = TclScanElement(elementStr, elemLen, &flags);
if (len != elemLen) {
char *quotedElementStr = TclStackAlloc(interp,
(unsigned)len + 1);
len = TclConvertElement(elementStr, elemLen,
quotedElementStr, flags);
Tcl_AppendToObj(objPtr, quotedElementStr, len);
TclStackFree(interp, quotedElementStr);
} else {
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
/*
* Add a space if the word is not the last one (which has a
* moderately complex condition here).
*/
if (i<toPrint-1 || objc!=0 || message!=NULL) {
Tcl_AppendStringsToObj(objPtr, " ", NULL);
|
| ︙ | ︙ | |||
1014 1015 1016 1017 1018 1019 1020 | * Quote the argument if it contains spaces (Bug 942757). */ elementStr = TclGetStringFromObj(objv[i], &elemLen); flags = 0; len = TclScanElement(elementStr, elemLen, &flags); | | < < | 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 |
* Quote the argument if it contains spaces (Bug 942757).
*/
elementStr = TclGetStringFromObj(objv[i], &elemLen);
flags = 0;
len = TclScanElement(elementStr, elemLen, &flags);
if (len != elemLen) {
char *quotedElementStr = TclStackAlloc(interp,
(unsigned) len + 1);
len = TclConvertElement(elementStr, elemLen,
quotedElementStr, flags);
Tcl_AppendToObj(objPtr, quotedElementStr, len);
TclStackFree(interp, quotedElementStr);
} else {
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
}
/*
* Append a space character (" ") if there is more text to follow
* (either another element from objv, or the message string).
*/
if (i<objc-1 || message!=NULL) {
Tcl_AppendStringsToObj(objPtr, " ", NULL);
|
| ︙ | ︙ | |||
1051 1052 1053 1054 1055 1056 1057 |
if (message != NULL) {
Tcl_AppendStringsToObj(objPtr, message, NULL);
}
Tcl_AppendStringsToObj(objPtr, "\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
Tcl_SetObjResult(interp, objPtr);
| < < | 963 964 965 966 967 968 969 970 971 972 973 974 975 976 |
if (message != NULL) {
Tcl_AppendStringsToObj(objPtr, message, NULL);
}
Tcl_AppendStringsToObj(objPtr, "\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
Tcl_SetObjResult(interp, objPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_ParseArgsObjv --
*
|
| ︙ | ︙ | |||
1453 1454 1455 1456 1457 1458 1459 |
"ok", "error", "return", "break", "continue", NULL
};
if ((value->typePtr != &indexType)
&& TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
return TCL_OK;
}
| | | | 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 |
"ok", "error", "return", "break", "continue", NULL
};
if ((value->typePtr != &indexType)
&& TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
return TCL_OK;
}
if (Tcl_GetIndexFromObjStruct(NULL, value, returnCodes,
sizeof(char *), NULL, TCL_EXACT, codePtr) == TCL_OK) {
return TCL_OK;
}
/*
* Value is not a legal completion code.
*/
|
| ︙ | ︙ |
Changes to generic/tclInt.decls.
| ︙ | ︙ | |||
46 47 48 49 50 51 52 |
}
declare 6 {
void TclCleanupCommand(Command *cmdPtr)
}
declare 7 {
int TclCopyAndCollapse(int count, const char *src, char *dst)
}
| > | | | < > | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 |
}
declare 6 {
void TclCleanupCommand(Command *cmdPtr)
}
declare 7 {
int TclCopyAndCollapse(int count, const char *src, char *dst)
}
# Removed in Tcl 9
#declare 8 {
# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
#}
# TclCreatePipeline unofficially exported for use by BLT.
declare 9 {
int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv,
Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr,
TclFile *errFilePtr)
|
| ︙ | ︙ | |||
179 180 181 182 183 184 185 |
declare 40 {
int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr)
}
declare 41 {
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
| | | | 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 |
declare 40 {
int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr)
}
declare 41 {
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
}
# Removed in Tcl 8.5a2
#declare 43 {
# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
# int flags)
#}
declare 44 {
int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr)
}
declare 45 {
int TclHideUnsafeCommands(Tcl_Interp *interp)
|
| ︙ | ︙ | |||
218 219 220 221 222 223 224 |
Namespace *nsPtr)
}
declare 51 {
int TclInterpInit(Tcl_Interp *interp)
}
# Removed in Tcl 8.5a2
#declare 52 {
| | | | 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 |
Namespace *nsPtr)
}
declare 51 {
int TclInterpInit(Tcl_Interp *interp)
}
# Removed in Tcl 8.5a2
#declare 52 {
# int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
# int flags)
#}
declare 53 {
int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
int argc, const char **argv)
}
declare 54 {
int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[])
}
declare 55 {
Proc *TclIsProc(Command *cmdPtr)
|
| ︙ | ︙ | |||
310 311 312 313 314 315 316 |
declare 75 {
unsigned long TclpGetClicks(void)
}
declare 76 {
unsigned long TclpGetSeconds(void)
}
| | | | < > | 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 |
declare 75 {
unsigned long TclpGetClicks(void)
}
declare 76 {
unsigned long TclpGetSeconds(void)
}
# Removed in 9.0:
#declare 77 {
# void TclpGetTime(Tcl_Time *time)
#}
# Removed in 8.6:
#declare 78 {
# int TclpGetTimeZone(unsigned long time)
#}
# Replaced by Tcl_FSListVolumes in 8.4:
#declare 79 {
# int TclpListVolumes(Tcl_Interp *interp)
|
| ︙ | ︙ | |||
406 407 408 409 410 411 412 |
#}
# Removed in 8.4b2:
#declare 100 {
# Tcl_Obj *TclSetIndexedScalar(Tcl_Interp *interp, int localIndex,
# Tcl_Obj *objPtr, int flags)
#}
declare 101 {
| | > | | < > | 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 |
#}
# Removed in 8.4b2:
#declare 100 {
# Tcl_Obj *TclSetIndexedScalar(Tcl_Interp *interp, int localIndex,
# Tcl_Obj *objPtr, int flags)
#}
declare 101 {
const char *TclSetPreInitScript(const char *string)
}
declare 102 {
void TclSetupEnv(Tcl_Interp *interp)
}
declare 103 {
int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
int *portPtr)
}
# Removed in Tcl 9
#declare 104 {
# int TclSockMinimumBuffersOld(int sock, int size)
#}
# Replaced by Tcl_FSStat in 8.4:
#declare 105 {
# int TclStat(const char *path, Tcl_StatBuf *buf)
#}
#declare 106 {
# int TclStatDeleteProc(TclStatProc_ *proc)
#}
|
| ︙ | ︙ | |||
450 451 452 453 454 455 456 |
# defined here instead of in tcl.decls since they are not stable yet.
declare 111 {
void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name,
Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
| > | | | < > > | | | < > > | | < > > | | | < > > | | | < > > | | | < > > | | | < > > | | < > > | | | < > > | | < > > | | < > > | | | < > > | | < > | | | 452 453 454 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 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 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 579 580 581 582 583 584 585 586 587 |
# defined here instead of in tcl.decls since they are not stable yet.
declare 111 {
void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name,
Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
# Removed in 9.0:
#declare 112 {
# int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 113 {
# Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
# ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
#}
# Removed in 9.0:
#declare 114 {
# void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
#}
# Removed in 9.0:
#declare 115 {
# int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# const char *pattern, int resetListFirst)
#}
# Removed in 9.0:
#declare 116 {
# Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
# Tcl_Namespace *contextNsPtr, int flags)
#}
# Removed in 9.0:
#declare 117 {
# Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
# Tcl_Namespace *contextNsPtr, int flags)
#}
declare 118 {
int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name,
Tcl_ResolverInfo *resInfo)
}
declare 119 {
int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr,
Tcl_ResolverInfo *resInfo)
}
declare 120 {
Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
# Removed in 9.0:
#declare 121 {
# int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# const char *pattern)
#}
# Removed in 9.0:
#declare 122 {
# Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 123 {
# void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
# Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 124 {
# Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
#}
# Removed in 9.0:
#declare 125 {
# Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
#}
declare 126 {
void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
Tcl_Obj *objPtr)
}
# Removed in 9.0:
#declare 127 {
# int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# const char *pattern, int allowOverwrite)
#}
declare 128 {
void Tcl_PopCallFrame(Tcl_Interp *interp)
}
declare 129 {
int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr,
Tcl_Namespace *nsPtr, int isProcCallFrame)
}
declare 130 {
int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, const char *name)
}
declare 131 {
void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr,
Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 132 {
int TclpHasSockets(Tcl_Interp *interp)
}
# Removed in 9.0
#declare 133 {
# struct tm *TclpGetDate(const time_t *time, int useGMT)
#}
# Removed in 8.5
#declare 134 {
# size_t TclpStrftime(char *s, size_t maxsize, const char *format,
# const struct tm *t, int useGMT)
#}
#declare 135 {
# int TclpCheckStackSpace(void)
#}
# Added in 8.1:
#declare 137 {
# int TclpChdir(const char *dirName)
#}
declare 138 {
const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
#declare 139 {
# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
# char *sym2, Tcl_PackageInitProc **proc1Ptr,
# Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr)
#}
#declare 140 {
# int TclLooksLikeInt(const char *bytes, int length)
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
CompileHookProc *hookProc, ClientData clientData)
}
declare 143 {
int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr,
|
| ︙ | ︙ | |||
621 622 623 624 625 626 627 |
declare 156 {
void TclRegError(Tcl_Interp *interp, const char *msg,
int status)
}
declare 157 {
Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
| | | | < > | | | < > | 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 |
declare 156 {
void TclRegError(Tcl_Interp *interp, const char *msg,
int status)
}
declare 157 {
Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
# REMOVED - use public Tcl_SetStartupScript()
#declare 158 {
# void TclSetStartupScriptFileName(const char *filename)
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 159 {
# const char *TclGetStartupScriptFileName(void)
#}
#declare 160 {
# int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
# Tcl_DString *dirPtr, char *pattern, char *tail,
# GlobTypeData *types)
#}
# new in 8.3.2/8.4a2
|
| ︙ | ︙ | |||
673 674 675 676 677 678 679 |
# New function due to TIP #33
declare 166 {
int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
int index, Tcl_Obj *valuePtr)
}
# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
| | | | < > | | | < > | | 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 |
# New function due to TIP #33
declare 166 {
int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
int index, Tcl_Obj *valuePtr)
}
# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
# REMOVED - use public Tcl_SetStartupScript()
#declare 167 {
# void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 168 {
# Tcl_Obj *TclGetStartupScriptPath(void)
#}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
declare 169 {
int TclpUtfNcmp2(const char *s1, const char *s2, size_t n)
}
declare 170 {
int TclCheckInterpTraces(Tcl_Interp *interp, const char *command,
int numChars, Command *cmdPtr, int result, int traceFlags,
int objc, Tcl_Obj *const objv[])
}
declare 171 {
|
| ︙ | ︙ | |||
726 727 728 729 730 731 732 |
declare 176 {
void TclCleanupVar(Var *varPtr, Var *arrayPtr)
}
declare 177 {
void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
const char *operation, const char *reason)
}
| | | | < > | | < > < | | | < > > | | < > | 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 |
declare 176 {
void TclCleanupVar(Var *varPtr, Var *arrayPtr)
}
declare 177 {
void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
const char *operation, const char *reason)
}
# TIP 338 made these public - now declared in tcl.h
#declare 178 {
# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
#}
#declare 179 {
# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
#}
# REMOVED
# Allocate lists without copying arrays
# declare 180 {
# Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv)
# }
#declare 181 {
# Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv,
# const char *file, int line)
#}
# Removed in 9.0
#declare 182 {
# struct tm *TclpLocaltime(const time_t *clock)
#}
# Removed in 9.0
#declare 183 {
# struct tm *TclpGmtime(const time_t *clock)
#}
# For the new "Thread Storage" subsystem.
### REMOVED on grounds it should never have been exposed. All these
### functions are now either static in tclThreadStorage.c or
### MODULE_SCOPE.
# declare 184 {
|
| ︙ | ︙ | |||
936 937 938 939 940 941 942 |
}
declare 235 {
void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}
# TIP 337 made this one public
| | | < > | 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 |
}
declare 235 {
void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}
# TIP 337 made this one public
#declare 236 {
# void TclBackgroundException(Tcl_Interp *interp, int code)
#}
# TIP #285: Script cancellation support.
declare 237 {
int TclResetCancellation(Tcl_Interp *interp, int force)
}
# NRE functions for "rogue" extensions to exploit NRE; they will need to
|
| ︙ | ︙ | |||
1021 1022 1023 1024 1025 1026 1027 |
################################
# Windows specific functions
declare 0 win {
void TclWinConvertError(DWORD errCode)
}
| > | | < > > | | | < > > | | | < > > | | < > > | | | < > | | | < > | 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 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 |
################################
# Windows specific functions
declare 0 win {
void TclWinConvertError(DWORD errCode)
}
# Removed in Tcl 9.0
#declare 1 win {
# void TclWinConvertWSAError(DWORD errCode)
#}
# Removed in Tcl 9.0
#declare 2 win {
# struct servent *TclWinGetServByName(const char *nm,
# const char *proto)
#}
# Removed in Tcl 9.0
#declare 3 win {
# int TclWinGetSockOpt(SOCKET s, int level, int optname,
# char *optval, int *optlen)
#}
declare 4 win {
HINSTANCE TclWinGetTclInstance(void)
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 5 win {
int TclUnixWaitForFile(int fd, int mask, int timeout)
}
# Removed in 8.1:
# declare 5 win {
# HINSTANCE TclWinLoadLibrary(char *name)
# }
# Removed in 8.1:
#declare 6 win {
# unsigned short TclWinNToHS(unsigned short ns)
#}
# Removed in Tcl 9.0
#declare 7 win {
# int TclWinSetSockOpt(SOCKET s, int level, int optname,
# const char *optval, int optlen)
#}
declare 8 win {
int TclpGetPid(Tcl_Pid pid)
}
declare 9 win {
int TclWinGetPlatformId(void)
}
# Removed in Tcl 9.0
#declare 10 win {
# Tcl_DirEntry *TclpReaddir(DIR *dir)
#}
# Removed in 8.3.1 (for Win32s only)
#declare 10 win {
# int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
#}
# Pipe channel functions
|
| ︙ | ︙ | |||
1110 1111 1112 1113 1114 1115 1116 |
}
declare 19 win {
TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
void TclWinAddProcess(HANDLE hProcess, DWORD id)
}
| | | | < > | 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 |
}
declare 19 win {
TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
void TclWinAddProcess(HANDLE hProcess, DWORD id)
}
# Removed in Tcl 9.0
#declare 21 win {
# char *TclpInetNtoa(struct in_addr addr)
#}
# removed permanently for 8.4
#declare 21 win {
# void TclpAsyncMark(Tcl_AsyncHandler async)
#}
# Added in 8.1:
declare 22 win {
|
| ︙ | ︙ | |||
1195 1196 1197 1198 1199 1200 1201 |
declare 9 unix {
TclFile TclpCreateTempFile(const char *contents)
}
# Added in 8.4:
| > | | < < | | | < > | | < > | | < > | 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 |
declare 9 unix {
TclFile TclpCreateTempFile(const char *contents)
}
# Added in 8.4:
# Removed in Tcl 9.0
#declare 10 unix {
# Tcl_DirEntry *TclpReaddir(DIR *dir)
#}
#declare 11 unix {
# struct tm *TclpLocaltime_unix(const time_t *clock)
#}
#declare 12 unix {
# struct tm *TclpGmtime_unix(const time_t *clock)
#}
#declare 13 unix {
# char *TclpInetNtoa(struct in_addr addr)
#}
# Added in 8.5:
declare 14 unix {
int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
}
|
| ︙ | ︙ |
Changes to generic/tclInt.h.
| ︙ | ︙ | |||
21 22 23 24 25 26 27 | /* * Some numerics configuration options. */ #undef ACCEPT_NAN | < < < < < < < < < < < < < | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | /* * Some numerics configuration options. */ #undef ACCEPT_NAN /* * Common include files needed by most of the Tcl source files are included * here, so that system-dependent personalizations for the include files only * have to be made in once place. This results in a few extra includes, but * greater modularity. The order of the three groups of #includes is * important. For example, stdio.h is needed by tcl.h. */ |
| ︙ | ︙ | |||
156 157 158 159 160 161 162 |
typedef struct Tcl_ResolvedVarInfo {
Tcl_ResolveRuntimeVarProc *fetchProc;
Tcl_ResolveVarDeleteProc *deleteProc;
} Tcl_ResolvedVarInfo;
typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
| | | | | 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 |
typedef struct Tcl_ResolvedVarInfo {
Tcl_ResolveRuntimeVarProc *fetchProc;
Tcl_ResolveVarDeleteProc *deleteProc;
} Tcl_ResolvedVarInfo;
typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
const char *name, int length, Tcl_Namespace *context,
Tcl_ResolvedVarInfo **rPtr);
typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, const char *name,
Tcl_Namespace *context, int flags, Tcl_Var *rPtr);
typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, const char *name,
Tcl_Namespace *context, int flags, Tcl_Command *rPtr);
typedef struct Tcl_ResolverInfo {
Tcl_ResolveCmdProc *cmdResProc;
/* Procedure handling command name
* resolution. */
Tcl_ResolveVarProc *varResProc;
|
| ︙ | ︙ | |||
1768 1769 1770 1771 1772 1773 1774 1775 |
* plus other state information related to interpreting commands, such as
* variable storage. Primary responsibility for this data structure is in
* tclBasic.c, but almost every Tcl source file uses something in here.
*----------------------------------------------------------------
*/
typedef struct Interp {
/*
| > | > > > > | < < < | < | < < < < < | < < | < < < < < < | | | | | > > | > < | < < < < < < < | 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 |
* plus other state information related to interpreting commands, such as
* variable storage. Primary responsibility for this data structure is in
* tclBasic.c, but almost every Tcl source file uses something in here.
*----------------------------------------------------------------
*/
typedef struct Interp {
/*
* The first two fields were named "result" and "freeProc" in earlier
* versions of Tcl. They are no longer used within Tcl, and are no
* longer available to be accessed by extensions. However, they cannot
* be removed. Why? There is a deployed base of stub-enabled extensions
* that query the value of iPtr->stubTable. For them to continue to work,
* the location of the field "stubTable" within the Interp struct cannot
* change. The most robust way to assure that is to leave all fields up to
* that one undisturbed.
*/
const char *legacyResult;
void (*legacyFreeProc) (void);
int errorLine; /* When TCL_ERROR is returned, this gives the
* line number in the command where the error
* occurred (1 means first line). */
const struct TclStubs *stubTable;
/* Pointer to the exported Tcl stub table. In
* ancient pre-8.1 versions of Tcl this was a
* pointer to the objResultPtr or a pointer to a
* buckets array in a hash table. Deployed stubs
* enabled extensions check for a NULL pointer value
* and for a TCL_STUBS_MAGIC value to verify they
* are not [load]ing into one of those pre-stubs
* interps.
*/
TclHandle handle; /* Handle used to keep track of when this
* interp is deleted. */
Namespace *globalNsPtr; /* The interpreter's global namespace. */
Tcl_HashTable *hiddenCmdTablePtr;
/* Hash table used by tclBasic.c to keep track
* of hidden commands on a per-interp
* basis. */
ClientData interpInfo; /* Information used by tclInterp.c to keep
* track of master/slave interps on a
* per-interp basis. */
void (*optimizer)(void *envPtr);
/*
* Information related to procedures and variables. See tclProc.c and
* tclVar.c for usage.
*/
int numLevels; /* Keeps track of how many nested calls to
* Tcl_Eval are in progress for this
|
| ︙ | ︙ | |||
1853 1854 1855 1856 1857 1858 1859 |
* or NULL if no active traces. */
int returnCode; /* [return -code] parameter. */
CallFrame *rootFramePtr; /* Global frame pointer for this
* interpreter. */
Namespace *lookupNsPtr; /* Namespace to use ONLY on the next
* TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
| < < < < < < < < < < < < < | 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 |
* or NULL if no active traces. */
int returnCode; /* [return -code] parameter. */
CallFrame *rootFramePtr; /* Global frame pointer for this
* interpreter. */
Namespace *lookupNsPtr; /* Namespace to use ONLY on the next
* TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
/*
* Information about packages. Used only in tclPkg.c.
*/
Tcl_HashTable packageTable; /* Describes all of the packages loaded in or
* available to this interpreter. Keys are
* package names, values are (Package *)
|
| ︙ | ︙ | |||
1888 1889 1890 1891 1892 1893 1894 |
int cmdCount; /* Total number of times a command procedure
* has been called for this interpreter. */
int evalFlags; /* Flags to control next call to Tcl_Eval.
* Normally zero, but may be set before
* calling Tcl_Eval. See below for valid
* values. */
| < | 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 |
int cmdCount; /* Total number of times a command procedure
* has been called for this interpreter. */
int evalFlags; /* Flags to control next call to Tcl_Eval.
* Normally zero, but may be set before
* calling Tcl_Eval. See below for valid
* values. */
LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl
* objects holding literals of scripts
* compiled by the interpreter. Indexed by the
* string representations of literals. Used to
* avoid creating duplicate objects. */
int compileEpoch; /* Holds the current "compilation epoch" for
* this interpreter. This is incremented to
|
| ︙ | ︙ | |||
1926 1927 1928 1929 1930 1931 1932 |
struct ExecEnv *execEnvPtr; /* Execution environment for Tcl bytecode
* execution. Contains a pointer to the Tcl
* evaluation stack. */
Tcl_Obj *emptyObjPtr; /* Points to an object holding an empty
* string. Returned by Tcl_ObjSetVar2 when
* variable traces change a variable in a
* gross way. */
| < < | 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 |
struct ExecEnv *execEnvPtr; /* Execution environment for Tcl bytecode
* execution. Contains a pointer to the Tcl
* evaluation stack. */
Tcl_Obj *emptyObjPtr; /* Points to an object holding an empty
* string. Returned by Tcl_ObjSetVar2 when
* variable traces change a variable in a
* gross way. */
Tcl_Obj *objResultPtr; /* If the last command returned an object
* result, this points to it. Should not be
* accessed directly; see comment above. */
Tcl_ThreadId threadId; /* ID of thread that owns the interpreter. */
ActiveCommandTrace *activeCmdTracePtr;
/* First in list of active command traces for
|
| ︙ | ︙ | |||
2561 2562 2563 2564 2565 2566 2567 | /* * Opaque handle used in pipeline routines to encapsulate platform-dependent * state. */ typedef struct TclFile_ *TclFile; | < < < < < < < < < < | 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 |
/*
* Opaque handle used in pipeline routines to encapsulate platform-dependent
* state.
*/
typedef struct TclFile_ *TclFile;
typedef enum Tcl_PathPart {
TCL_PATH_DIRNAME,
TCL_PATH_TAIL,
TCL_PATH_EXTENSION,
TCL_PATH_ROOT
} Tcl_PathPart;
|
| ︙ | ︙ | |||
2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 | MODULE_SCOPE const Tcl_ObjType tclDoubleType; MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; MODULE_SCOPE const Tcl_ObjType tclIntType; MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; #ifndef TCL_WIDE_INT_IS_LONG MODULE_SCOPE const Tcl_ObjType tclWideIntType; #endif MODULE_SCOPE const Tcl_ObjType tclRegexpType; MODULE_SCOPE Tcl_ObjType tclCmdNameType; | > | 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 | MODULE_SCOPE const Tcl_ObjType tclDoubleType; MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; MODULE_SCOPE const Tcl_ObjType tclIntType; MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclArraySearchType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; #ifndef TCL_WIDE_INT_IS_LONG MODULE_SCOPE const Tcl_ObjType tclWideIntType; #endif MODULE_SCOPE const Tcl_ObjType tclRegexpType; MODULE_SCOPE Tcl_ObjType tclCmdNameType; |
| ︙ | ︙ | |||
2881 2882 2883 2884 2885 2886 2887 | MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, int strLen, const unsigned char *pattern, int ptnLen, int flags); MODULE_SCOPE double TclCeil(const mp_int *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); | < < | | 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 | MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, int strLen, const unsigned char *pattern, int ptnLen, int flags); MODULE_SCOPE double TclCeil(const mp_int *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble; MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num, int *loc); MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, int start, int *clNext); MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr); MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, Tcl_Obj *originObjPtr); MODULE_SCOPE int TclConvertElement(const char *src, int length, char *dst, char flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evulation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, |
| ︙ | ︙ | |||
2970 2971 2972 2973 2974 2975 2976 | const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, unsigned int *sizePtr); | < < < | 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 | const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, unsigned int *sizePtr); MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp, |
| ︙ | ︙ | |||
3114 3115 3116 3117 3118 3119 3120 | MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id); MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, int reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); MODULE_SCOPE int TclScanElement(const char *string, int length, | | | 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 | MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id); MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, int reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); MODULE_SCOPE int TclScanElement(const char *string, int length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr, mp_int *bignumValue); MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr); |
| ︙ | ︙ | |||
3207 3208 3209 3210 3211 3212 3213 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); | < < < | 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CdObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp); |
| ︙ | ︙ | |||
4061 4062 4063 4064 4065 4066 4067 |
(objPtr)->typePtr = NULL; \
TCL_DTRACE_OBJ_CREATE(objPtr)
/*
* Invalidate the string rep first so we can use the bytes value for our
* pointer chain, and signal an obj deletion (as opposed to shimmering) with
* 'length == -1'.
| < > > > > > | | | | | | | | | | | | | | > | 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 |
(objPtr)->typePtr = NULL; \
TCL_DTRACE_OBJ_CREATE(objPtr)
/*
* Invalidate the string rep first so we can use the bytes value for our
* pointer chain, and signal an obj deletion (as opposed to shimmering) with
* 'length == -1'.
*
* Use do/while0 idiom for optimum correctness without compiler warnings.
* http://c2.com/cgi/wiki?TrivialDoWhileLoop
*/
# define TclDecrRefCount(objPtr) \
do { \
Tcl_Obj *_objPtr = (objPtr); \
if (_objPtr->refCount-- <= 1) { \
if (!_objPtr->typePtr || !_objPtr->typePtr->freeIntRepProc) { \
TCL_DTRACE_OBJ_FREE(_objPtr); \
if (_objPtr->bytes \
&& (_objPtr->bytes != tclEmptyStringRep)) { \
ckfree((char *) _objPtr->bytes); \
} \
_objPtr->length = -1; \
TclFreeObjStorage(_objPtr); \
TclIncrObjsFreed(); \
} else { \
TclFreeObj(_objPtr); \
} \
} \
} while(0)
#if defined(PURIFY)
/*
* The PURIFY mode is like the regular mode, but instead of doing block
* Tcl_Obj allocation and keeping a freed list for efficiency, it always
* allocates and frees a single Tcl_Obj so that tools like Purify can better
|
| ︙ | ︙ | |||
4396 4397 4398 4399 4400 4401 4402 |
* MODULE_SCOPE void TclNumUtfChars(int numChars, const char *bytes,
* int numBytes);
*----------------------------------------------------------------
*/
#define TclNumUtfChars(numChars, bytes, numBytes) \
do { \
| | | 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 |
* MODULE_SCOPE void TclNumUtfChars(int numChars, const char *bytes,
* int numBytes);
*----------------------------------------------------------------
*/
#define TclNumUtfChars(numChars, bytes, numBytes) \
do { \
size_t count, i = (numBytes); \
unsigned char *str = (unsigned char *) (bytes); \
while (i && (*str < 0xC0)) { i--; str++; } \
count = (numBytes) - i; \
if (i) { \
count += Tcl_NumUtfChars((bytes) + count, i); \
} \
(numChars) = count; \
|
| ︙ | ︙ | |||
4504 4505 4506 4507 4508 4509 4510 | /* *---------------------------------------------------------------- * Macros used by the Tcl core to set a Tcl_Obj's numeric representation * avoiding the corresponding function calls in time critical parts of the * core. They should only be called on unshared objects. The ANSI C * "prototypes" for these macros are: * | < < < < < < < < | 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 |
/*
*----------------------------------------------------------------
* Macros used by the Tcl core to set a Tcl_Obj's numeric representation
* avoiding the corresponding function calls in time critical parts of the
* core. They should only be called on unshared objects. The ANSI C
* "prototypes" for these macros are:
*
* MODULE_SCOPE void TclSetLongObj(Tcl_Obj *objPtr, long longValue);
* MODULE_SCOPE void TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d);
*----------------------------------------------------------------
*/
#define TclSetLongObj(objPtr, i) \
do { \
TclInvalidateStringRep(objPtr); \
TclFreeIntRep(objPtr); \
(objPtr)->internalRep.longValue = (long)(i); \
(objPtr)->typePtr = &tclIntType; \
} while (0)
/*
* NOTE: There is to be no such thing as a "pure" boolean. Boolean values set
* programmatically go straight to being "int" Tcl_Obj's, with value 0 or 1.
* The only "boolean" Tcl_Obj's shall be those holding the cached boolean
* value of strings like: "yes", "no", "true", "false", "on", "off".
*/
#ifndef TCL_WIDE_INT_IS_LONG
#define TclSetWideIntObj(objPtr, w) \
do { \
TclInvalidateStringRep(objPtr); \
TclFreeIntRep(objPtr); \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
(objPtr)->typePtr = &tclWideIntType; \
|
| ︙ | ︙ | |||
4557 4558 4559 4560 4561 4562 4563 | /* *---------------------------------------------------------------- * Macros used by the Tcl core to create and initialise objects of standard * types, avoiding the corresponding function calls in time critical parts of * the core. The ANSI C "prototypes" for these macros are: * | < < < < < < < < < < < < | 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 |
/*
*----------------------------------------------------------------
* Macros used by the Tcl core to create and initialise objects of standard
* types, avoiding the corresponding function calls in time critical parts of
* the core. The ANSI C "prototypes" for these macros are:
*
* MODULE_SCOPE void TclNewLongObj(Tcl_Obj *objPtr, long l);
* MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d);
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, char *s, int len);
* MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, char*sLiteral);
*
*----------------------------------------------------------------
*/
#ifndef TCL_MEM_DEBUG
#define TclNewLongObj(objPtr, i) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.longValue = (long)(i); \
(objPtr)->typePtr = &tclIntType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#define TclNewDoubleObj(objPtr, d) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.doubleValue = (double)(d); \
|
| ︙ | ︙ | |||
4612 4613 4614 4615 4616 4617 4618 |
(objPtr)->refCount = 0; \
TclInitStringRep((objPtr), (s), (len)); \
(objPtr)->typePtr = NULL; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#else /* TCL_MEM_DEBUG */
| < < < < < < | 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 |
(objPtr)->refCount = 0; \
TclInitStringRep((objPtr), (s), (len)); \
(objPtr)->typePtr = NULL; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#else /* TCL_MEM_DEBUG */
#define TclNewLongObj(objPtr, l) \
(objPtr) = Tcl_NewLongObj(l)
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
#define TclNewStringObj(objPtr, s, len) \
(objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */
|
| ︙ | ︙ |
Changes to generic/tclIntDecls.h.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 | */ #ifndef _TCLINTDECLS #define _TCLINTDECLS #include "tclPort.h" | < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | < | | | | | < < | < < < | < | < < | < < | < < < | | | | < < | < < | < < | < | < | | < < | | | | | | < < | < | | | | | | | | | | | | | | | | < | < | | | | | | | < | < | | | | | | | | | | < < | < | < | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | 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 149 150 151 152 153 154 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 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 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 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 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 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 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 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 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 |
*/
#ifndef _TCLINTDECLS
#define _TCLINTDECLS
#include "tclPort.h"
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
* script. Any modifications to the function declarations below should be made
* in the generic/tclInt.decls script.
*/
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
/*
* Exported function declarations:
*/
/* Slot 0 is reserved */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* 3 */
TCLAPI void TclAllocateFreeObjects(void);
/* Slot 4 is reserved */
/* 5 */
TCLAPI int TclCleanupChildren(Tcl_Interp *interp, int numPids,
Tcl_Pid *pidPtr, Tcl_Channel errorChan);
/* 6 */
TCLAPI void TclCleanupCommand(Command *cmdPtr);
/* 7 */
TCLAPI int TclCopyAndCollapse(int count, const char *src,
char *dst);
/* Slot 8 is reserved */
/* 9 */
TCLAPI int TclCreatePipeline(Tcl_Interp *interp, int argc,
const char **argv, Tcl_Pid **pidArrayPtr,
TclFile *inPipePtr, TclFile *outPipePtr,
TclFile *errFilePtr);
/* 10 */
TCLAPI int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
const char *procName, Tcl_Obj *argsPtr,
Tcl_Obj *bodyPtr, Proc **procPtrPtr);
/* 11 */
TCLAPI void TclDeleteCompiledLocalVars(Interp *iPtr,
CallFrame *framePtr);
/* 12 */
TCLAPI void TclDeleteVars(Interp *iPtr,
TclVarHashTable *tablePtr);
/* Slot 13 is reserved */
/* 14 */
TCLAPI int TclDumpMemoryInfo(ClientData clientData, int flags);
/* Slot 15 is reserved */
/* 16 */
TCLAPI void TclExprFloatError(Tcl_Interp *interp, double value);
/* Slot 17 is reserved */
/* Slot 18 is reserved */
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* 22 */
TCLAPI int TclFindElement(Tcl_Interp *interp,
const char *listStr, int listLength,
const char **elementPtr,
const char **nextPtr, int *sizePtr,
int *bracePtr);
/* 23 */
TCLAPI Proc * TclFindProc(Interp *iPtr, const char *procName);
/* 24 */
TCLAPI int TclFormatInt(char *buffer, long n);
/* 25 */
TCLAPI void TclFreePackageInfo(Interp *iPtr);
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* 28 */
TCLAPI Tcl_Channel TclpGetDefaultStdChannel(int type);
/* Slot 29 is reserved */
/* Slot 30 is reserved */
/* 31 */
TCLAPI const char * TclGetExtension(const char *name);
/* 32 */
TCLAPI int TclGetFrame(Tcl_Interp *interp, const char *str,
CallFrame **framePtrPtr);
/* Slot 33 is reserved */
/* 34 */
TCLAPI int TclGetIntForIndex(Tcl_Interp *interp,
Tcl_Obj *objPtr, int endValue, int *indexPtr);
/* Slot 35 is reserved */
/* Slot 36 is reserved */
/* 37 */
TCLAPI int TclGetLoadedPackages(Tcl_Interp *interp,
const char *targetName);
/* 38 */
TCLAPI int TclGetNamespaceForQualName(Tcl_Interp *interp,
const char *qualName, Namespace *cxtNsPtr,
int flags, Namespace **nsPtrPtr,
Namespace **altNsPtrPtr,
Namespace **actualCxtPtrPtr,
const char **simpleNamePtr);
/* 39 */
TCLAPI TclObjCmdProcType TclGetObjInterpProc(void);
/* 40 */
TCLAPI int TclGetOpenMode(Tcl_Interp *interp, const char *str,
int *seekFlagPtr);
/* 41 */
TCLAPI Tcl_Command TclGetOriginalCommand(Tcl_Command command);
/* 42 */
TCLAPI const char * TclpGetUserHome(const char *name,
Tcl_DString *bufferPtr);
/* Slot 43 is reserved */
/* 44 */
TCLAPI int TclGuessPackageName(const char *fileName,
Tcl_DString *bufPtr);
/* 45 */
TCLAPI int TclHideUnsafeCommands(Tcl_Interp *interp);
/* 46 */
TCLAPI int TclInExit(void);
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 is reserved */
/* 50 */
TCLAPI void TclInitCompiledLocals(Tcl_Interp *interp,
CallFrame *framePtr, Namespace *nsPtr);
/* 51 */
TCLAPI int TclInterpInit(Tcl_Interp *interp);
/* Slot 52 is reserved */
/* 53 */
TCLAPI int TclInvokeObjectCommand(ClientData clientData,
Tcl_Interp *interp, int argc,
const char **argv);
/* 54 */
TCLAPI int TclInvokeStringCommand(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
/* 55 */
TCLAPI Proc * TclIsProc(Command *cmdPtr);
/* Slot 56 is reserved */
/* Slot 57 is reserved */
/* 58 */
TCLAPI Var * TclLookupVar(Tcl_Interp *interp, const char *part1,
const char *part2, int flags,
const char *msg, int createPart1,
int createPart2, Var **arrayPtrPtr);
/* Slot 59 is reserved */
/* 60 */
TCLAPI int TclNeedSpace(const char *start, const char *end);
/* 61 */
TCLAPI Tcl_Obj * TclNewProcBodyObj(Proc *procPtr);
/* 62 */
TCLAPI int TclObjCommandComplete(Tcl_Obj *cmdPtr);
/* 63 */
TCLAPI int TclObjInterpProc(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
/* 64 */
TCLAPI int TclObjInvoke(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int flags);
/* Slot 65 is reserved */
/* Slot 66 is reserved */
/* Slot 67 is reserved */
/* Slot 68 is reserved */
/* 69 */
TCLAPI char * TclpAlloc(unsigned int size);
/* Slot 70 is reserved */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
/* 74 */
TCLAPI void TclpFree(char *ptr);
/* 75 */
TCLAPI unsigned long TclpGetClicks(void);
/* 76 */
TCLAPI unsigned long TclpGetSeconds(void);
/* Slot 77 is reserved */
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
/* 81 */
TCLAPI char * TclpRealloc(char *ptr, unsigned int size);
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* 88 */
TCLAPI char * TclPrecTraceProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
/* 89 */
TCLAPI int TclPreventAliasLoop(Tcl_Interp *interp,
Tcl_Interp *cmdInterp, Tcl_Command cmd);
/* Slot 90 is reserved */
/* 91 */
TCLAPI void TclProcCleanupProc(Proc *procPtr);
/* 92 */
TCLAPI int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
Tcl_Obj *bodyPtr, Namespace *nsPtr,
const char *description,
const char *procName);
/* 93 */
TCLAPI void TclProcDeleteProc(ClientData clientData);
/* Slot 94 is reserved */
/* Slot 95 is reserved */
/* 96 */
TCLAPI int TclRenameCommand(Tcl_Interp *interp,
const char *oldName, const char *newName);
/* 97 */
TCLAPI void TclResetShadowedCmdRefs(Tcl_Interp *interp,
Command *newCmdPtr);
/* 98 */
TCLAPI int TclServiceIdle(void);
/* Slot 99 is reserved */
/* Slot 100 is reserved */
/* 101 */
TCLAPI const char * TclSetPreInitScript(const char *string);
/* 102 */
TCLAPI void TclSetupEnv(Tcl_Interp *interp);
/* 103 */
TCLAPI int TclSockGetPort(Tcl_Interp *interp, const char *str,
const char *proto, int *portPtr);
/* Slot 104 is reserved */
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
/* 108 */
TCLAPI void TclTeardownNamespace(Namespace *nsPtr);
/* 109 */
TCLAPI int TclUpdateReturnInfo(Interp *iPtr);
/* 110 */
TCLAPI int TclSockMinimumBuffers(void *sock, int size);
/* 111 */
TCLAPI void Tcl_AddInterpResolvers(Tcl_Interp *interp,
const char *name,
Tcl_ResolveCmdProc *cmdProc,
Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc);
/* Slot 112 is reserved */
/* Slot 113 is reserved */
/* Slot 114 is reserved */
/* Slot 115 is reserved */
/* Slot 116 is reserved */
/* Slot 117 is reserved */
/* 118 */
TCLAPI int Tcl_GetInterpResolvers(Tcl_Interp *interp,
const char *name, Tcl_ResolverInfo *resInfo);
/* 119 */
TCLAPI int Tcl_GetNamespaceResolvers(
Tcl_Namespace *namespacePtr,
Tcl_ResolverInfo *resInfo);
/* 120 */
TCLAPI Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* Slot 121 is reserved */
/* Slot 122 is reserved */
/* Slot 123 is reserved */
/* Slot 124 is reserved */
/* Slot 125 is reserved */
/* 126 */
TCLAPI void Tcl_GetVariableFullName(Tcl_Interp *interp,
Tcl_Var variable, Tcl_Obj *objPtr);
/* Slot 127 is reserved */
/* 128 */
TCLAPI void Tcl_PopCallFrame(Tcl_Interp *interp);
/* 129 */
TCLAPI int Tcl_PushCallFrame(Tcl_Interp *interp,
Tcl_CallFrame *framePtr,
Tcl_Namespace *nsPtr, int isProcCallFrame);
/* 130 */
TCLAPI int Tcl_RemoveInterpResolvers(Tcl_Interp *interp,
const char *name);
/* 131 */
TCLAPI void Tcl_SetNamespaceResolvers(
Tcl_Namespace *namespacePtr,
Tcl_ResolveCmdProc *cmdProc,
Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 132 */
TCLAPI int TclpHasSockets(Tcl_Interp *interp);
/* Slot 133 is reserved */
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
/* 138 */
TCLAPI const char * TclGetEnv(const char *name, Tcl_DString *valuePtr);
/* Slot 139 is reserved */
/* Slot 140 is reserved */
/* 141 */
TCLAPI const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 142 */
TCLAPI int TclSetByteCodeFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr, CompileHookProc *hookProc,
ClientData clientData);
/* 143 */
TCLAPI int TclAddLiteralObj(struct CompileEnv *envPtr,
Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
/* 144 */
TCLAPI void TclHideLiteral(Tcl_Interp *interp,
struct CompileEnv *envPtr, int index);
/* 145 */
TCLAPI const struct AuxDataType * TclGetAuxDataType(const char *typeName);
/* 146 */
TCLAPI TclHandle TclHandleCreate(void *ptr);
/* 147 */
TCLAPI void TclHandleFree(TclHandle handle);
/* 148 */
TCLAPI TclHandle TclHandlePreserve(TclHandle handle);
/* 149 */
TCLAPI void TclHandleRelease(TclHandle handle);
/* 150 */
TCLAPI int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
/* 151 */
TCLAPI void TclRegExpRangeUniChar(Tcl_RegExp re, int index,
int *startPtr, int *endPtr);
/* 152 */
TCLAPI void TclSetLibraryPath(Tcl_Obj *pathPtr);
/* 153 */
TCLAPI Tcl_Obj * TclGetLibraryPath(void);
/* Slot 154 is reserved */
/* Slot 155 is reserved */
/* 156 */
TCLAPI void TclRegError(Tcl_Interp *interp, const char *msg,
int status);
/* 157 */
TCLAPI Var * TclVarTraceExists(Tcl_Interp *interp,
const char *varName);
/* Slot 158 is reserved */
/* Slot 159 is reserved */
/* Slot 160 is reserved */
/* 161 */
TCLAPI int TclChannelTransform(Tcl_Interp *interp,
Tcl_Channel chan, Tcl_Obj *cmdObjPtr);
/* 162 */
TCLAPI void TclChannelEventScriptInvoker(ClientData clientData,
int flags);
/* 163 */
TCLAPI const void * TclGetInstructionTable(void);
/* 164 */
TCLAPI void TclExpandCodeArray(void *envPtr);
/* 165 */
TCLAPI void TclpSetInitialEncodings(void);
/* 166 */
TCLAPI int TclListObjSetElement(Tcl_Interp *interp,
Tcl_Obj *listPtr, int index,
Tcl_Obj *valuePtr);
/* Slot 167 is reserved */
/* Slot 168 is reserved */
/* 169 */
TCLAPI int TclpUtfNcmp2(const char *s1, const char *s2,
size_t n);
/* 170 */
TCLAPI int TclCheckInterpTraces(Tcl_Interp *interp,
const char *command, int numChars,
Command *cmdPtr, int result, int traceFlags,
int objc, Tcl_Obj *const objv[]);
/* 171 */
TCLAPI int TclCheckExecutionTraces(Tcl_Interp *interp,
const char *command, int numChars,
Command *cmdPtr, int result, int traceFlags,
int objc, Tcl_Obj *const objv[]);
/* 172 */
TCLAPI int TclInThreadExit(void);
/* 173 */
TCLAPI int TclUniCharMatch(const Tcl_UniChar *string,
int strLen, const Tcl_UniChar *pattern,
int ptnLen, int flags);
/* Slot 174 is reserved */
/* 175 */
TCLAPI int TclCallVarTraces(Interp *iPtr, Var *arrayPtr,
Var *varPtr, const char *part1,
const char *part2, int flags,
int leaveErrMsg);
/* 176 */
TCLAPI void TclCleanupVar(Var *varPtr, Var *arrayPtr);
/* 177 */
TCLAPI void TclVarErrMsg(Tcl_Interp *interp, const char *part1,
const char *part2, const char *operation,
const char *reason);
/* Slot 178 is reserved */
/* Slot 179 is reserved */
/* Slot 180 is reserved */
/* Slot 181 is reserved */
/* Slot 182 is reserved */
/* Slot 183 is reserved */
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
/* Slot 187 is reserved */
/* Slot 188 is reserved */
/* Slot 189 is reserved */
/* Slot 190 is reserved */
/* Slot 191 is reserved */
/* Slot 192 is reserved */
/* Slot 193 is reserved */
/* Slot 194 is reserved */
/* Slot 195 is reserved */
/* Slot 196 is reserved */
/* Slot 197 is reserved */
/* 198 */
TCLAPI int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
CallFrame **framePtrPtr);
/* Slot 199 is reserved */
/* 200 */
TCLAPI int TclpObjRemoveDirectory(Tcl_Obj *pathPtr,
int recursive, Tcl_Obj **errorPtr);
/* 201 */
TCLAPI int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr,
Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
/* 202 */
TCLAPI int TclpObjCreateDirectory(Tcl_Obj *pathPtr);
/* 203 */
TCLAPI int TclpObjDeleteFile(Tcl_Obj *pathPtr);
/* 204 */
TCLAPI int TclpObjCopyFile(Tcl_Obj *srcPathPtr,
Tcl_Obj *destPathPtr);
/* 205 */
TCLAPI int TclpObjRenameFile(Tcl_Obj *srcPathPtr,
Tcl_Obj *destPathPtr);
/* 206 */
TCLAPI int TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
/* 207 */
TCLAPI int TclpObjAccess(Tcl_Obj *pathPtr, int mode);
/* 208 */
TCLAPI Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp,
Tcl_Obj *pathPtr, int mode, int permissions);
/* Slot 209 is reserved */
/* Slot 210 is reserved */
/* Slot 211 is reserved */
/* 212 */
TCLAPI void TclpFindExecutable(const char *argv0);
/* 213 */
TCLAPI Tcl_Obj * TclGetObjNameOfExecutable(void);
/* 214 */
TCLAPI void TclSetObjNameOfExecutable(Tcl_Obj *name,
Tcl_Encoding encoding);
/* 215 */
TCLAPI void * TclStackAlloc(Tcl_Interp *interp, int numBytes);
/* 216 */
TCLAPI void TclStackFree(Tcl_Interp *interp, void *freePtr);
/* 217 */
TCLAPI int TclPushStackFrame(Tcl_Interp *interp,
Tcl_CallFrame **framePtrPtr,
Tcl_Namespace *namespacePtr,
int isProcCallFrame);
/* 218 */
TCLAPI void TclPopStackFrame(Tcl_Interp *interp);
/* Slot 219 is reserved */
/* Slot 220 is reserved */
/* Slot 221 is reserved */
/* Slot 222 is reserved */
/* Slot 223 is reserved */
/* 224 */
TCLAPI TclPlatformType * TclGetPlatform(void);
/* 225 */
TCLAPI Tcl_Obj * TclTraceDictPath(Tcl_Interp *interp,
Tcl_Obj *rootPtr, int keyc,
Tcl_Obj *const keyv[], int flags);
/* 226 */
TCLAPI int TclObjBeingDeleted(Tcl_Obj *objPtr);
/* 227 */
TCLAPI void TclSetNsPath(Namespace *nsPtr, int pathLength,
Tcl_Namespace *pathAry[]);
/* Slot 228 is reserved */
/* 229 */
TCLAPI int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
const char *myName, int myFlags, int index);
/* 230 */
TCLAPI Var * TclObjLookupVar(Tcl_Interp *interp,
Tcl_Obj *part1Ptr, const char *part2,
int flags, const char *msg,
const int createPart1, const int createPart2,
Var **arrayPtrPtr);
/* 231 */
TCLAPI int TclGetNamespaceFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
/* 232 */
TCLAPI int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags, const CmdFrame *invoker, int word);
/* 233 */
TCLAPI void TclGetSrcInfoForPc(CmdFrame *contextPtr);
/* 234 */
TCLAPI Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
const char *key, int *newPtr);
/* 235 */
TCLAPI void TclInitVarHashTable(TclVarHashTable *tablePtr,
Namespace *nsPtr);
/* Slot 236 is reserved */
/* 237 */
TCLAPI int TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
TCLAPI int TclNRInterpProc(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
/* 239 */
TCLAPI int TclNRInterpProcCore(Tcl_Interp *interp,
Tcl_Obj *procNameObj, int skip,
ProcErrorProc *errorProc);
/* 240 */
TCLAPI int TclNRRunCallbacks(Tcl_Interp *interp, int result,
struct NRE_callback *rootPtr);
/* 241 */
TCLAPI int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags, const CmdFrame *invoker, int word);
/* 242 */
TCLAPI int TclNREvalObjv(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int flags,
Command *cmdPtr);
/* 243 */
TCLAPI void TclDbDumpActiveObjects(FILE *outFile);
/* 244 */
TCLAPI Tcl_HashTable * TclGetNamespaceChildTable(Tcl_Namespace *nsPtr);
/* 245 */
TCLAPI Tcl_HashTable * TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr);
/* 246 */
TCLAPI int TclInitRewriteEnsemble(Tcl_Interp *interp,
int numRemoved, int numInserted,
Tcl_Obj *const *objv);
/* 247 */
TCLAPI void TclResetRewriteEnsemble(Tcl_Interp *interp,
int isRootEnsemble);
/* 248 */
TCLAPI int TclCopyChannel(Tcl_Interp *interp,
Tcl_Channel inChan, Tcl_Channel outChan,
Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
/* 249 */
TCLAPI char * TclDoubleDigits(double dv, int ndigits, int flags,
int *decpt, int *signum, char **endPtr);
/* 250 */
TCLAPI void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
int force);
/* 251 */
TCLAPI int TclRegisterLiteral(void *envPtr, const char *bytes,
int length, int flags);
typedef struct TclIntStubs {
int magic;
void *hooks;
void (*reserved0)(void);
void (*reserved1)(void);
void (*reserved2)(void);
void (*tclAllocateFreeObjects) (void); /* 3 */
void (*reserved4)(void);
int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
void (*reserved8)(void);
int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */
void (*reserved13)(void);
int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */
void (*reserved15)(void);
|
| ︙ | ︙ | |||
660 661 662 663 664 665 666 |
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 */
| | | | 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 |
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 */
const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
void (*reserved43)(void);
int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
int (*tclInExit) (void); /* 46 */
void (*reserved47)(void);
void (*reserved48)(void);
void (*reserved49)(void);
void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
void (*reserved52)(void);
int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */
int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */
Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
void (*reserved56)(void);
void (*reserved57)(void);
Var * (*tclLookupVar) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 58 */
void (*reserved59)(void);
int (*tclNeedSpace) (const char *start, const char *end); /* 60 */
|
| ︙ | ︙ | |||
695 696 697 698 699 700 701 |
void (*reserved70)(void);
void (*reserved71)(void);
void (*reserved72)(void);
void (*reserved73)(void);
void (*tclpFree) (char *ptr); /* 74 */
unsigned long (*tclpGetClicks) (void); /* 75 */
unsigned long (*tclpGetSeconds) (void); /* 76 */
| | | 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 |
void (*reserved70)(void);
void (*reserved71)(void);
void (*reserved72)(void);
void (*reserved73)(void);
void (*tclpFree) (char *ptr); /* 74 */
unsigned long (*tclpGetClicks) (void); /* 75 */
unsigned long (*tclpGetSeconds) (void); /* 76 */
void (*reserved77)(void);
void (*reserved78)(void);
void (*reserved79)(void);
void (*reserved80)(void);
char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
void (*reserved82)(void);
void (*reserved83)(void);
void (*reserved84)(void);
|
| ︙ | ︙ | |||
719 720 721 722 723 724 725 |
void (*reserved94)(void);
void (*reserved95)(void);
int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */
void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
int (*tclServiceIdle) (void); /* 98 */
void (*reserved99)(void);
void (*reserved100)(void);
| | | | | | | | | | | | | | | | | | | | | | | | | | | | 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 |
void (*reserved94)(void);
void (*reserved95)(void);
int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */
void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
int (*tclServiceIdle) (void); /* 98 */
void (*reserved99)(void);
void (*reserved100)(void);
const char * (*tclSetPreInitScript) (const char *string); /* 101 */
void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
void (*reserved104)(void);
void (*reserved105)(void);
void (*reserved106)(void);
void (*reserved107)(void);
void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */
int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
void (*reserved112)(void);
void (*reserved113)(void);
void (*reserved114)(void);
void (*reserved115)(void);
void (*reserved116)(void);
void (*reserved117)(void);
int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */
int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
void (*reserved121)(void);
void (*reserved122)(void);
void (*reserved123)(void);
void (*reserved124)(void);
void (*reserved125)(void);
void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
void (*reserved127)(void);
void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
void (*reserved133)(void);
void (*reserved134)(void);
void (*reserved135)(void);
void (*reserved136)(void);
void (*reserved137)(void);
const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
void (*reserved139)(void);
void (*reserved140)(void);
const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */
int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
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, int index, int *startPtr, int *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);
void (*reserved159)(void);
void (*reserved160)(void);
int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
const void * (*tclGetInstructionTable) (void); /* 163 */
void (*tclExpandCodeArray) (void *envPtr); /* 164 */
void (*tclpSetInitialEncodings) (void); /* 165 */
int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
void (*reserved167)(void);
void (*reserved168)(void);
int (*tclpUtfNcmp2) (const char *s1, const char *s2, size_t n); /* 169 */
int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
int (*tclInThreadExit) (void); /* 172 */
int (*tclUniCharMatch) (const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags); /* 173 */
void (*reserved174)(void);
int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
void (*reserved178)(void);
void (*reserved179)(void);
void (*reserved180)(void);
void (*reserved181)(void);
void (*reserved182)(void);
void (*reserved183)(void);
void (*reserved184)(void);
void (*reserved185)(void);
void (*reserved186)(void);
void (*reserved187)(void);
void (*reserved188)(void);
void (*reserved189)(void);
void (*reserved190)(void);
|
| ︙ | ︙ | |||
854 855 856 857 858 859 860 |
int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */
Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */
int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
| | | 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 |
int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */
Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */
int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
void (*reserved236)(void);
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
|
| ︙ | ︙ | |||
896 897 898 899 900 901 902 | /* Slot 4 is reserved */ #define TclCleanupChildren \ (tclIntStubsPtr->tclCleanupChildren) /* 5 */ #define TclCleanupCommand \ (tclIntStubsPtr->tclCleanupCommand) /* 6 */ #define TclCopyAndCollapse \ (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */ | | < | 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 | /* Slot 4 is reserved */ #define TclCleanupChildren \ (tclIntStubsPtr->tclCleanupChildren) /* 5 */ #define TclCleanupCommand \ (tclIntStubsPtr->tclCleanupCommand) /* 6 */ #define TclCopyAndCollapse \ (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */ /* Slot 8 is reserved */ #define TclCreatePipeline \ (tclIntStubsPtr->tclCreatePipeline) /* 9 */ #define TclCreateProc \ (tclIntStubsPtr->tclCreateProc) /* 10 */ #define TclDeleteCompiledLocalVars \ (tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */ #define TclDeleteVars \ |
| ︙ | ︙ | |||
1004 1005 1006 1007 1008 1009 1010 | /* Slot 73 is reserved */ #define TclpFree \ (tclIntStubsPtr->tclpFree) /* 74 */ #define TclpGetClicks \ (tclIntStubsPtr->tclpGetClicks) /* 75 */ #define TclpGetSeconds \ (tclIntStubsPtr->tclpGetSeconds) /* 76 */ | < | | 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 | /* Slot 73 is reserved */ #define TclpFree \ (tclIntStubsPtr->tclpFree) /* 74 */ #define TclpGetClicks \ (tclIntStubsPtr->tclpGetClicks) /* 75 */ #define TclpGetSeconds \ (tclIntStubsPtr->tclpGetSeconds) /* 76 */ /* Slot 77 is reserved */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ #define TclpRealloc \ (tclIntStubsPtr->tclpRealloc) /* 81 */ /* Slot 82 is reserved */ /* Slot 83 is reserved */ |
| ︙ | ︙ | |||
1044 1045 1046 1047 1048 1049 1050 | /* Slot 100 is reserved */ #define TclSetPreInitScript \ (tclIntStubsPtr->tclSetPreInitScript) /* 101 */ #define TclSetupEnv \ (tclIntStubsPtr->tclSetupEnv) /* 102 */ #define TclSockGetPort \ (tclIntStubsPtr->tclSockGetPort) /* 103 */ | < | < | < | < | < | < | < | < | < | < | < | < | < | < | | 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 | /* Slot 100 is reserved */ #define TclSetPreInitScript \ (tclIntStubsPtr->tclSetPreInitScript) /* 101 */ #define TclSetupEnv \ (tclIntStubsPtr->tclSetupEnv) /* 102 */ #define TclSockGetPort \ (tclIntStubsPtr->tclSockGetPort) /* 103 */ /* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ #define TclTeardownNamespace \ (tclIntStubsPtr->tclTeardownNamespace) /* 108 */ #define TclUpdateReturnInfo \ (tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */ #define TclSockMinimumBuffers \ (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ #define Tcl_AddInterpResolvers \ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */ /* Slot 112 is reserved */ /* Slot 113 is reserved */ /* Slot 114 is reserved */ /* Slot 115 is reserved */ /* Slot 116 is reserved */ /* Slot 117 is reserved */ #define Tcl_GetInterpResolvers \ (tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */ #define Tcl_GetNamespaceResolvers \ (tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */ #define Tcl_FindNamespaceVar \ (tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */ /* Slot 121 is reserved */ /* Slot 122 is reserved */ /* Slot 123 is reserved */ /* Slot 124 is reserved */ /* Slot 125 is reserved */ #define Tcl_GetVariableFullName \ (tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */ /* Slot 127 is reserved */ #define Tcl_PopCallFrame \ (tclIntStubsPtr->tcl_PopCallFrame) /* 128 */ #define Tcl_PushCallFrame \ (tclIntStubsPtr->tcl_PushCallFrame) /* 129 */ #define Tcl_RemoveInterpResolvers \ (tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */ #define Tcl_SetNamespaceResolvers \ (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */ #define TclpHasSockets \ (tclIntStubsPtr->tclpHasSockets) /* 132 */ /* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ /* Slot 137 is reserved */ #define TclGetEnv \ (tclIntStubsPtr->tclGetEnv) /* 138 */ /* Slot 139 is reserved */ |
| ︙ | ︙ | |||
1141 1142 1143 1144 1145 1146 1147 | (tclIntStubsPtr->tclGetLibraryPath) /* 153 */ /* Slot 154 is reserved */ /* Slot 155 is reserved */ #define TclRegError \ (tclIntStubsPtr->tclRegError) /* 156 */ #define TclVarTraceExists \ (tclIntStubsPtr->tclVarTraceExists) /* 157 */ | < | < | < | < | < | < | < | < | | 1057 1058 1059 1060 1061 1062 1063 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 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 | (tclIntStubsPtr->tclGetLibraryPath) /* 153 */ /* Slot 154 is reserved */ /* Slot 155 is reserved */ #define TclRegError \ (tclIntStubsPtr->tclRegError) /* 156 */ #define TclVarTraceExists \ (tclIntStubsPtr->tclVarTraceExists) /* 157 */ /* Slot 158 is reserved */ /* Slot 159 is reserved */ /* Slot 160 is reserved */ #define TclChannelTransform \ (tclIntStubsPtr->tclChannelTransform) /* 161 */ #define TclChannelEventScriptInvoker \ (tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */ #define TclGetInstructionTable \ (tclIntStubsPtr->tclGetInstructionTable) /* 163 */ #define TclExpandCodeArray \ (tclIntStubsPtr->tclExpandCodeArray) /* 164 */ #define TclpSetInitialEncodings \ (tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */ #define TclListObjSetElement \ (tclIntStubsPtr->tclListObjSetElement) /* 166 */ /* Slot 167 is reserved */ /* Slot 168 is reserved */ #define TclpUtfNcmp2 \ (tclIntStubsPtr->tclpUtfNcmp2) /* 169 */ #define TclCheckInterpTraces \ (tclIntStubsPtr->tclCheckInterpTraces) /* 170 */ #define TclCheckExecutionTraces \ (tclIntStubsPtr->tclCheckExecutionTraces) /* 171 */ #define TclInThreadExit \ (tclIntStubsPtr->tclInThreadExit) /* 172 */ #define TclUniCharMatch \ (tclIntStubsPtr->tclUniCharMatch) /* 173 */ /* Slot 174 is reserved */ #define TclCallVarTraces \ (tclIntStubsPtr->tclCallVarTraces) /* 175 */ #define TclCleanupVar \ (tclIntStubsPtr->tclCleanupVar) /* 176 */ #define TclVarErrMsg \ (tclIntStubsPtr->tclVarErrMsg) /* 177 */ /* Slot 178 is reserved */ /* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ /* Slot 182 is reserved */ /* Slot 183 is reserved */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ /* Slot 187 is reserved */ /* Slot 188 is reserved */ /* Slot 189 is reserved */ /* Slot 190 is reserved */ |
| ︙ | ︙ | |||
1269 1270 1271 1272 1273 1274 1275 | (tclIntStubsPtr->tclEvalObjEx) /* 232 */ #define TclGetSrcInfoForPc \ (tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */ #define TclVarHashCreateVar \ (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ | < | | 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 | (tclIntStubsPtr->tclEvalObjEx) /* 232 */ #define TclGetSrcInfoForPc \ (tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */ #define TclVarHashCreateVar \ (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ /* Slot 236 is reserved */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ #define TclNRInterpProc \ (tclIntStubsPtr->tclNRInterpProc) /* 238 */ #define TclNRInterpProcCore \ (tclIntStubsPtr->tclNRInterpProcCore) /* 239 */ #define TclNRRunCallbacks \ |
| ︙ | ︙ | |||
1306 1307 1308 1309 1310 1311 1312 | #define TclRegisterLiteral \ (tclIntStubsPtr->tclRegisterLiteral) /* 251 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1213 1214 1215 1216 1217 1218 1219 1220 | #define TclRegisterLiteral \ (tclIntStubsPtr->tclRegisterLiteral) /* 251 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLINTDECLS */ |
Changes to generic/tclIntPlatDecls.h.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 | * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. */ #ifndef _TCLINTPLATDECLS #define _TCLINTPLATDECLS | < < < < < < < < < < < < < < < < | | | | | | | | | | < | < | < | < | | | | | < | < < | < < | | | < | < < | | | < | | | | | | | | | | | < | | | | | | | | | | | | | | | | | < | < | < | < | | | | | | | | | | | | | | | | | | | | 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 149 150 151 152 153 154 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 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 |
* Copyright (c) 1998-1999 by Scriptics Corporation.
* All rights reserved.
*/
#ifndef _TCLINTPLATDECLS
#define _TCLINTPLATDECLS
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
* script. Any modifications to the function declarations below should be made
* in the generic/tclInt.decls script.
*/
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
/*
* Exported function declarations:
*/
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
TCLAPI void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
/* 1 */
TCLAPI int TclpCloseFile(TclFile file);
/* 2 */
TCLAPI Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
TclFile writeFile, TclFile errorFile,
int numPids, Tcl_Pid *pidPtr);
/* 3 */
TCLAPI int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
TCLAPI int TclpCreateProcess(Tcl_Interp *interp, int argc,
const char **argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr);
/* Slot 5 is reserved */
/* 6 */
TCLAPI TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
TCLAPI TclFile TclpOpenFile(const char *fname, int mode);
/* 8 */
TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
TCLAPI TclFile TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
TCLAPI int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
int dontCopyAtts);
/* Slot 15 is reserved */
/* Slot 16 is reserved */
/* Slot 17 is reserved */
/* Slot 18 is reserved */
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* Slot 22 is reserved */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
TCLAPI int TclWinCPUID(int index, int *regs);
/* 30 */
TCLAPI int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
TCLAPI void TclWinConvertError(DWORD errCode);
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */
/* 4 */
TCLAPI HINSTANCE TclWinGetTclInstance(void);
/* 5 */
TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout);
/* Slot 6 is reserved */
/* Slot 7 is reserved */
/* 8 */
TCLAPI int TclpGetPid(Tcl_Pid pid);
/* 9 */
TCLAPI int TclWinGetPlatformId(void);
/* Slot 10 is reserved */
/* 11 */
TCLAPI void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
/* 12 */
TCLAPI int TclpCloseFile(TclFile file);
/* 13 */
TCLAPI Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
TclFile writeFile, TclFile errorFile,
int numPids, Tcl_Pid *pidPtr);
/* 14 */
TCLAPI int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 15 */
TCLAPI int TclpCreateProcess(Tcl_Interp *interp, int argc,
const char **argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr);
/* 16 */
TCLAPI int TclpIsAtty(int fd);
/* 17 */
TCLAPI int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
int dontCopyAtts);
/* 18 */
TCLAPI TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
TCLAPI TclFile TclpOpenFile(const char *fname, int mode);
/* 20 */
TCLAPI void TclWinAddProcess(HANDLE hProcess, DWORD id);
/* Slot 21 is reserved */
/* 22 */
TCLAPI TclFile TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
TCLAPI char * TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
TCLAPI void TclWinSetInterfaces(int wide);
/* 27 */
TCLAPI void TclWinFlushDirtyChannels(void);
/* 28 */
TCLAPI void TclWinResetInterfaces(void);
/* 29 */
TCLAPI int TclWinCPUID(int index, int *regs);
/* 30 */
TCLAPI int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
TCLAPI void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
/* 1 */
TCLAPI int TclpCloseFile(TclFile file);
/* 2 */
TCLAPI Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
TclFile writeFile, TclFile errorFile,
int numPids, Tcl_Pid *pidPtr);
/* 3 */
TCLAPI int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
TCLAPI int TclpCreateProcess(Tcl_Interp *interp, int argc,
const char **argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr);
/* Slot 5 is reserved */
/* 6 */
TCLAPI TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
TCLAPI TclFile TclpOpenFile(const char *fname, int mode);
/* 8 */
TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
TCLAPI TclFile TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
TCLAPI int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
int dontCopyAtts);
/* 15 */
TCLAPI int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr);
/* 16 */
TCLAPI int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr);
/* 17 */
TCLAPI int TclMacOSXCopyFileAttributes(const char *src,
const char *dst,
const Tcl_StatBuf *statBufPtr);
/* 18 */
TCLAPI int TclMacOSXMatchType(Tcl_Interp *interp,
const char *pathName, const char *fileName,
Tcl_StatBuf *statBufPtr,
Tcl_GlobTypeData *types);
/* 19 */
TCLAPI void TclMacOSXNotifierAddRunLoopMode(
const void *runLoopMode);
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* Slot 22 is reserved */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
TCLAPI int TclWinCPUID(int index, int *regs);
/* 30 */
TCLAPI int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* MACOSX */
typedef struct TclIntPlatStubs {
int magic;
void *hooks;
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
int (*tclpCloseFile) (TclFile file); /* 1 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
void (*reserved5)(void);
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
void (*reserved10)(void);
void (*reserved11)(void);
void (*reserved12)(void);
void (*reserved13)(void);
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
void (*reserved15)(void);
void (*reserved16)(void);
void (*reserved17)(void);
void (*reserved18)(void);
void (*reserved19)(void);
void (*reserved20)(void);
void (*reserved21)(void);
void (*reserved22)(void);
void (*reserved23)(void);
void (*reserved24)(void);
void (*reserved25)(void);
void (*reserved26)(void);
void (*reserved27)(void);
void (*reserved28)(void);
int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
void (*tclWinConvertError) (DWORD errCode); /* 0 */
void (*reserved1)(void);
void (*reserved2)(void);
void (*reserved3)(void);
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
void (*reserved6)(void);
void (*reserved7)(void);
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
void (*reserved10)(void);
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
int (*tclpCloseFile) (TclFile file); /* 12 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
int (*tclpIsAtty) (int fd); /* 16 */
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
void (*reserved21)(void);
TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
void (*reserved23)(void);
char * (*tclWinNoBackslash) (char *path); /* 24 */
void (*reserved25)(void);
void (*tclWinSetInterfaces) (int wide); /* 26 */
void (*tclWinFlushDirtyChannels) (void); /* 27 */
void (*tclWinResetInterfaces) (void); /* 28 */
|
| ︙ | ︙ | |||
331 332 333 334 335 336 337 |
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
void (*reserved5)(void);
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
| | | | | | 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 |
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
void (*reserved5)(void);
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
void (*reserved10)(void);
void (*reserved11)(void);
void (*reserved12)(void);
void (*reserved13)(void);
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
void (*reserved20)(void);
|
| ︙ | ︙ | |||
387 388 389 390 391 392 393 | (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ | | | | | < < < < | 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 | (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ /* Slot 10 is reserved */ /* Slot 11 is reserved */ /* Slot 12 is reserved */ /* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ /* Slot 15 is reserved */ /* Slot 16 is reserved */ /* Slot 17 is reserved */ /* Slot 18 is reserved */ /* Slot 19 is reserved */ |
| ︙ | ︙ | |||
419 420 421 422 423 424 425 | (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ | | | | < < < | | < < | < | < | 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 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 | (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ /* Slot 1 is reserved */ /* Slot 2 is reserved */ /* Slot 3 is reserved */ #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ /* Slot 6 is reserved */ /* Slot 7 is reserved */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclWinGetPlatformId \ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ /* Slot 10 is reserved */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 12 */ #define TclpCreateCommandChannel \ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */ #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ #define TclpIsAtty \ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 18 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ /* Slot 21 is reserved */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ /* Slot 23 is reserved */ #define TclWinNoBackslash \ (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ /* Slot 25 is reserved */ #define TclWinSetInterfaces \ |
| ︙ | ︙ | |||
498 499 500 501 502 503 504 | (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ | | | | | < < < < | 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 | (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ /* Slot 10 is reserved */ /* Slot 11 is reserved */ /* Slot 12 is reserved */ /* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ (tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */ #define TclMacOSXSetFileAttribute \ (tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */ #define TclMacOSXCopyFileAttributes \ |
| ︙ | ︙ | |||
537 538 539 540 541 542 543 | (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ | < < < < < < < < < | < < < < < < < < < | 488 489 490 491 492 493 494 495 496 497 498 499 500 | (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if !defined(_WIN32) && !defined(__CYGWIN__) # undef TclpGetPid # define TclpGetPid(pid) ((unsigned long) (pid)) #endif #endif /* _TCLINTPLATDECLS */ |
Changes to generic/tclInterp.c.
| ︙ | ︙ | |||
21 22 23 24 25 26 27 | static const char *tclPreInitScript = NULL; /* Forward declaration */ struct Target; /* | | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
static const char *tclPreInitScript = NULL;
/* Forward declaration */
struct Target;
/*
* Alias:
*
* Stores information about an alias. Is stored in the slave interpreter and
* used by the source command to find the target command in the master when
* the source command is invoked.
*/
typedef struct {
Tcl_Obj *token; /* Token for the alias command in the slave
* interp. This used to be the command name in
* the slave when the alias was first
* created. */
Tcl_Interp *targetInterp; /* Interp in which target command will be
* invoked. */
Tcl_Command slaveCmd; /* Source command in slave interpreter, bound
|
| ︙ | ︙ | |||
69 70 71 72 73 74 75 | * struct Slave: * * Used by the "interp" command to record and find information about slave * interpreters. Maps from a command name in the master to information about a * slave interpreter, e.g. what aliases are defined in it. */ | | | | 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 |
* struct Slave:
*
* Used by the "interp" command to record and find information about slave
* interpreters. Maps from a command name in the master to information about a
* slave interpreter, e.g. what aliases are defined in it.
*/
typedef struct {
Tcl_Interp *masterInterp; /* Master interpreter for this slave. */
Tcl_HashEntry *slaveEntryPtr;
/* Hash entry in masters slave table for this
* slave interpreter. Used to find this
* record, and used when deleting the slave
* interpreter to delete it from the master's
* table. */
Tcl_Interp *slaveInterp; /* The slave interpreter. */
Tcl_Command interpCmd; /* Interpreter object command. */
Tcl_HashTable aliasTable; /* Table which maps from names of commands in
* slave interpreter to Alias defined
* below. */
} Slave;
/*
* struct Target:
*
* Maps from master interpreter commands back to the source commands in slave
|
| ︙ | ︙ | |||
123 124 125 126 127 128 129 | * * NB: the flags field in the interp structure, used with SAFE_INTERP mask * denotes whether the interpreter is safe or not. Safe interpreters have * restricted functionality, can only create safe slave interpreters and can * only load safe extensions. */ | | | | | | 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 153 154 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 |
*
* NB: the flags field in the interp structure, used with SAFE_INTERP mask
* denotes whether the interpreter is safe or not. Safe interpreters have
* restricted functionality, can only create safe slave interpreters and can
* only load safe extensions.
*/
typedef struct {
Tcl_HashTable slaveTable; /* Hash table for slave interpreters. Maps
* from command names to Slave records. */
Target *targetsPtr; /* The head of a doubly-linked list of all the
* target records which denote aliases from
* slaves or sibling interpreters that direct
* to commands in this interpreter. This list
* is used to remove dangling pointers from
* the slave (or sibling) interpreters when
* this interpreter is deleted. */
} Master;
/*
* The following structure keeps track of all the Master and Slave information
* on a per-interp basis.
*/
typedef struct {
Master master; /* Keeps track of all interps for which this
* interp is the Master. */
Slave slave; /* Information necessary for this interp to
* function as a slave. */
} InterpInfo;
/*
* Limit callbacks handled by scripts are modelled as structures which are
* stored in hashes indexed by a two-word key. Note that the type of the
* 'type' field in the key is not int; this is to make sure that things are
* likely to work properly on 64-bit architectures.
*/
typedef struct {
Tcl_Interp *interp; /* The interpreter in which to execute the
* callback. */
Tcl_Obj *scriptObj; /* The script to execute to perform the
* user-defined part of the callback. */
int type; /* What kind of callback is this. */
Tcl_HashEntry *entryPtr; /* The entry in the hash table maintained by
* the target interpreter that refers to this
* callback record, or NULL if the entry has
* already been deleted from that hash
* table. */
} ScriptLimitCallback;
typedef struct {
Tcl_Interp *interp; /* The interpreter that the limit callback was
* attached to. This is not the interpreter
* that the callback runs in! */
long type; /* The type of callback that this is. */
} ScriptLimitCallbackKey;
/*
|
| ︙ | ︙ |
Changes to generic/tclLink.c.
| ︙ | ︙ | |||
17 18 19 20 21 22 23 | /* * For each linked variable there is a data structure of the following type, * which describes the link and is the clientData for the trace set on the Tcl * variable. */ | | | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 |
/*
* For each linked variable there is a data structure of the following type,
* which describes the link and is the clientData for the trace set on the Tcl
* variable.
*/
typedef struct {
Tcl_Interp *interp; /* Interpreter 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. */
char *addr; /* Location of C variable. */
int type; /* Type of link (TCL_LINK_INT, etc.). */
|
| ︙ | ︙ |
Changes to generic/tclListObj.c.
| ︙ | ︙ | |||
997 998 999 1000 1001 1002 1003 |
listRepPtr = AttemptNewList(NULL, numRequired + growth, NULL);
if (listRepPtr == NULL) {
listRepPtr = AttemptNewList(interp, numRequired, NULL);
if (listRepPtr == NULL) {
for (i = 0; i < objc; i++) {
/* See bug 3598580 */
| < < < < | 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 |
listRepPtr = AttemptNewList(NULL, numRequired + growth, NULL);
if (listRepPtr == NULL) {
listRepPtr = AttemptNewList(interp, numRequired, NULL);
if (listRepPtr == NULL) {
for (i = 0; i < objc; i++) {
/* See bug 3598580 */
Tcl_DecrRefCount(objv[i]);
}
return TCL_ERROR;
}
}
}
listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
|
| ︙ | ︙ | |||
1953 1954 1955 1956 1957 1958 1959 |
*----------------------------------------------------------------------
*/
static void
UpdateStringOfList(
Tcl_Obj *listPtr) /* List object with string rep to update. */
{
| | | | 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 |
*----------------------------------------------------------------------
*/
static void
UpdateStringOfList(
Tcl_Obj *listPtr) /* List object with string rep to update. */
{
# define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
List *listRepPtr = ListRepPtr(listPtr);
int numElems = listRepPtr->elemCount;
int i, length, bytesNeeded = 0;
const char *elem;
char *dst;
Tcl_Obj **elemPtrs;
|
| ︙ | ︙ | |||
1991 1992 1993 1994 1995 1996 1997 |
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
/*
* We know numElems <= LIST_MAX, so this is safe.
*/
| | | 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 |
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
/*
* We know numElems <= LIST_MAX, so this is safe.
*/
flagPtr = ckalloc(numElems);
}
elemPtrs = &listRepPtr->elements;
for (i = 0; i < numElems; i++) {
flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
elem = TclGetStringFromObj(elemPtrs[i], &length);
bytesNeeded += TclScanElement(elem, length, flagPtr+i);
if (bytesNeeded < 0) {
|
| ︙ | ︙ |
Changes to generic/tclLiteral.c.
| ︙ | ︙ | |||
172 173 174 175 176 177 178 |
*/
Tcl_Obj *
TclCreateLiteral(
Interp *iPtr,
const char *bytes, /* The start of the string. Note that this is
* not a NUL-terminated string. */
| | | | | | | | 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 |
*/
Tcl_Obj *
TclCreateLiteral(
Interp *iPtr,
const char *bytes, /* The start of the string. Note that this is
* not a NUL-terminated string. */
size_t length, /* Number of bytes in the string. */
TCL_HASH_TYPE hash, /* The string's hash. If -1, it will be
* computed here. */
int *newPtr,
Namespace *nsPtr,
int flags,
LiteralEntry **globalPtrPtr)
{
LiteralTable *globalTablePtr = &iPtr->literalTable;
LiteralEntry *globalPtr;
TCL_HASH_TYPE globalHash;
Tcl_Obj *objPtr;
/*
* Is it in the interpreter's global literal table?
*/
if (hash == (TCL_HASH_TYPE) -1) {
hash = HashString(bytes, length);
}
globalHash = (hash & globalTablePtr->mask);
for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
globalPtr = globalPtr->nextPtr) {
objPtr = globalPtr->objPtr;
if ((globalPtr->nsPtr == nsPtr)
&& ((size_t)objPtr->length == length) && ((length == 0)
|| ((objPtr->bytes[0] == bytes[0])
&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
/*
* A literal was found: return it
*/
if (newPtr) {
*newPtr = 0;
}
|
| ︙ | ︙ | |||
255 256 257 258 259 260 261 |
/*
* Yes, add it to the global literal table.
*/
#ifdef TCL_COMPILE_DEBUG
if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
| | | 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 |
/*
* Yes, add it to the global literal table.
*/
#ifdef TCL_COMPILE_DEBUG
if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
"TclRegisterLiteral", (length>60? 60 : (int)length), bytes);
}
#endif
globalPtr = ckalloc(sizeof(LiteralEntry));
globalPtr->objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
globalPtr->refCount = 1;
|
| ︙ | ︙ |
Changes to generic/tclLoad.c.
| ︙ | ︙ | |||
459 460 461 462 463 464 465 |
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
NULL);
code = TCL_ERROR;
goto done;
}
code = pkgPtr->initProc(target);
}
| < > > > > > > > > > > > | 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 |
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
NULL);
code = TCL_ERROR;
goto done;
}
code = pkgPtr->initProc(target);
}
/*
* Test for whether the initialization failed. If so, transfer the error
* from the target interpreter to the originating one.
*/
if (code != TCL_OK) {
Interp *iPtr = (Interp *) target;
if (iPtr->legacyResult && !iPtr->legacyFreeProc) {
/*
* A call to Tcl_InitStubs() determined the caller extension and
* this interp are incompatible in their stubs mechanisms, and
* recorded the error in the oldest legacy place we have to do so.
*/
Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1));
iPtr->legacyResult = NULL;
iPtr->legacyFreeProc = (void (*) (void))-1;
}
Tcl_TransferResult(target, code, interp);
goto done;
}
/*
* Record the fact that the package has been loaded in the target
* interpreter.
|
| ︙ | ︙ |
Changes to generic/tclMain.c.
| ︙ | ︙ | |||
364 365 366 367 368 369 370 |
} else {
appName = path;
}
Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
argc--;
argv++;
| | | | 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 |
} else {
appName = path;
}
Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
argc--;
argv++;
Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewLongObj(argc), TCL_GLOBAL_ONLY);
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
}
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
/*
* Set the "tcl_interactive" variable.
*/
is.tty = isatty(0);
Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
Tcl_NewLongObj(!path && is.tty), TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
*/
Tcl_Preserve(interp);
if (appInitProc(interp) != TCL_OK) {
|
| ︙ | ︙ |
Changes to generic/tclNamesp.c.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 | #include "tclCompile.h" /* for TclLogCommandInfo visibility */ /* * Thread-local storage used to avoid having a global lock on data that is not * limited to a single interpreter. */ | | | | 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 |
#include "tclCompile.h" /* for TclLogCommandInfo visibility */
/*
* Thread-local storage used to avoid having a global lock on data that is not
* limited to a single interpreter.
*/
typedef struct {
long numNsCreated; /* Count of the number of namespaces created
* within the thread. This value is used as a
* unique id for each namespace. Cannot be
* per-interp because the nsId is used to
* distinguish objects which can be passed
* around between interps in the same thread,
* but does not need to be global because
* object internal reps are always per-thread
* anyway. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
* This structure contains a cached pointer to a namespace that is the result
* of resolving the namespace's name in some other namespace. It is the
* internal representation for a nsName object. It contains the pointer along
* with some information that is used to check the cached pointer's validity.
*/
typedef struct {
Namespace *nsPtr; /* A cached pointer to the Namespace that the
* name resolved to. */
Namespace *refNsPtr; /* Points to the namespace context in which
* the name was resolved. NULL if the name is
* fully qualified and thus the resolution
* does not depend on the context. */
int refCount; /* Reference count: 1 for each nsName object
|
| ︙ | ︙ | |||
378 379 380 381 382 383 384 |
Tcl_PopCallFrame(
Tcl_Interp *interp) /* Interpreter with call frame to pop. */
{
register Interp *iPtr = (Interp *) interp;
register CallFrame *framePtr = iPtr->framePtr;
Namespace *nsPtr;
| < < < < < < < < < < < < < | 378 379 380 381 382 383 384 385 386 387 388 389 390 391 |
Tcl_PopCallFrame(
Tcl_Interp *interp) /* Interpreter with call frame to pop. */
{
register Interp *iPtr = (Interp *) interp;
register CallFrame *framePtr = iPtr->framePtr;
Namespace *nsPtr;
if (framePtr->varTablePtr != NULL) {
TclDeleteVars(iPtr, framePtr->varTablePtr);
ckfree(framePtr->varTablePtr);
framePtr->varTablePtr = NULL;
}
if (framePtr->numCompiledLocals > 0) {
TclDeleteCompiledLocalVars(iPtr, framePtr);
|
| ︙ | ︙ | |||
417 418 419 420 421 422 423 424 425 426 427 428 429 430 |
nsPtr = framePtr->nsPtr;
nsPtr->activationCount--;
if ((nsPtr->flags & NS_DYING)
&& (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
}
framePtr->nsPtr = NULL;
if (framePtr->tailcallPtr) {
TclSetTailcall(interp, framePtr->tailcallPtr);
}
}
/*
| > > > > > > > | 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 |
nsPtr = framePtr->nsPtr;
nsPtr->activationCount--;
if ((nsPtr->flags & NS_DYING)
&& (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
}
framePtr->nsPtr = NULL;
if (framePtr->callerPtr) {
iPtr->framePtr = framePtr->callerPtr;
iPtr->varFramePtr = framePtr->callerVarPtr;
} else {
/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
}
if (framePtr->tailcallPtr) {
TclSetTailcall(interp, framePtr->tailcallPtr);
}
}
/*
|
| ︙ | ︙ | |||
3449 3450 3451 3452 3453 3454 3455 |
Tcl_Namespace *namespacePtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
| | | 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 |
Tcl_Namespace *namespacePtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(
GetNamespaceFromObj(interp, objv[1], &namespacePtr) == TCL_OK));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
4601 4602 4603 4604 4605 4606 4607 |
Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name");
return TCL_ERROR;
} else if (objc == 3) {
/*
* Look for a flag controlling the lookup.
*/
| | | | 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 |
Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name");
return TCL_ERROR;
} else if (objc == 3) {
/*
* Look for a flag controlling the lookup.
*/
if (Tcl_GetIndexFromObjStruct(interp, objv[1], opts,
sizeof(char *), "option", 0, &lookupType) != TCL_OK) {
/*
* Preserve old style of error message!
*/
Tcl_ResetResult(interp);
goto badArgs;
}
|
| ︙ | ︙ | |||
4993 4994 4995 4996 4997 4998 4999 |
*/
} else if (iPtr->varFramePtr != iPtr->framePtr) {
/*
* uplevel case, [lappend errorstack UP $relativelevel]
*/
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
| | | 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 |
*/
} else if (iPtr->varFramePtr != iPtr->framePtr) {
/*
* uplevel case, [lappend errorstack UP $relativelevel]
*/
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewLongObj(
iPtr->framePtr->level - iPtr->varFramePtr->level));
} else if (iPtr->framePtr != iPtr->rootFramePtr) {
/*
* normal case, [lappend errorstack CALL [info level 0]]
*/
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
|
| ︙ | ︙ |
Changes to generic/tclOO.decls.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 | library tclOO ###################################################################### # Public API, exposed for general users of TclOO. # interface tclOO | | | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
library tclOO
######################################################################
# Public API, exposed for general users of TclOO.
#
interface tclOO
hooks tclOOPrivate
scspec TCLAPI
declare 0 {
Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
Tcl_Object sourceObject, const char *targetName,
const char *targetNamespaceName)
}
|
| ︙ | ︙ |
Changes to generic/tclOO.h.
| ︙ | ︙ | |||
33 34 35 36 37 38 39 |
* For C++ compilers, use extern "C"
*/
#ifdef __cplusplus
extern "C" {
#endif
| < < | < < | < | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 |
* For C++ compilers, use extern "C"
*/
#ifdef __cplusplus
extern "C" {
#endif
#define Tcl_OOInitStubs(interp) (TCLOO_PATCHLEVEL)
#define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL)
/*
* These are opaque types.
*/
typedef struct Tcl_Class_ *Tcl_Class;
typedef struct Tcl_Method_ *Tcl_Method;
|
| ︙ | ︙ |
Changes to generic/tclOOBasic.c.
| ︙ | ︙ | |||
981 982 983 984 985 986 987 |
*/
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand");
return TCL_ERROR;
} else if (objc == 1) {
index = SELF_OBJECT;
| | | | 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 |
*/
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand");
return TCL_ERROR;
} else if (objc == 1) {
index = SELF_OBJECT;
} else if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmds,
sizeof(char *), "subcommand", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum SelfCmds) index) {
case SELF_OBJECT:
Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr));
return TCL_OK;
|
| ︙ | ︙ | |||
1151 1152 1153 1154 1155 1156 1157 |
result[0] = TclOOObjectName(interp, declarerPtr);
result[1] = mPtr->namePtr;
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
return TCL_OK;
}
case SELF_CALL:
result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
| | | 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 |
result[0] = TclOOObjectName(interp, declarerPtr);
result[1] = mPtr->namePtr;
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
return TCL_OK;
}
case SELF_CALL:
result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
result[1] = Tcl_NewLongObj(contextPtr->index);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
return TCL_OK;
}
return TCL_ERROR;
}
/*
|
| ︙ | ︙ |
Changes to generic/tclOODecls.h.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
# endif
#endif
#ifdef USE_TCL_STUBS
# undef USE_TCLOO_STUBS
# define USE_TCLOO_STUBS
#endif
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
| > > > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
# endif
#endif
#ifdef USE_TCL_STUBS
# undef USE_TCLOO_STUBS
# define USE_TCLOO_STUBS
#endif
#define tclOOPrivateStubs tclOOIntStubs
#define TclOOPrivateStubs TclOOIntStubs
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
|
| ︙ | ︙ | |||
114 115 116 117 118 119 120 |
TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 28 */
TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
Tcl_Object object);
typedef struct {
| | | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 |
TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 28 */
TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
Tcl_Object object);
typedef struct {
const struct TclOOPrivateStubs *tclOOPrivateStubs;
} TclOOStubHooks;
typedef struct TclOOStubs {
int magic;
const TclOOStubHooks *hooks;
Tcl_Object (*tcl_CopyObjectInstance) (Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 0 */
|
| ︙ | ︙ |
Changes to generic/tclOOStubInit.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * This file is (mostly) automatically generated from tclOO.decls. * It is compiled and linked in with the tclOO package proper. */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclOOInt.h" MODULE_SCOPE const TclOOStubs tclOOStubs; #ifdef __GNUC__ #pragma GCC dependency "tclOO.decls" #endif /* !BEGIN!: Do not edit below this line. */ | > | | 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 |
/*
* This file is (mostly) automatically generated from tclOO.decls.
* It is compiled and linked in with the tclOO package proper.
*/
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclOOInt.h"
MODULE_SCOPE const TclOOStubs tclOOStubs;
MODULE_SCOPE const TclOOIntStubs tclOOIntStubs;
#ifdef __GNUC__
#pragma GCC dependency "tclOO.decls"
#endif
/* !BEGIN!: Do not edit below this line. */
const TclOOIntStubs tclOOIntStubs = {
TCL_STUB_MAGIC,
0,
TclOOGetDefineCmdContext, /* 0 */
TclOOMakeProcInstanceMethod, /* 1 */
TclOOMakeProcMethod, /* 2 */
TclOONewProcInstanceMethod, /* 3 */
TclOONewProcMethod, /* 4 */
|
| ︙ | ︙ | |||
34 35 36 37 38 39 40 |
TclOOObjectSetFilters, /* 12 */
TclOOClassSetFilters, /* 13 */
TclOOObjectSetMixins, /* 14 */
TclOOClassSetMixins, /* 15 */
};
static const TclOOStubHooks tclOOStubHooks = {
| | | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 |
TclOOObjectSetFilters, /* 12 */
TclOOClassSetFilters, /* 13 */
TclOOObjectSetMixins, /* 14 */
TclOOClassSetMixins, /* 15 */
};
static const TclOOStubHooks tclOOStubHooks = {
&tclOOPrivateStubs
};
const TclOOStubs tclOOStubs = {
TCL_STUB_MAGIC,
&tclOOStubHooks,
Tcl_CopyObjectInstance, /* 0 */
Tcl_GetClassAsObject, /* 1 */
|
| ︙ | ︙ |
Deleted generic/tclOOStubLib.c.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to generic/tclObj.c.
| ︙ | ︙ | |||
54 55 56 57 58 59 60 | #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) /* * Structure for tracking the source file and line number where a given * Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself, * for sanity checking purposes. */ | | | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 |
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
/*
* Structure for tracking the source file and line number where a given
* Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself,
* for sanity checking purposes.
*/
typedef struct {
Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */
const char *file; /* The name of the source file calling this
* function; used for debugging. */
int line; /* Line number in the source file; used for
* debugging. */
} ObjData;
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
|
| ︙ | ︙ | |||
398 399 400 401 402 403 404 405 406 407 408 409 410 411 |
Tcl_RegisterObjType(&tclDoubleType);
Tcl_RegisterObjType(&tclEndOffsetType);
Tcl_RegisterObjType(&tclIntType);
Tcl_RegisterObjType(&tclStringType);
Tcl_RegisterObjType(&tclListType);
Tcl_RegisterObjType(&tclDictType);
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclCmdNameType);
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
/* For backward compatibility only ... */
Tcl_RegisterObjType(&oldBooleanType);
#ifndef TCL_WIDE_INT_IS_LONG
| > | 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 |
Tcl_RegisterObjType(&tclDoubleType);
Tcl_RegisterObjType(&tclEndOffsetType);
Tcl_RegisterObjType(&tclIntType);
Tcl_RegisterObjType(&tclStringType);
Tcl_RegisterObjType(&tclListType);
Tcl_RegisterObjType(&tclDictType);
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclArraySearchType);
Tcl_RegisterObjType(&tclCmdNameType);
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
/* For backward compatibility only ... */
Tcl_RegisterObjType(&oldBooleanType);
#ifndef TCL_WIDE_INT_IS_LONG
|
| ︙ | ︙ | |||
1759 1760 1761 1762 1763 1764 1765 |
Tcl_Obj *
Tcl_NewBooleanObj(
register int boolValue) /* Boolean used to initialize new object. */
{
register Tcl_Obj *objPtr;
| | | 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 |
Tcl_Obj *
Tcl_NewBooleanObj(
register int boolValue) /* Boolean used to initialize new object. */
{
register Tcl_Obj *objPtr;
TclNewLongObj(objPtr, boolValue!=0);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1853 1854 1855 1856 1857 1858 1859 |
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register int boolValue) /* Boolean used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
}
| | | 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 |
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register int boolValue) /* Boolean used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
}
TclSetLongObj(objPtr, boolValue!=0);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetBooleanFromObj --
*
|
| ︙ | ︙ | |||
2421 2422 2423 2424 2425 2426 2427 |
Tcl_Obj *
Tcl_NewIntObj(
register int intValue) /* Int used to initialize the new object. */
{
register Tcl_Obj *objPtr;
| | | 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 |
Tcl_Obj *
Tcl_NewIntObj(
register int intValue) /* Int used to initialize the new object. */
{
register Tcl_Obj *objPtr;
TclNewLongObj(objPtr, intValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
2454 2455 2456 2457 2458 2459 2460 |
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register int intValue) /* Integer used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
}
| | | 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 |
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register int intValue) /* Integer used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
}
TclSetLongObj(objPtr, intValue);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetIntFromObj --
*
|
| ︙ | ︙ | |||
2600 2601 2602 2603 2604 2605 2606 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | < > | 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#undef Tcl_NewLongObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_NewLongObj(
register long longValue) /* Long integer used to initialize the
* new object. */
{
return Tcl_DbNewLongObj(longValue, "unknown", 0);
|
| ︙ | ︙ | |||
2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 |
* Side effects:
* The object's old string rep, if any, is freed. Also, any old internal
* rep is freed.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetLongObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register long longValue) /* Long integer used to initialize the
* object's value. */
{
if (Tcl_IsShared(objPtr)) {
| > | 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 |
* Side effects:
* The object's old string rep, if any, is freed. Also, any old internal
* rep is freed.
*
*----------------------------------------------------------------------
*/
#undef Tcl_SetLongObj
void
Tcl_SetLongObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register long longValue) /* Long integer used to initialize the
* object's value. */
{
if (Tcl_IsShared(objPtr)) {
|
| ︙ | ︙ | |||
4049 4050 4051 4052 4053 4054 4055 |
TCL_HASH_TYPE
TclHashObjKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
{
Tcl_Obj *objPtr = keyPtr;
| < | > | | 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 |
TCL_HASH_TYPE
TclHashObjKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
{
Tcl_Obj *objPtr = keyPtr;
const char *string = TclGetString(objPtr);
size_t length = objPtr->length;
TCL_HASH_TYPE result = 0;
/*
* I tried a zillion different hash functions and asked many other people
* for advice. Many people had their own favorite functions, all
* different, but no-one had much idea why they were good ones. I chose
* the one below (multiply by 9 and add new character) because of the
* following reasons:
|
| ︙ | ︙ | |||
4093 4094 4095 4096 4097 4098 4099 |
if (length > 0) {
result = UCHAR(*string);
while (--length) {
result += (result << 3) + UCHAR(*++string);
}
}
| | | 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 |
if (length > 0) {
result = UCHAR(*string);
while (--length) {
result += (result << 3) + UCHAR(*++string);
}
}
return result;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetCommandFromObj --
*
|
| ︙ | ︙ |
Changes to generic/tclPathObj.c.
| ︙ | ︙ | |||
67 68 69 70 71 72 73 | * (ii) flags != 0, => Special path, see TclNewFSPathObj * * Now, this is a path like 'file join $dir $tail' where, cwdPtr is the $dir * and normPathPtr is the $tail. * */ | | | 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 |
* (ii) flags != 0, => Special path, see TclNewFSPathObj
*
* Now, this is a path like 'file join $dir $tail' where, cwdPtr is the $dir
* and normPathPtr is the $tail.
*
*/
typedef struct {
Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
* is NULL, then this is a pure normalized,
* absolute path object, in which the parent
* Tcl_Obj's string rep is already both
* translated and normalized. */
Tcl_Obj *normPathPtr; /* Normalized absolute path, without ., .. or
* ~user sequences. If the Tcl_Obj containing
|
| ︙ | ︙ |
Changes to generic/tclPkg.c.
| ︙ | ︙ | |||
35 36 37 38 39 40 41 | /* * For each package that is known in any way to an interpreter, there is one * record of the following type. These records are stored in the * "packageTable" hash table in the interpreter, keyed by package name such as * "Tk" (no version number). */ | | | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 |
/*
* For each package that is known in any way to an interpreter, there is one
* record of the following type. These records are stored in the
* "packageTable" hash table in the interpreter, keyed by package name such as
* "Tk" (no version number).
*/
typedef struct {
char *version; /* Version that has been supplied in this
* interpreter via "package provide"
* (malloc'ed). NULL means the package doesn't
* exist in this interpreter yet. */
PkgAvail *availPtr; /* First in list of all available versions of
* this package. */
const void *clientData; /* Client data. */
|
| ︙ | ︙ | |||
84 85 86 87 88 89 90 |
unsigned local__len = (unsigned) (strlen(s) + 1); \
DupBlock((v),(s),local__len); \
} while (0)
/*
*----------------------------------------------------------------------
*
| | < < < < < < < < < < < | 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 |
unsigned local__len = (unsigned) (strlen(s) + 1); \
DupBlock((v),(s),local__len); \
} while (0)
/*
*----------------------------------------------------------------------
*
* Tcl_PkgProvideEx --
*
* This function is invoked to declare that a particular version of a
* particular package is now present in an interpreter. There must not be
* any other version of this package already provided in the interpreter.
*
* Results:
* Normally returns TCL_OK; if there is already another version of the
* package loaded then TCL_ERROR is returned and an error message is left
* in the interp's result.
*
* Side effects:
* The interpreter remembers that this package is available, so that no
* other version of the package may be provided for the interpreter.
*
*----------------------------------------------------------------------
*/
int
Tcl_PkgProvideEx(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
const char *name, /* Name of package. */
const char *version, /* Version string for package. */
const void *clientData) /* clientdata for this package (normally used
|
| ︙ | ︙ | |||
161 162 163 164 165 166 167 |
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
| | | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 |
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* Tcl_PkgRequireEx / Tcl_PkgRequireProc --
*
* This function is called by code that depends on a particular version
* of a particular package. If the package is not already provided in the
* interpreter, this function invokes a Tcl script to provide it. If the
* package is already provided, this function makes sure that the
* caller's needs don't conflict with the version that is present.
*
|
| ︙ | ︙ | |||
185 186 187 188 189 190 191 | * Side effects: * The script from some previous "package ifneeded" command may be * invoked to provide the package. * *---------------------------------------------------------------------- */ | < < < < < < < < < < < < < < < | 174 175 176 177 178 179 180 181 182 183 184 185 186 187 |
* Side effects:
* The script from some previous "package ifneeded" command may be
* invoked to provide the package.
*
*----------------------------------------------------------------------
*/
const char *
Tcl_PkgRequireEx(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
const char *name, /* Name of desired package. */
const char *version, /* Version string for desired version; NULL
* means use the latest version available. */
|
| ︙ | ︙ | |||
650 651 652 653 654 655 656 |
}
return pkgPtr->version;
}
/*
*----------------------------------------------------------------------
*
| | < < < < < < < < < < < < < < < | 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 |
}
return pkgPtr->version;
}
/*
*----------------------------------------------------------------------
*
* Tcl_PkgPresentEx --
*
* Checks to see whether the specified package is present. If it is not
* then no additional action is taken.
*
* Results:
* If successful, returns the version string for the currently provided
* version of the package, which may be different from the "version"
* argument. If the caller's requirements cannot be met (e.g. the version
* requested conflicts with a currently provided version), NULL is
* returned and an error message is left in interp->result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
const char *
Tcl_PkgPresentEx(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
const char *name, /* Name of desired package. */
const char *version, /* Version string for desired version; NULL
* means use the latest version available. */
|
| ︙ | ︙ | |||
1889 1890 1891 1892 1893 1894 1895 |
const char *
Tcl_PkgInitStubsCheck(
Tcl_Interp *interp,
const char * version,
int exact)
{
| | | | | 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 |
const char *
Tcl_PkgInitStubsCheck(
Tcl_Interp *interp,
const char * version,
int exact)
{
const char *actualVersion = Tcl_PkgPresentEx(interp, "Tcl", version, 0, NULL);
if ((exact&1) && actualVersion) {
const char *p = version;
int count = 0;
while (*p) {
count += !isdigit(UCHAR(*p++));
}
if (count == 1) {
if (0 != strncmp(version, actualVersion, strlen(version))) {
/* Construct error message */
Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL);
return NULL;
}
} else {
return Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL);
}
}
return actualVersion;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclPlatDecls.h.
1 2 3 4 5 6 7 8 9 10 11 12 | /* * tclPlatDecls.h -- * * Declarations of platform specific Tcl APIs. * * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. */ #ifndef _TCLPLATDECLS #define _TCLPLATDECLS | < < < < < < < < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | /* * tclPlatDecls.h -- * * Declarations of platform specific Tcl APIs. * * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. */ #ifndef _TCLPLATDECLS #define _TCLPLATDECLS /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tcl.decls script. */ /* |
| ︙ | ︙ | |||
48 49 50 51 52 53 54 | /* * Exported function declarations: */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ | | | | | | 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 |
/*
* Exported function declarations:
*/
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
TCLAPI TCHAR * Tcl_WinUtfToTChar(const char *str, int len,
Tcl_DString *dsPtr);
/* 1 */
TCLAPI char * Tcl_WinTCharToUtf(const TCHAR *str, int len,
Tcl_DString *dsPtr);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
TCLAPI int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
const char *bundleName, int hasResourceFile,
int maxPathLen, char *libraryPath);
/* 1 */
TCLAPI int Tcl_MacOSXOpenVersionedBundleResources(
Tcl_Interp *interp, const char *bundleName,
const char *bundleVersion,
int hasResourceFile, int maxPathLen,
char *libraryPath);
#endif /* MACOSX */
typedef struct TclPlatStubs {
|
| ︙ | ︙ | |||
110 111 112 113 114 115 116 | (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ | < < < | 99 100 101 102 103 104 105 106 107 108 | (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLPLATDECLS */ |
Changes to generic/tclPreserve.c.
| ︙ | ︙ | |||
49 50 51 52 53 54 55 | * The following data structure is used to keep track of whether an arbitrary * block of memory has been deleted. This is used by the TclHandle code to * avoid the more time-expensive algorithm of Tcl_Preserve(). This mechanism * is mainly used when we have lots of references to a few big, expensive * objects that we don't want to live any longer than necessary. */ | | | 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 |
* The following data structure is used to keep track of whether an arbitrary
* block of memory has been deleted. This is used by the TclHandle code to
* avoid the more time-expensive algorithm of Tcl_Preserve(). This mechanism
* is mainly used when we have lots of references to a few big, expensive
* objects that we don't want to live any longer than necessary.
*/
typedef struct {
void *ptr; /* Pointer to the memory block being tracked.
* This field will become NULL when the memory
* block is deleted. This field must be the
* first in the structure. */
#ifdef TCL_MEM_DEBUG
void *ptr2; /* Backup copy of the above pointer used to
* ensure that the contents of the handle are
|
| ︙ | ︙ |
Changes to generic/tclProc.c.
| ︙ | ︙ | |||
1083 1084 1085 1086 1087 1088 1089 |
numArgs = framePtr->procPtr->numArgs;
desiredObjs = TclStackAlloc(interp,
(int) sizeof(Tcl_Obj *) * (numArgs+1));
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
} else {
| < < < < | 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 |
numArgs = framePtr->procPtr->numArgs;
desiredObjs = TclStackAlloc(interp,
(int) sizeof(Tcl_Obj *) * (numArgs+1));
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
} else {
desiredObjs[0] = framePtr->objv[skip-1];
}
Tcl_IncrRefCount(desiredObjs[0]);
defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
for (i=1 ; i<=numArgs ; i++, defPtr++) {
Tcl_Obj *argObj;
Tcl_Obj *namePtr = localName(framePtr, i-1);
|
| ︙ | ︙ |
Changes to generic/tclRegexp.c.
| ︙ | ︙ | |||
60 61 62 63 64 65 66 | /* * Thread local storage used to maintain a per-thread cache of compiled * regular expressions. */ #define NUM_REGEXPS 30 | | | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 |
/*
* Thread local storage used to maintain a per-thread cache of compiled
* regular expressions.
*/
#define NUM_REGEXPS 30
typedef struct {
int initialized; /* Set to 1 when the module is initialized. */
char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular
* expression patterns. NULL means that this
* slot isn't used. Malloc-ed. */
int patLengths[NUM_REGEXPS];/* Number of non-null characters in
* corresponding entry in patterns. -1 means
* entry isn't used. */
|
| ︙ | ︙ | |||
668 669 670 671 672 673 674 |
* 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,
| | | 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 |
* 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,
Tcl_NewLongObj((long) 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/tclResult.c.
| ︙ | ︙ | |||
23 24 25 26 27 28 29 | /* * Function prototypes for local functions in this file: */ static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); | < | | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
/*
* Function prototypes for local functions in this file:
*/
static Tcl_Obj ** GetKeys(void);
static void ReleaseKeys(ClientData clientData);
static void ResetObjResult(Interp *iPtr);
/*
* This structure is used to take a snapshot of the interpreter state in
* Tcl_SaveInterpState. You can snapshot the state, execute a command, and
* then back up to the result or the error that was previously in progress.
*/
typedef struct {
int status; /* return code status */
int flags; /* Each remaining field saves the */
int returnLevel; /* corresponding field of the Interp */
int returnCode; /* struct. These fields taken together are */
Tcl_Obj *errorInfo; /* the "state" of the interp. */
Tcl_Obj *errorCode;
Tcl_Obj *returnOpts;
|
| ︙ | ︙ | |||
207 208 209 210 211 212 213 |
Tcl_DecrRefCount(statePtr->objResult);
ckfree(statePtr);
}
/*
*----------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 206 207 208 209 210 211 212 213 214 215 216 217 218 219 |
Tcl_DecrRefCount(statePtr->objResult);
ckfree(statePtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetResult --
*
* Arrange for "result" to be the Tcl return value.
*
* Results:
* None.
*
|
| ︙ | ︙ | |||
413 414 415 416 417 418 419 |
* return value. */
register char *result, /* Value to be returned. If NULL, the result
* is set to an empty string. */
Tcl_FreeProc *freeProc) /* Gives information about the string:
* TCL_STATIC, TCL_VOLATILE, or the address of
* a Tcl_FreeProc such as free. */
{
| < < < | | < < < < < | < < < < < < | < < < < < < < < < < < < < | | | | | < < < < < < < | 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 |
* return value. */
register char *result, /* Value to be returned. If NULL, the result
* is set to an empty string. */
Tcl_FreeProc *freeProc) /* Gives information about the string:
* TCL_STATIC, TCL_VOLATILE, or the address of
* a Tcl_FreeProc such as free. */
{
Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) {
return;
}
if (freeProc == TCL_DYNAMIC) {
ckfree(result);
} else {
(*freeProc)(result);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetStringResult --
*
|
| ︙ | ︙ | |||
479 480 481 482 483 484 485 |
*----------------------------------------------------------------------
*/
const char *
Tcl_GetStringResult(
register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
| < < < < < < < < < | | 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 |
*----------------------------------------------------------------------
*/
const char *
Tcl_GetStringResult(
register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
Interp *iPtr = (Interp *) interp;
return Tcl_GetString(iPtr->objResultPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetObjResult --
*
|
| ︙ | ︙ | |||
531 532 533 534 535 536 537 |
/*
* We wait until the end to release the old object result, in case we are
* setting the result to itself.
*/
TclDecrRefCount(oldObjResult);
| < < < < < < < < < < < < < < < | 305 306 307 308 309 310 311 312 313 314 315 316 317 318 |
/*
* We wait until the end to release the old object result, in case we are
* setting the result to itself.
*/
TclDecrRefCount(oldObjResult);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetObjResult --
*
|
| ︙ | ︙ | |||
574 575 576 577 578 579 580 |
*/
Tcl_Obj *
Tcl_GetObjResult(
Tcl_Interp *interp) /* Interpreter whose result to return. */
{
register Interp *iPtr = (Interp *) interp;
| < < < < < < < < < < < < < < < < < < < < < < < < < | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 |
*/
Tcl_Obj *
Tcl_GetObjResult(
Tcl_Interp *interp) /* Interpreter whose result to return. */
{
register Interp *iPtr = (Interp *) interp;
return iPtr->objResultPtr;
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendResultVA --
|
| ︙ | ︙ | |||
636 637 638 639 640 641 642 |
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
if (Tcl_IsShared(objPtr)) {
objPtr = Tcl_DuplicateObj(objPtr);
}
Tcl_AppendStringsToObjVA(objPtr, argList);
Tcl_SetObjResult(interp, objPtr);
| < < < < < < < < < < < < < < < < < | 370 371 372 373 374 375 376 377 378 379 380 381 382 383 |
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
if (Tcl_IsShared(objPtr)) {
objPtr = Tcl_DuplicateObj(objPtr);
}
Tcl_AppendStringsToObjVA(objPtr, argList);
Tcl_SetObjResult(interp, objPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendResult --
*
|
| ︙ | ︙ | |||
718 719 720 721 722 723 724 |
Tcl_AppendElement(
Tcl_Interp *interp, /* Interpreter whose result is to be
* extended. */
const char *element) /* String to convert to list element and add
* to result. */
{
Interp *iPtr = (Interp *) interp;
| < < < | < < < < | < | < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < | < < < < < < | < < < < < < < < < < < < | < < | < < < | < < < < | < < < | < < < < < < | < < | | | | | < | < < < < < < < < < | 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 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 |
Tcl_AppendElement(
Tcl_Interp *interp, /* Interpreter whose result is to be
* extended. */
const char *element) /* String to convert to list element and add
* to result. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
int length;
const char *bytes;
if (Tcl_IsShared(iPtr->objResultPtr)) {
Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
}
bytes = TclGetStringFromObj(iPtr->objResultPtr, &length);
if (TclNeedSpace(bytes, bytes+length)) {
Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
}
Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
Tcl_DecrRefCount(listPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_FreeResult --
*
* This function frees up the memory associated with an interpreter's
* result, resetting the interpreter's result object. Tcl_FreeResult is
* most commonly used when a function is about to replace one result
* value with another.
*
* Results:
* None.
*
* Side effects:
* Frees the memory associated with interp's result but does not change
* any part of the error dictionary (i.e., the errorinfo and errorcode
* remain the same).
*
*----------------------------------------------------------------------
*/
void
Tcl_FreeResult(
register Tcl_Interp *interp)/* Interpreter for which to free result. */
{
register Interp *iPtr = (Interp *) interp;
ResetObjResult(iPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_ResetResult --
|
| ︙ | ︙ | |||
909 910 911 912 913 914 915 |
void
Tcl_ResetResult(
register Tcl_Interp *interp)/* Interpreter for which to clear result. */
{
register Interp *iPtr = (Interp *) interp;
ResetObjResult(iPtr);
| < < < < < < < < < < | 507 508 509 510 511 512 513 514 515 516 517 518 519 520 |
void
Tcl_ResetResult(
register Tcl_Interp *interp)/* Interpreter for which to clear result. */
{
register Interp *iPtr = (Interp *) interp;
ResetObjResult(iPtr);
if (iPtr->errorCode) {
/* Legacy support */
if (iPtr->flags & ERR_LEGACY_COPY) {
Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
iPtr->errorCode, TCL_GLOBAL_ONLY);
}
Tcl_DecrRefCount(iPtr->errorCode);
|
| ︙ | ︙ | |||
1108 1109 1110 1111 1112 1113 1114 | * Tcl_GetErrorLine -- * * Returns the line number associated with the current error. * *---------------------------------------------------------------------- */ | < < | 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 |
* Tcl_GetErrorLine --
*
* Returns the line number associated with the current error.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetErrorLine(
Tcl_Interp *interp)
{
return ((Interp *) interp)->errorLine;
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetErrorLine --
*
* Sets the line number associated with the current error.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetErrorLine(
Tcl_Interp *interp,
int value)
{
((Interp *) interp)->errorLine = value;
}
|
| ︙ | ︙ |
Changes to generic/tclScan.c.
| ︙ | ︙ | |||
24 25 26 27 28 29 30 | #define SCAN_BIG 0x800 /* Asked for a bignum value. */ /* * The following structure contains the information associated with a * character set. */ | | | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 |
#define SCAN_BIG 0x800 /* Asked for a bignum value. */
/*
* The following structure contains the information associated with a
* character set.
*/
typedef struct {
int exclude; /* 1 if this is an exclusion set. */
int nchars;
Tcl_UniChar *chars;
int nranges;
struct Range {
Tcl_UniChar start;
Tcl_UniChar end;
|
| ︙ | ︙ |
Changes to generic/tclStrToD.c.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath.h" #include <math.h> | < < < < < < < | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath.h" #include <math.h> /* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be * uniquely determined by radix and by the widths of significand and exponent. */ #if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024) |
| ︙ | ︙ | |||
486 487 488 489 490 491 492 |
const char **endPtrPtr, /* Place to store pointer to the character
* that terminated the scan. */
int flags) /* Flags governing the parse. */
{
enum State {
INITIAL, SIGNUM, ZERO, ZERO_X,
ZERO_O, ZERO_B, BINARY,
| | | 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 |
const char **endPtrPtr, /* Place to store pointer to the character
* that terminated the scan. */
int flags) /* Flags governing the parse. */
{
enum State {
INITIAL, SIGNUM, ZERO, ZERO_X,
ZERO_O, ZERO_B, BINARY,
HEXADECIMAL, OCTAL, DECIMAL,
LEADING_RADIX_POINT, FRACTION,
EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY
#ifdef IEEE_FLOATING_POINT
, sN, sNA, sNAN, sNANPAREN, sNANHEX, sNANFINISH
#endif
} state = INITIAL;
|
| ︙ | ︙ | |||
531 532 533 534 535 536 537 |
* an acceptable number. */
size_t acceptLen; /* Number of characters following that
* point. */
int status = TCL_OK; /* Status to return to caller. */
char d = 0; /* Last hexadecimal digit scanned; initialized
* to avoid a compiler warning. */
int shift = 0; /* Amount to shift when accumulating binary */
| < | 524 525 526 527 528 529 530 531 532 533 534 535 536 537 |
* an acceptable number. */
size_t acceptLen; /* Number of characters following that
* point. */
int status = TCL_OK; /* Status to return to caller. */
char d = 0; /* Last hexadecimal digit scanned; initialized
* to avoid a compiler warning. */
int shift = 0; /* Amount to shift when accumulating binary */
#define ALL_BITS (~(Tcl_WideUInt)0)
#define MOST_BITS (ALL_BITS >> 1)
/*
* Initialize bytes to start of the object's string rep if the caller
* didn't pass anything else.
|
| ︙ | ︙ | |||
649 650 651 652 653 654 655 |
state = ZERO_B;
break;
}
if (flags & TCL_PARSE_BINARY_ONLY) {
goto zerob;
}
if (c == 'o' || c == 'O') {
| < < < < | 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 |
state = ZERO_B;
break;
}
if (flags & TCL_PARSE_BINARY_ONLY) {
goto zerob;
}
if (c == 'o' || c == 'O') {
state = ZERO_O;
break;
}
goto decimal;
case OCTAL:
/*
* Scanned an optional + or -, followed by a string of octal
* digits. Acceptable inputs are more digits, period, or E. If 8
* or 9 is encountered, commit to floating point.
*/
|
| ︙ | ︙ | |||
719 720 721 722 723 724 725 |
} else {
numSigDigs = 1;
}
numTrailZeros = 0;
state = OCTAL;
break;
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 707 708 709 710 711 712 713 714 715 716 717 718 719 720 |
} else {
numSigDigs = 1;
}
numTrailZeros = 0;
state = OCTAL;
break;
}
goto endgame;
/*
* Scanned 0x. If state is HEXADECIMAL, scanned at least one
* character following the 0x. The only acceptable inputs are
* hexadecimal digits.
*/
|
| ︙ | ︙ | |||
875 876 877 878 879 880 881 | case DECIMAL: /* * Scanned an optional + or - followed by a string of decimal * digits. */ | < < | 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 |
case DECIMAL:
/*
* Scanned an optional + or - followed by a string of decimal
* digits.
*/
decimal:
acceptState = state;
acceptPoint = p;
acceptLen = len;
if (c == '0') {
numTrailZeros++;
state = DECIMAL;
break;
|
| ︙ | ︙ | |||
1161 1162 1163 1164 1165 1166 1167 |
* Generate and store the appropriate internal rep.
*/
if (status == TCL_OK && objPtr != NULL) {
TclFreeIntRep(objPtr);
switch (acceptState) {
case SIGNUM:
| < | 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 |
* Generate and store the appropriate internal rep.
*/
if (status == TCL_OK && objPtr != NULL) {
TclFreeIntRep(objPtr);
switch (acceptState) {
case SIGNUM:
case ZERO_X:
case ZERO_O:
case ZERO_B:
case LEADING_RADIX_POINT:
case EXPONENT_START:
case EXPONENT_SIGNUM:
case sI:
|
| ︙ | ︙ | |||
1386 1387 1388 1389 1390 1391 1392 |
if (status != TCL_OK) {
if (interp != NULL) {
Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"",
expected);
Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
Tcl_AppendToObj(msg, "\"", -1);
| < < < | 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 |
if (status != TCL_OK) {
if (interp != NULL) {
Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"",
expected);
Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
Tcl_AppendToObj(msg, "\"", -1);
Tcl_SetObjResult(interp, msg);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
}
}
/*
* Free memory.
|
| ︙ | ︙ |
Changes to generic/tclStringObj.c.
| ︙ | ︙ | |||
41 42 43 44 45 46 47 | /* * Prototypes for functions defined later in this file: */ static void AppendPrintfToObjVA(Tcl_Obj *objPtr, const char *format, va_list argList); static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, | | | | | | | | | | | | | | 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 | /* * Prototypes for functions defined later in this file: */ static void AppendPrintfToObjVA(Tcl_Obj *objPtr, const char *format, va_list argList); static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t appendNumChars); static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, const char *bytes, size_t numBytes); static void AppendUtfToUtfRep(Tcl_Obj *objPtr, const char *bytes, size_t numBytes); static void DupStringInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static size_t ExtendStringRepWithUnicode(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, const char *bytes, size_t numBytes, size_t numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); static void GrowStringBuffer(Tcl_Obj *objPtr, size_t needed, int flag); static void GrowUnicodeBuffer(Tcl_Obj *objPtr, size_t needed); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); static size_t UnicodeLength(const Tcl_UniChar *unicode); static void UpdateStringOfString(Tcl_Obj *objPtr); /* * The structure below defines the string Tcl object type by means of * functions that can be invoked by generic object code. */ |
| ︙ | ︙ | |||
118 119 120 121 122 123 124 |
#ifndef TCL_MIN_UNICHAR_GROWTH
#define TCL_MIN_UNICHAR_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif
static void
GrowStringBuffer(
Tcl_Obj *objPtr,
| | | | | | | | | | | | | | 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 153 154 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 |
#ifndef TCL_MIN_UNICHAR_GROWTH
#define TCL_MIN_UNICHAR_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif
static void
GrowStringBuffer(
Tcl_Obj *objPtr,
size_t needed,
int flag)
{
/*
* Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->allocated
* flag || objPtr->bytes != NULL
*/
String *stringPtr = GET_STRING(objPtr);
char *ptr = NULL;
size_t attempt;
if (objPtr->bytes == tclEmptyStringRep) {
objPtr->bytes = NULL;
}
if (flag == 0 || stringPtr->allocated > 0) {
attempt = 2 * needed;
if (attempt <= STRING_MAXCHARS) {
ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
}
if (ptr == NULL) {
/*
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
size_t limit = INT_MAX - needed;
size_t extra = needed - objPtr->length + TCL_MIN_GROWTH;
size_t growth = (extra > limit) ? limit : extra;
attempt = needed + growth;
ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
}
}
if (ptr == NULL) {
/*
* First allocation - just big enough; or last chance fallback.
*/
attempt = needed;
ptr = ckrealloc(objPtr->bytes, attempt + 1);
}
objPtr->bytes = ptr;
stringPtr->allocated = attempt;
}
static void
GrowUnicodeBuffer(
Tcl_Obj *objPtr,
size_t needed)
{
/*
* Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->maxChars
* needed < STRING_MAXCHARS
*/
String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
size_t attempt;
if (stringPtr->maxChars > 0) {
/*
* Subsequent appends - apply the growth algorithm.
*/
attempt = 2 * needed;
if (attempt <= STRING_MAXCHARS) {
ptr = stringAttemptRealloc(stringPtr, attempt);
}
if (ptr == NULL) {
/*
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
size_t limit = STRING_MAXCHARS - needed;
size_t extra = needed - stringPtr->numChars1
+ TCL_MIN_UNICHAR_GROWTH;
size_t growth = (extra > limit) ? limit : extra;
attempt = needed + growth;
ptr = stringAttemptRealloc(stringPtr, attempt);
}
}
if (ptr == NULL) {
/*
|
| ︙ | ︙ | |||
432 433 434 435 436 437 438 |
/*
* OK, need to work with the object as a string.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
| | | | 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 |
/*
* OK, need to work with the object as a string.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
numChars = stringPtr->numChars1;
/*
* If numChars is unknown, compute it.
*/
if (numChars == -1) {
TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
stringPtr->numChars1 = numChars;
}
return numChars;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
494 495 496 497 498 499 500 |
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
/*
* If numChars is unknown, compute it.
*/
| | | | | 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 |
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
/*
* If numChars is unknown, compute it.
*/
if (stringPtr->numChars1 == (size_t)-1) {
TclNumUtfChars(stringPtr->numChars1, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars1 == (size_t)objPtr->length) {
return (Tcl_UniChar) objPtr->bytes[index];
}
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
return stringPtr->unicode[index];
}
|
| ︙ | ︙ | |||
571 572 573 574 575 576 577 |
if (stringPtr->hasUnicode == 0) {
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (lengthPtr != NULL) {
| | | 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 |
if (stringPtr->hasUnicode == 0) {
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (lengthPtr != NULL) {
*lengthPtr = stringPtr->numChars1;
}
return stringPtr->unicode;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
628 629 630 631 632 633 634 |
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
/*
* If numChars is unknown, compute it.
*/
| | | | | | 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 |
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
/*
* If numChars is unknown, compute it.
*/
if (stringPtr->numChars1 == (size_t)-1) {
TclNumUtfChars(stringPtr->numChars1, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars1 == (size_t)objPtr->length) {
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
/*
* Since we know the char length of the result, store it.
*/
SetStringFromAny(NULL, newObjPtr);
stringPtr = GET_STRING(newObjPtr);
stringPtr->numChars1 = newObjPtr->length;
return newObjPtr;
}
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
|
| ︙ | ︙ | |||
759 760 761 762 763 764 765 |
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (objPtr->bytes != NULL) {
/*
* Change length of an existing string rep.
*/
| | | | | | 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 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 |
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (objPtr->bytes != NULL) {
/*
* Change length of an existing string rep.
*/
if ((size_t)length > stringPtr->allocated) {
/*
* Need to enlarge the buffer.
*/
if (objPtr->bytes == tclEmptyStringRep) {
objPtr->bytes = ckalloc(length + 1);
} else {
objPtr->bytes = ckrealloc(objPtr->bytes, length + 1);
}
stringPtr->allocated = length;
}
objPtr->length = length;
objPtr->bytes[length] = 0;
/*
* Invalidate the unicode data.
*/
stringPtr->numChars1 = (size_t)-1;
stringPtr->hasUnicode = 0;
} else {
/*
* Changing length of pure unicode string.
*/
stringCheckLimits(length);
if ((size_t)length > stringPtr->maxChars) {
stringPtr = stringRealloc(stringPtr, length);
SET_STRING(objPtr, stringPtr);
stringPtr->maxChars = length;
}
/*
* Mark the new end of the unicode string
*/
stringPtr->numChars1 = length;
stringPtr->unicode[length] = 0;
stringPtr->hasUnicode = 1;
/*
* Can only get here when objPtr->bytes == NULL. No need to invalidate
* the string rep.
*/
|
| ︙ | ︙ | |||
862 863 864 865 866 867 868 |
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (objPtr->bytes != NULL) {
/*
* Change length of an existing string rep.
*/
| | | 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 |
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (objPtr->bytes != NULL) {
/*
* Change length of an existing string rep.
*/
if ((size_t)length > stringPtr->allocated) {
/*
* Need to enlarge the buffer.
*/
char *newBytes;
if (objPtr->bytes == tclEmptyStringRep) {
|
| ︙ | ︙ | |||
888 889 890 891 892 893 894 | objPtr->length = length; objPtr->bytes[length] = 0; /* * Invalidate the unicode data. */ | | | | | | 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 |
objPtr->length = length;
objPtr->bytes[length] = 0;
/*
* Invalidate the unicode data.
*/
stringPtr->numChars1 = (size_t)-1;
stringPtr->hasUnicode = 0;
} else {
/*
* Changing length of pure unicode string.
*/
if ((size_t)length > STRING_MAXCHARS) {
return 0;
}
if ((size_t)length > stringPtr->maxChars) {
stringPtr = stringAttemptRealloc(stringPtr, length);
if (stringPtr == NULL) {
return 0;
}
SET_STRING(objPtr, stringPtr);
stringPtr->maxChars = length;
}
/*
* Mark the new end of the unicode string.
*/
stringPtr->unicode[length] = 0;
stringPtr->numChars1 = length;
stringPtr->hasUnicode = 1;
/*
* Can only get here when objPtr->bytes == NULL. No need to invalidate
* the string rep.
*/
}
|
| ︙ | ︙ | |||
954 955 956 957 958 959 960 |
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
}
TclFreeIntRep(objPtr);
SetUnicodeObj(objPtr, unicode, numChars);
}
| | | | | | | | 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 |
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
}
TclFreeIntRep(objPtr);
SetUnicodeObj(objPtr, unicode, numChars);
}
static size_t
UnicodeLength(
const Tcl_UniChar *unicode)
{
size_t numChars = 0;
if (unicode) {
while (numChars != (size_t)-1 && unicode[numChars] != 0) {
numChars++;
}
}
stringCheckLimits(numChars);
return numChars;
}
static void
SetUnicodeObj(
Tcl_Obj *objPtr, /* The object to set the string of. */
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* object. */
size_t numChars) /* Number of characters in the unicode
* string. */
{
String *stringPtr;
if (numChars == (size_t)-1) {
numChars = UnicodeLength(unicode);
}
/*
* Allocate enough space for the String structure + Unicode string.
*/
stringCheckLimits(numChars);
stringPtr = stringAlloc(numChars);
SET_STRING(objPtr, stringPtr);
objPtr->typePtr = &tclStringType;
stringPtr->maxChars = numChars;
memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar));
stringPtr->unicode[numChars] = 0;
stringPtr->numChars1 = numChars;
stringPtr->hasUnicode = 1;
TclInvalidateStringRep(objPtr);
stringPtr->allocated = 0;
}
/*
|
| ︙ | ︙ | |||
1067 1068 1069 1070 1071 1072 1073 |
* of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to
* objPtr's string rep.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
| | | | 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 |
* of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to
* objPtr's string rep.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode && (stringPtr->numChars1+1) > 1) {
AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
} else {
AppendUtfToUtfRep(objPtr, bytes, toCopy);
}
if (length <= limit) {
return;
}
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode && (stringPtr->numChars1+1) > 1) {
AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis));
} else {
AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis));
}
}
/*
|
| ︙ | ︙ | |||
1190 1191 1192 1193 1194 1195 1196 |
void
Tcl_AppendObjToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
Tcl_Obj *appendObjPtr) /* Object to append. */
{
String *stringPtr;
| | > | 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 |
void
Tcl_AppendObjToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
Tcl_Obj *appendObjPtr) /* Object to append. */
{
String *stringPtr;
int length, numChars;
size_t appendNumChars = (size_t)-1;
const char *bytes;
/*
* Special case: second object is standard-empty is fast case. We know
* that appending nothing to anything leaves that starting anything...
*/
|
| ︙ | ︙ | |||
1288 1289 1290 1291 1292 1293 1294 |
* Append to objPtr's UTF string rep. If we know the number of characters
* in both objects before appending, then set the combined number of
* characters in the final (appended-to) object.
*/
bytes = TclGetStringFromObj(appendObjPtr, &length);
| | | | | | 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 |
* Append to objPtr's UTF string rep. If we know the number of characters
* in both objects before appending, then set the combined number of
* characters in the final (appended-to) object.
*/
bytes = TclGetStringFromObj(appendObjPtr, &length);
numChars = stringPtr->numChars1;
if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
String *appendStringPtr = GET_STRING(appendObjPtr);
appendNumChars = appendStringPtr->numChars1;
}
AppendUtfToUtfRep(objPtr, bytes, length);
if (numChars >= 0 && appendNumChars != (size_t)-1) {
stringPtr->numChars1 = numChars + appendNumChars;
}
}
/*
*----------------------------------------------------------------------
*
* AppendUnicodeToUnicodeRep --
|
| ︙ | ︙ | |||
1322 1323 1324 1325 1326 1327 1328 |
*----------------------------------------------------------------------
*/
static void
AppendUnicodeToUnicodeRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to append. */
| | | | | | | | | | 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 |
*----------------------------------------------------------------------
*/
static void
AppendUnicodeToUnicodeRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to append. */
size_t appendNumChars) /* Number of chars of "unicode" to append. */
{
String *stringPtr;
size_t numChars;
if (appendNumChars == (size_t)-1) {
appendNumChars = UnicodeLength(unicode);
}
if (appendNumChars == 0) {
return;
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/*
* If not enough space has been allocated for the unicode rep, reallocate
* the internal rep object with additional space. First try to double the
* required allocation; if that fails, try a more modest increase. See the
* "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
* explanation of this growth algorithm.
*/
numChars = stringPtr->numChars1 + appendNumChars;
stringCheckLimits(numChars);
if (numChars > stringPtr->maxChars) {
size_t offset = (size_t)-1;
/*
* 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) {
offset = unicode - stringPtr->unicode;
}
GrowUnicodeBuffer(objPtr, numChars);
stringPtr = GET_STRING(objPtr);
/*
* Relocate unicode if needed; see above.
*/
if (offset != (size_t)-1) {
unicode = stringPtr->unicode + offset;
}
}
/*
* Copy the new string onto the end of the old string, then add the
* trailing null.
*/
if (unicode) {
memmove(stringPtr->unicode + stringPtr->numChars1, unicode,
appendNumChars * sizeof(Tcl_UniChar));
}
stringPtr->unicode[numChars] = 0;
stringPtr->numChars1 = numChars;
stringPtr->allocated = 0;
TclInvalidateStringRep(objPtr);
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
1411 1412 1413 1414 1415 1416 1417 |
*----------------------------------------------------------------------
*/
static void
AppendUnicodeToUtfRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to convert to UTF. */
| | | | | 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 |
*----------------------------------------------------------------------
*/
static void
AppendUnicodeToUtfRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to convert to UTF. */
size_t numChars) /* Number of chars of "unicode" to convert. */
{
String *stringPtr = GET_STRING(objPtr);
numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);
if (stringPtr->numChars1 != (size_t)-1) {
stringPtr->numChars1 += numChars;
}
}
/*
*----------------------------------------------------------------------
*
* AppendUtfToUnicodeRep --
|
| ︙ | ︙ | |||
1444 1445 1446 1447 1448 1449 1450 |
*----------------------------------------------------------------------
*/
static void
AppendUtfToUnicodeRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* String to convert to Unicode. */
| | | 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 |
*----------------------------------------------------------------------
*/
static void
AppendUtfToUnicodeRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* String to convert to Unicode. */
size_t numBytes) /* Number of bytes of "bytes" to convert. */
{
String *stringPtr;
if (numBytes == 0) {
return;
}
|
| ︙ | ︙ | |||
1480 1481 1482 1483 1484 1485 1486 |
*----------------------------------------------------------------------
*/
static void
AppendUtfToUtfRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* String to append. */
| | | | | | 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 |
*----------------------------------------------------------------------
*/
static void
AppendUtfToUtfRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* String to append. */
size_t numBytes) /* Number of bytes of "bytes" to append. */
{
String *stringPtr;
size_t newLength, oldLength;
if (numBytes == 0) {
return;
}
/*
* Copy the new string onto the end of the old string, then add the
* trailing null.
*/
if (objPtr->bytes == NULL) {
objPtr->length = 0;
}
oldLength = objPtr->length;
newLength = numBytes + oldLength;
if ((int)newLength < 0) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
stringPtr = GET_STRING(objPtr);
if (newLength > stringPtr->allocated) {
size_t offset = (size_t)-1;
/*
* Protect against case where unicode points into the existing
* stringPtr->unicode array. Force it to follow any relocations due to
* the reallocs below.
*/
|
| ︙ | ︙ | |||
1529 1530 1531 1532 1533 1534 1535 | GrowStringBuffer(objPtr, newLength, 0); /* * Relocate bytes if needed; see above. */ | | | | 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 |
GrowStringBuffer(objPtr, newLength, 0);
/*
* Relocate bytes if needed; see above.
*/
if (offset != (size_t)-1) {
bytes = objPtr->bytes + offset;
}
}
/*
* Invalidate the unicode data.
*/
stringPtr->numChars1 = (size_t)-1;
stringPtr->hasUnicode = 0;
if (bytes) {
memmove(objPtr->bytes + oldLength, bytes, numBytes);
}
objPtr->bytes[newLength] = 0;
objPtr->length = newLength;
|
| ︙ | ︙ | |||
3098 3099 3100 3101 3102 3103 3104 |
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode) {
Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
| | | | | 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 |
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode) {
Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
Tcl_UniChar *src = from + stringPtr->numChars1;
if (Tcl_IsShared(objPtr)) {
Tcl_UniChar *to;
/*
* Create a non-empty, pure unicode value, so we can coax
* Tcl_SetObjLength into growing the unicode rep buffer.
*/
ch = 0;
objPtr = Tcl_NewUnicodeObj(&ch, 1);
Tcl_SetObjLength(objPtr, stringPtr->numChars1);
to = Tcl_GetUnicode(objPtr);
while (--src >= from) {
*to++ = *src;
}
} else {
/* Reversing in place */
while (--src > from) {
ch = *src;
*src = *from;
*from++ = ch;
}
}
}
if (objPtr->bytes) {
int numChars = stringPtr->numChars1;
int numBytes = objPtr->length;
char *to, *from = objPtr->bytes;
if (Tcl_IsShared(objPtr)) {
objPtr = Tcl_NewObj();
Tcl_SetObjLength(objPtr, numBytes);
}
|
| ︙ | ︙ | |||
3165 3166 3167 3168 3169 3170 3171 | to += bytesInChar; from += bytesInChar; bytesLeft -= bytesInChar; charCount++; } from = to = objPtr->bytes; | | | 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 |
to += bytesInChar;
from += bytesInChar;
bytesLeft -= bytesInChar;
charCount++;
}
from = to = objPtr->bytes;
stringPtr->numChars1 = charCount;
}
/* Pass 2. Reverse all the bytes. */
ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
}
return objPtr;
}
|
| ︙ | ︙ | |||
3199 3200 3201 3202 3203 3204 3205 |
FillUnicodeRep(
Tcl_Obj *objPtr) /* The object in which to fill the unicode
* rep. */
{
String *stringPtr = GET_STRING(objPtr);
ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
| | | | | | | | | 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 |
FillUnicodeRep(
Tcl_Obj *objPtr) /* The object in which to fill the unicode
* rep. */
{
String *stringPtr = GET_STRING(objPtr);
ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
stringPtr->numChars1);
}
static void
ExtendUnicodeRepWithString(
Tcl_Obj *objPtr,
const char *bytes,
size_t numBytes,
size_t numAppendChars)
{
String *stringPtr = GET_STRING(objPtr);
size_t needed, numOrigChars = 0;
Tcl_UniChar *dst;
if (stringPtr->hasUnicode) {
numOrigChars = stringPtr->numChars1;
}
if (numAppendChars == (size_t)-1) {
TclNumUtfChars(numAppendChars, bytes, numBytes);
}
needed = numOrigChars + numAppendChars;
stringCheckLimits(needed);
if (needed > stringPtr->maxChars) {
GrowUnicodeBuffer(objPtr, needed);
stringPtr = GET_STRING(objPtr);
}
stringPtr->hasUnicode = 1;
if (bytes) {
stringPtr->numChars1 = needed;
} else {
numAppendChars = 0;
}
for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
bytes += TclUtfToUniChar(bytes, dst);
}
*dst = 0;
|
| ︙ | ︙ | |||
3267 3268 3269 3270 3271 3272 3273 |
* an internal rep of type "String". */
Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
String *srcStringPtr = GET_STRING(srcPtr);
String *copyStringPtr = NULL;
| | | | | | | | | 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 |
* an internal rep of type "String". */
Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
String *srcStringPtr = GET_STRING(srcPtr);
String *copyStringPtr = NULL;
if (srcStringPtr->numChars1 == (size_t)-1) {
/*
* The String struct in the source value holds zero useful data. Don't
* bother copying it. Don't even bother allocating space in which to
* copy it. Just let the copy be untyped.
*/
return;
}
if (srcStringPtr->hasUnicode) {
int copyMaxChars;
if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars1) {
copyMaxChars = 2 * srcStringPtr->numChars1;
} else {
copyMaxChars = srcStringPtr->maxChars;
}
copyStringPtr = stringAttemptAlloc(copyMaxChars);
if (copyStringPtr == NULL) {
copyMaxChars = srcStringPtr->numChars1;
copyStringPtr = stringAlloc(copyMaxChars);
}
copyStringPtr->maxChars = copyMaxChars;
memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
srcStringPtr->numChars1 * sizeof(Tcl_UniChar));
copyStringPtr->unicode[srcStringPtr->numChars1] = 0;
} else {
copyStringPtr = stringAlloc(0);
copyStringPtr->maxChars = 0;
copyStringPtr->unicode[0] = 0;
}
copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
copyStringPtr->numChars1 = srcStringPtr->numChars1;
/*
* Tricky point: the string value was copied by generic object management
* code, so it doesn't contain any extra bytes that might exist in the
* source object.
*/
|
| ︙ | ︙ | |||
3351 3352 3353 3354 3355 3356 3357 | TclFreeIntRep(objPtr); /* * Create a basic String intrep that just points to the UTF-8 string * already in place at objPtr->bytes. */ | | | 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 |
TclFreeIntRep(objPtr);
/*
* Create a basic String intrep that just points to the UTF-8 string
* already in place at objPtr->bytes.
*/
stringPtr->numChars1 = (size_t)-1;
stringPtr->allocated = objPtr->length;
stringPtr->maxChars = 0;
stringPtr->hasUnicode = 0;
SET_STRING(objPtr, stringPtr);
objPtr->typePtr = &tclStringType;
}
return TCL_OK;
|
| ︙ | ︙ | |||
3395 3396 3397 3398 3399 3400 3401 |
* In that circumstance, any lingering claim about the size of
* memory pointed to by that NULL pointer is clearly bogus, and
* needs a reset.
*/
stringPtr->allocated = 0;
| | | | | | | | 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 |
* In that circumstance, any lingering claim about the size of
* memory pointed to by that NULL pointer is clearly bogus, and
* needs a reset.
*/
stringPtr->allocated = 0;
if (stringPtr->numChars1 == 0) {
TclInitStringRep(objPtr, tclEmptyStringRep, 0);
} else {
(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
stringPtr->numChars1);
}
}
static size_t
ExtendStringRepWithUnicode(
Tcl_Obj *objPtr,
const Tcl_UniChar *unicode,
size_t numChars)
{
/*
* Pre-condition: this is the "string" Tcl_ObjType.
*/
size_t i, origLength, size = 0;
char *dst;
String *stringPtr = GET_STRING(objPtr);
if (numChars == (size_t)-1) {
numChars = UnicodeLength(unicode);
}
if (numChars == 0) {
return 0;
}
|
| ︙ | ︙ | |||
3442 3443 3444 3445 3446 3447 3448 |
&& stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
goto copyBytes;
}
for (i = 0; i < numChars && size >= 0; i++) {
size += TclUtfCount(unicode[i]);
}
| | | 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 |
&& stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
goto copyBytes;
}
for (i = 0; i < numChars && size >= 0; i++) {
size += TclUtfCount(unicode[i]);
}
if ((int)size < 0) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
/*
* Grow space if needed.
*/
|
| ︙ | ︙ |
Changes to generic/tclStringRep.h.
| ︙ | ︙ | |||
43 44 45 46 47 48 49 |
* Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
* restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
* can be officially modified by altering the definition of Tcl_UniChar in
* tcl.h, but do not do that unless you are sure what you're doing!
*/
typedef struct {
| | | | | | | | | | | | | | 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 |
* Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
* restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
* can be officially modified by altering the definition of Tcl_UniChar in
* tcl.h, but do not do that unless you are sure what you're doing!
*/
typedef struct {
size_t numChars1; /* The number of chars in the string. (size_t)-1 means
* this value has not been calculated. Any other
* means that there is a valid Unicode rep, or
* that the number of UTF bytes == the number
* of chars. */
size_t allocated; /* The amount of space actually allocated for
* the UTF string (minus 1 byte for the
* termination char). */
size_t maxChars; /* Max number of chars that can fit in the
* space allocated for the unicode array. */
int hasUnicode; /* Boolean determining whether the string has
* a Unicode representation. */
Tcl_UniChar unicode[1]; /* The array of Unicode chars. The actual size
* of this field depends on the 'maxChars'
* field above. */
} String;
#define STRING_MAXCHARS \
((UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
#define STRING_SIZE(numChars) \
(sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
#define stringCheckLimits(numChars) \
do { \
if ((size_t)(numChars) > STRING_MAXCHARS) { \
Tcl_Panic("max length for a Tcl unicode value (%" TCL_LL_MODIFIER "d chars) exceeded", \
(Tcl_WideInt)STRING_MAXCHARS); \
} \
} while (0)
#define stringAttemptAlloc(numChars) \
(String *) attemptckalloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
(String *) ckalloc(STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \
(String *) ckrealloc((ptr), STRING_SIZE(numChars))
#define stringAttemptRealloc(ptr, numChars) \
(String *) attemptckrealloc((ptr), STRING_SIZE(numChars))
#define GET_STRING(objPtr) \
((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
/*
* Local Variables:
|
| ︙ | ︙ |
Changes to generic/tclStubInit.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 | /* * tclStubInit.c -- * * This file contains the initializers for the Tcl stub vectors. * * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath.h" #ifdef __GNUC__ #pragma GCC dependency "tcl.decls" #pragma GCC dependency "tclInt.decls" #pragma GCC dependency "tclTomMath.decls" #endif /* * Remove macros that will interfere with the definitions below. */ #undef Tcl_Alloc #undef Tcl_Free #undef Tcl_Realloc | > > > > > > > > < < < < | < | < < < < < < < < | < < | < < < < | < < < < < < < < < < < < > | < < < < | > > > > | < | < | < | < > > | < < > > | < < | 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 |
/*
* tclStubInit.c --
*
* This file contains the initializers for the Tcl stub vectors.
*
* Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
#include "tclOOInt.h"
#include "tommath.h"
/*
* The actual definition of the variable holding the TclOO stub table.
*/
MODULE_SCOPE const TclOOStubs tclOOStubs;
MODULE_SCOPE const TclOOIntStubs tclOOIntStubs;
#ifdef __GNUC__
#pragma GCC dependency "tcl.decls"
#pragma GCC dependency "tclInt.decls"
#pragma GCC dependency "tclTomMath.decls"
#endif
/*
* Remove macros that will interfere with the definitions below.
*/
#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc
#undef Tcl_NewByteArrayObj
#undef Tcl_NewDoubleObj
#undef Tcl_NewListObj
#undef Tcl_NewLongObj
#undef Tcl_NewObj
#undef Tcl_NewStringObj
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
#undef TclpGetPid
#undef TclPkgProvide
#undef Tcl_SetIntObj
#define TclPkgProvide pkgProvide
static int TclPkgProvide(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
const char *name, /* Name of package. */
const char *version) /* Version string for package. */
{
/* In Tcl 9, Tcl_PkgProvide is a macro calling Tcl_PkgProvideEx.
* The only way this stub can be called is by an extension compiled
* against Tcl 8 headers. The Tcl_StubsInit() function already
* succeeded, so the extension author lied: It did something like:
* Tcl_StubsInit(interp, "8.6-", 0)
* or
* Tcl_StubsInit(interp, "8.6-9.1", 0)
*
* The best we can do is provide an error-message, as if the
* extension originally called:
* Tcl_StubsInit(interp, "8", 0)
*/
Tcl_PkgRequireEx(interp, "Tcl", "8", 0, NULL);
return TCL_ERROR;
}
#ifdef _WIN32
# define TclUnixWaitForFile 0
# define TclUnixCopyFile 0
# define TclUnixOpenTemporaryFile 0
# define TclpIsAtty 0
#elif defined(__CYGWIN__)
# define TclpIsAtty TclPlatIsAtty
# define TclWinSetInterfaces (void (*) (int)) doNothing
# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
# define TclWinFlushDirtyChannels doNothing
# define TclWinResetInterfaces doNothing
|
| ︙ | ︙ | |||
127 128 129 130 131 132 133 |
{
void *hInstance = NULL;
GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
(const char *)&winTCharEncoding, &hInstance);
return hInstance;
}
| < < < < < < < < < < < < < < < < < < < < < < < | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 |
{
void *hInstance = NULL;
GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
(const char *)&winTCharEncoding, &hInstance);
return hInstance;
}
#define TclWinNoBackslash winNoBackslash
static char *
TclWinNoBackslash(char *path)
{
char *p;
for (p = path; *p != '\0'; p++) {
|
| ︙ | ︙ | |||
262 263 264 265 266 267 268 |
"integer value too large to represent as non-long integer", -1));
result = TCL_ERROR;
}
}
return result;
}
#define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj
| < < < < < < < < < < < < < < < < < < < | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 |
"integer value too large to represent as non-long integer", -1));
result = TCL_ERROR;
}
}
return result;
}
#define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj
static int formatInt(char *buffer, int n){
return TclFormatInt(buffer, (long)n);
}
#define TclFormatInt (int(*)(char *, long))formatInt
#endif
#endif
/*
* WARNING: The contents of this file is automatically generated by the
* tools/genStubs.tcl script. Any modifications to the function declarations
* below should be made in the generic/tcl.decls script.
*/
|
| ︙ | ︙ | |||
312 313 314 315 316 317 318 |
0, /* 1 */
0, /* 2 */
TclAllocateFreeObjects, /* 3 */
0, /* 4 */
TclCleanupChildren, /* 5 */
TclCleanupCommand, /* 6 */
TclCopyAndCollapse, /* 7 */
| | | 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 |
0, /* 1 */
0, /* 2 */
TclAllocateFreeObjects, /* 3 */
0, /* 4 */
TclCleanupChildren, /* 5 */
TclCleanupCommand, /* 6 */
TclCopyAndCollapse, /* 7 */
0, /* 8 */
TclCreatePipeline, /* 9 */
TclCreateProc, /* 10 */
TclDeleteCompiledLocalVars, /* 11 */
TclDeleteVars, /* 12 */
0, /* 13 */
TclDumpMemoryInfo, /* 14 */
0, /* 15 */
|
| ︙ | ︙ | |||
381 382 383 384 385 386 387 |
0, /* 70 */
0, /* 71 */
0, /* 72 */
0, /* 73 */
TclpFree, /* 74 */
TclpGetClicks, /* 75 */
TclpGetSeconds, /* 76 */
| | | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 |
0, /* 70 */
0, /* 71 */
0, /* 72 */
0, /* 73 */
TclpFree, /* 74 */
TclpGetClicks, /* 75 */
TclpGetSeconds, /* 76 */
0, /* 77 */
0, /* 78 */
0, /* 79 */
0, /* 80 */
TclpRealloc, /* 81 */
0, /* 82 */
0, /* 83 */
0, /* 84 */
|
| ︙ | ︙ | |||
408 409 410 411 412 413 414 |
TclResetShadowedCmdRefs, /* 97 */
TclServiceIdle, /* 98 */
0, /* 99 */
0, /* 100 */
TclSetPreInitScript, /* 101 */
TclSetupEnv, /* 102 */
TclSockGetPort, /* 103 */
| | | | | | | | | | | | | | | | 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 |
TclResetShadowedCmdRefs, /* 97 */
TclServiceIdle, /* 98 */
0, /* 99 */
0, /* 100 */
TclSetPreInitScript, /* 101 */
TclSetupEnv, /* 102 */
TclSockGetPort, /* 103 */
0, /* 104 */
0, /* 105 */
0, /* 106 */
0, /* 107 */
TclTeardownNamespace, /* 108 */
TclUpdateReturnInfo, /* 109 */
TclSockMinimumBuffers, /* 110 */
Tcl_AddInterpResolvers, /* 111 */
0, /* 112 */
0, /* 113 */
0, /* 114 */
0, /* 115 */
0, /* 116 */
0, /* 117 */
Tcl_GetInterpResolvers, /* 118 */
Tcl_GetNamespaceResolvers, /* 119 */
Tcl_FindNamespaceVar, /* 120 */
0, /* 121 */
0, /* 122 */
0, /* 123 */
0, /* 124 */
0, /* 125 */
Tcl_GetVariableFullName, /* 126 */
0, /* 127 */
Tcl_PopCallFrame, /* 128 */
Tcl_PushCallFrame, /* 129 */
Tcl_RemoveInterpResolvers, /* 130 */
Tcl_SetNamespaceResolvers, /* 131 */
TclpHasSockets, /* 132 */
0, /* 133 */
0, /* 134 */
0, /* 135 */
0, /* 136 */
0, /* 137 */
TclGetEnv, /* 138 */
0, /* 139 */
0, /* 140 */
|
| ︙ | ︙ | |||
462 463 464 465 466 467 468 |
TclRegExpRangeUniChar, /* 151 */
TclSetLibraryPath, /* 152 */
TclGetLibraryPath, /* 153 */
0, /* 154 */
0, /* 155 */
TclRegError, /* 156 */
TclVarTraceExists, /* 157 */
| | | | | | | | | | 394 395 396 397 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 |
TclRegExpRangeUniChar, /* 151 */
TclSetLibraryPath, /* 152 */
TclGetLibraryPath, /* 153 */
0, /* 154 */
0, /* 155 */
TclRegError, /* 156 */
TclVarTraceExists, /* 157 */
0, /* 158 */
0, /* 159 */
0, /* 160 */
TclChannelTransform, /* 161 */
TclChannelEventScriptInvoker, /* 162 */
TclGetInstructionTable, /* 163 */
TclExpandCodeArray, /* 164 */
TclpSetInitialEncodings, /* 165 */
TclListObjSetElement, /* 166 */
0, /* 167 */
0, /* 168 */
TclpUtfNcmp2, /* 169 */
TclCheckInterpTraces, /* 170 */
TclCheckExecutionTraces, /* 171 */
TclInThreadExit, /* 172 */
TclUniCharMatch, /* 173 */
0, /* 174 */
TclCallVarTraces, /* 175 */
TclCleanupVar, /* 176 */
TclVarErrMsg, /* 177 */
0, /* 178 */
0, /* 179 */
0, /* 180 */
0, /* 181 */
0, /* 182 */
0, /* 183 */
0, /* 184 */
0, /* 185 */
0, /* 186 */
0, /* 187 */
0, /* 188 */
0, /* 189 */
0, /* 190 */
|
| ︙ | ︙ | |||
540 541 542 543 544 545 546 |
TclPtrMakeUpvar, /* 229 */
TclObjLookupVar, /* 230 */
TclGetNamespaceFromObj, /* 231 */
TclEvalObjEx, /* 232 */
TclGetSrcInfoForPc, /* 233 */
TclVarHashCreateVar, /* 234 */
TclInitVarHashTable, /* 235 */
| | | 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 |
TclPtrMakeUpvar, /* 229 */
TclObjLookupVar, /* 230 */
TclGetNamespaceFromObj, /* 231 */
TclEvalObjEx, /* 232 */
TclGetSrcInfoForPc, /* 233 */
TclVarHashCreateVar, /* 234 */
TclInitVarHashTable, /* 235 */
0, /* 236 */
TclResetCancellation, /* 237 */
TclNRInterpProc, /* 238 */
TclNRInterpProcCore, /* 239 */
TclNRRunCallbacks, /* 240 */
TclNREvalObjEx, /* 241 */
TclNREvalObjv, /* 242 */
TclDbDumpActiveObjects, /* 243 */
|
| ︙ | ︙ | |||
572 573 574 575 576 577 578 |
TclpCreatePipe, /* 3 */
TclpCreateProcess, /* 4 */
0, /* 5 */
TclpMakeFile, /* 6 */
TclpOpenFile, /* 7 */
TclUnixWaitForFile, /* 8 */
TclpCreateTempFile, /* 9 */
| | | | | | | | | | | | | 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 |
TclpCreatePipe, /* 3 */
TclpCreateProcess, /* 4 */
0, /* 5 */
TclpMakeFile, /* 6 */
TclpOpenFile, /* 7 */
TclUnixWaitForFile, /* 8 */
TclpCreateTempFile, /* 9 */
0, /* 10 */
0, /* 11 */
0, /* 12 */
0, /* 13 */
TclUnixCopyFile, /* 14 */
0, /* 15 */
0, /* 16 */
0, /* 17 */
0, /* 18 */
0, /* 19 */
0, /* 20 */
0, /* 21 */
0, /* 22 */
0, /* 23 */
0, /* 24 */
0, /* 25 */
0, /* 26 */
0, /* 27 */
0, /* 28 */
TclWinCPUID, /* 29 */
TclUnixOpenTemporaryFile, /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TclWinConvertError, /* 0 */
0, /* 1 */
0, /* 2 */
0, /* 3 */
TclWinGetTclInstance, /* 4 */
TclUnixWaitForFile, /* 5 */
0, /* 6 */
0, /* 7 */
TclpGetPid, /* 8 */
TclWinGetPlatformId, /* 9 */
0, /* 10 */
TclGetAndDetachPids, /* 11 */
TclpCloseFile, /* 12 */
TclpCreateCommandChannel, /* 13 */
TclpCreatePipe, /* 14 */
TclpCreateProcess, /* 15 */
TclpIsAtty, /* 16 */
TclUnixCopyFile, /* 17 */
TclpMakeFile, /* 18 */
TclpOpenFile, /* 19 */
TclWinAddProcess, /* 20 */
0, /* 21 */
TclpCreateTempFile, /* 22 */
0, /* 23 */
TclWinNoBackslash, /* 24 */
0, /* 25 */
TclWinSetInterfaces, /* 26 */
TclWinFlushDirtyChannels, /* 27 */
TclWinResetInterfaces, /* 28 */
|
| ︙ | ︙ | |||
638 639 640 641 642 643 644 |
TclpCreatePipe, /* 3 */
TclpCreateProcess, /* 4 */
0, /* 5 */
TclpMakeFile, /* 6 */
TclpOpenFile, /* 7 */
TclUnixWaitForFile, /* 8 */
TclpCreateTempFile, /* 9 */
| | | | | | 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 |
TclpCreatePipe, /* 3 */
TclpCreateProcess, /* 4 */
0, /* 5 */
TclpMakeFile, /* 6 */
TclpOpenFile, /* 7 */
TclUnixWaitForFile, /* 8 */
TclpCreateTempFile, /* 9 */
0, /* 10 */
0, /* 11 */
0, /* 12 */
0, /* 13 */
TclUnixCopyFile, /* 14 */
TclMacOSXGetFileAttribute, /* 15 */
TclMacOSXSetFileAttribute, /* 16 */
TclMacOSXCopyFileAttributes, /* 17 */
TclMacOSXMatchType, /* 18 */
TclMacOSXNotifierAddRunLoopMode, /* 19 */
0, /* 20 */
|
| ︙ | ︙ | |||
750 751 752 753 754 755 756 |
TclBNInitBignumFromWideInt, /* 65 */
TclBNInitBignumFromWideUInt, /* 66 */
};
static const TclStubHooks tclStubHooks = {
&tclPlatStubs,
&tclIntStubs,
| | > > | 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 |
TclBNInitBignumFromWideInt, /* 65 */
TclBNInitBignumFromWideUInt, /* 66 */
};
static const TclStubHooks tclStubHooks = {
&tclPlatStubs,
&tclIntStubs,
&tclIntPlatStubs,
&tclOOStubs,
&tclOOIntStubs
};
const TclStubs tclStubs = {
TCL_STUB_MAGIC,
&tclStubHooks,
Tcl_PkgProvideEx, /* 0 */
Tcl_PkgRequireEx, /* 1 */
|
| ︙ | ︙ | |||
808 809 810 811 812 813 814 |
Tcl_DuplicateObj, /* 29 */
TclFreeObj, /* 30 */
Tcl_GetBoolean, /* 31 */
Tcl_GetBooleanFromObj, /* 32 */
Tcl_GetByteArrayFromObj, /* 33 */
Tcl_GetDouble, /* 34 */
Tcl_GetDoubleFromObj, /* 35 */
| | | 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 |
Tcl_DuplicateObj, /* 29 */
TclFreeObj, /* 30 */
Tcl_GetBoolean, /* 31 */
Tcl_GetBooleanFromObj, /* 32 */
Tcl_GetByteArrayFromObj, /* 33 */
Tcl_GetDouble, /* 34 */
Tcl_GetDoubleFromObj, /* 35 */
0, /* 36 */
Tcl_GetInt, /* 37 */
Tcl_GetIntFromObj, /* 38 */
Tcl_GetLongFromObj, /* 39 */
Tcl_GetObjType, /* 40 */
Tcl_GetStringFromObj, /* 41 */
Tcl_InvalidateStringRep, /* 42 */
Tcl_ListObjAppendList, /* 43 */
|
| ︙ | ︙ | |||
839 840 841 842 843 844 845 |
Tcl_SetDoubleObj, /* 60 */
Tcl_SetIntObj, /* 61 */
Tcl_SetListObj, /* 62 */
Tcl_SetLongObj, /* 63 */
Tcl_SetObjLength, /* 64 */
Tcl_SetStringObj, /* 65 */
Tcl_AddErrorInfo, /* 66 */
| | | | | 773 774 775 776 777 778 779 780 781 782 783 784 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 |
Tcl_SetDoubleObj, /* 60 */
Tcl_SetIntObj, /* 61 */
Tcl_SetListObj, /* 62 */
Tcl_SetLongObj, /* 63 */
Tcl_SetObjLength, /* 64 */
Tcl_SetStringObj, /* 65 */
Tcl_AddErrorInfo, /* 66 */
0, /* 67 */
Tcl_AllowExceptions, /* 68 */
Tcl_AppendElement, /* 69 */
Tcl_AppendResult, /* 70 */
Tcl_AsyncCreate, /* 71 */
Tcl_AsyncDelete, /* 72 */
Tcl_AsyncInvoke, /* 73 */
Tcl_AsyncMark, /* 74 */
Tcl_AsyncReady, /* 75 */
Tcl_BackgroundError, /* 76 */
0, /* 77 */
Tcl_BadChannelOption, /* 78 */
Tcl_CallWhenDeleted, /* 79 */
Tcl_CancelIdleCall, /* 80 */
Tcl_Close, /* 81 */
Tcl_CommandComplete, /* 82 */
Tcl_Concat, /* 83 */
Tcl_ConvertElement, /* 84 */
Tcl_ConvertCountedElement, /* 85 */
Tcl_CreateAlias, /* 86 */
Tcl_CreateAliasObj, /* 87 */
Tcl_CreateChannel, /* 88 */
Tcl_CreateChannelHandler, /* 89 */
Tcl_CreateCloseHandler, /* 90 */
Tcl_CreateCommand, /* 91 */
Tcl_CreateEventSource, /* 92 */
Tcl_CreateExitHandler, /* 93 */
Tcl_CreateInterp, /* 94 */
0, /* 95 */
Tcl_CreateObjCommand, /* 96 */
Tcl_CreateSlave, /* 97 */
Tcl_CreateTimerHandler, /* 98 */
Tcl_CreateTrace, /* 99 */
Tcl_DeleteAssocData, /* 100 */
Tcl_DeleteChannelHandler, /* 101 */
Tcl_DeleteCloseHandler, /* 102 */
|
| ︙ | ︙ | |||
901 902 903 904 905 906 907 |
Tcl_DStringInit, /* 122 */
Tcl_DStringResult, /* 123 */
Tcl_DStringSetLength, /* 124 */
Tcl_DStringStartSublist, /* 125 */
Tcl_Eof, /* 126 */
Tcl_ErrnoId, /* 127 */
Tcl_ErrnoMsg, /* 128 */
| | | | | | 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 |
Tcl_DStringInit, /* 122 */
Tcl_DStringResult, /* 123 */
Tcl_DStringSetLength, /* 124 */
Tcl_DStringStartSublist, /* 125 */
Tcl_Eof, /* 126 */
Tcl_ErrnoId, /* 127 */
Tcl_ErrnoMsg, /* 128 */
0, /* 129 */
0, /* 130 */
0, /* 131 */
Tcl_EventuallyFree, /* 132 */
Tcl_Exit, /* 133 */
Tcl_ExposeCommand, /* 134 */
Tcl_ExprBoolean, /* 135 */
Tcl_ExprBooleanObj, /* 136 */
Tcl_ExprDouble, /* 137 */
Tcl_ExprDoubleObj, /* 138 */
Tcl_ExprLong, /* 139 */
Tcl_ExprLongObj, /* 140 */
Tcl_ExprObj, /* 141 */
Tcl_ExprString, /* 142 */
Tcl_Finalize, /* 143 */
0, /* 144 */
Tcl_FirstHashEntry, /* 145 */
Tcl_Flush, /* 146 */
Tcl_FreeResult, /* 147 */
Tcl_GetAlias, /* 148 */
Tcl_GetAliasObj, /* 149 */
Tcl_GetAssocData, /* 150 */
Tcl_GetChannel, /* 151 */
|
| ︙ | ︙ | |||
955 956 957 958 959 960 961 |
Tcl_GetPathType, /* 168 */
Tcl_Gets, /* 169 */
Tcl_GetsObj, /* 170 */
Tcl_GetServiceMode, /* 171 */
Tcl_GetSlave, /* 172 */
Tcl_GetStdChannel, /* 173 */
Tcl_GetStringResult, /* 174 */
| | | | | 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 |
Tcl_GetPathType, /* 168 */
Tcl_Gets, /* 169 */
Tcl_GetsObj, /* 170 */
Tcl_GetServiceMode, /* 171 */
Tcl_GetSlave, /* 172 */
Tcl_GetStdChannel, /* 173 */
Tcl_GetStringResult, /* 174 */
0, /* 175 */
Tcl_GetVar2, /* 176 */
0, /* 177 */
0, /* 178 */
Tcl_HideCommand, /* 179 */
Tcl_Init, /* 180 */
Tcl_InitHashTable, /* 181 */
Tcl_InputBlocked, /* 182 */
Tcl_InputBuffered, /* 183 */
Tcl_InterpDeleted, /* 184 */
Tcl_IsSafe, /* 185 */
|
| ︙ | ︙ | |||
1000 1001 1002 1003 1004 1005 1006 |
Tcl_RegExpExec, /* 213 */
Tcl_RegExpMatch, /* 214 */
Tcl_RegExpRange, /* 215 */
Tcl_Release, /* 216 */
Tcl_ResetResult, /* 217 */
Tcl_ScanElement, /* 218 */
Tcl_ScanCountedElement, /* 219 */
| | | | | | | | | | | | | | | | | 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 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 |
Tcl_RegExpExec, /* 213 */
Tcl_RegExpMatch, /* 214 */
Tcl_RegExpRange, /* 215 */
Tcl_Release, /* 216 */
Tcl_ResetResult, /* 217 */
Tcl_ScanElement, /* 218 */
Tcl_ScanCountedElement, /* 219 */
0, /* 220 */
Tcl_ServiceAll, /* 221 */
Tcl_ServiceEvent, /* 222 */
Tcl_SetAssocData, /* 223 */
Tcl_SetChannelBufferSize, /* 224 */
Tcl_SetChannelOption, /* 225 */
Tcl_SetCommandInfo, /* 226 */
Tcl_SetErrno, /* 227 */
Tcl_SetErrorCode, /* 228 */
Tcl_SetMaxBlockTime, /* 229 */
0, /* 230 */
Tcl_SetRecursionLimit, /* 231 */
Tcl_SetResult, /* 232 */
Tcl_SetServiceMode, /* 233 */
Tcl_SetObjErrorCode, /* 234 */
Tcl_SetObjResult, /* 235 */
Tcl_SetStdChannel, /* 236 */
0, /* 237 */
Tcl_SetVar2, /* 238 */
Tcl_SignalId, /* 239 */
Tcl_SignalMsg, /* 240 */
Tcl_SourceRCFile, /* 241 */
Tcl_SplitList, /* 242 */
Tcl_SplitPath, /* 243 */
Tcl_StaticPackage, /* 244 */
Tcl_StringMatch, /* 245 */
0, /* 246 */
0, /* 247 */
Tcl_TraceVar2, /* 248 */
Tcl_TranslateFileName, /* 249 */
Tcl_Ungets, /* 250 */
Tcl_UnlinkVar, /* 251 */
Tcl_UnregisterChannel, /* 252 */
0, /* 253 */
Tcl_UnsetVar2, /* 254 */
0, /* 255 */
Tcl_UntraceVar2, /* 256 */
Tcl_UpdateLinkedVar, /* 257 */
0, /* 258 */
Tcl_UpVar2, /* 259 */
0, /* 260 */
0, /* 261 */
Tcl_VarTraceInfo2, /* 262 */
Tcl_Write, /* 263 */
Tcl_WrongNumArgs, /* 264 */
Tcl_DumpActiveMemory, /* 265 */
Tcl_ValidateAllMemory, /* 266 */
Tcl_AppendResultVA, /* 267 */
Tcl_AppendStringsToObjVA, /* 268 */
Tcl_HashStats, /* 269 */
Tcl_ParseVar, /* 270 */
0, /* 271 */
Tcl_PkgPresentEx, /* 272 */
TclPkgProvide, /* 273 */
0, /* 274 */
Tcl_SetErrorCodeVA, /* 275 */
0, /* 276 */
Tcl_WaitPid, /* 277 */
Tcl_PanicVA, /* 278 */
Tcl_GetVersion, /* 279 */
Tcl_InitMemory, /* 280 */
Tcl_StackChannel, /* 281 */
Tcl_UnstackChannel, /* 282 */
Tcl_GetStackedChannel, /* 283 */
Tcl_SetMainLoop, /* 284 */
0, /* 285 */
Tcl_AppendObjToObj, /* 286 */
Tcl_CreateEncoding, /* 287 */
Tcl_CreateThreadExitHandler, /* 288 */
Tcl_DeleteThreadExitHandler, /* 289 */
0, /* 290 */
Tcl_EvalEx, /* 291 */
Tcl_EvalObjv, /* 292 */
Tcl_EvalObjEx, /* 293 */
Tcl_ExitThread, /* 294 */
Tcl_ExternalToUtf, /* 295 */
Tcl_ExternalToUtfDString, /* 296 */
Tcl_FinalizeThread, /* 297 */
|
| ︙ | ︙ | |||
1094 1095 1096 1097 1098 1099 1100 |
Tcl_InitNotifier, /* 307 */
Tcl_MutexLock, /* 308 */
Tcl_MutexUnlock, /* 309 */
Tcl_ConditionNotify, /* 310 */
Tcl_ConditionWait, /* 311 */
Tcl_NumUtfChars, /* 312 */
Tcl_ReadChars, /* 313 */
| | | | 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 |
Tcl_InitNotifier, /* 307 */
Tcl_MutexLock, /* 308 */
Tcl_MutexUnlock, /* 309 */
Tcl_ConditionNotify, /* 310 */
Tcl_ConditionWait, /* 311 */
Tcl_NumUtfChars, /* 312 */
Tcl_ReadChars, /* 313 */
0, /* 314 */
0, /* 315 */
Tcl_SetSystemEncoding, /* 316 */
Tcl_SetVar2Ex, /* 317 */
Tcl_ThreadAlert, /* 318 */
Tcl_ThreadQueueEvent, /* 319 */
Tcl_UniCharAtIndex, /* 320 */
Tcl_UniCharToLower, /* 321 */
Tcl_UniCharToTitle, /* 322 */
|
| ︙ | ︙ | |||
1121 1122 1123 1124 1125 1126 1127 |
Tcl_UtfToLower, /* 334 */
Tcl_UtfToTitle, /* 335 */
Tcl_UtfToUniChar, /* 336 */
Tcl_UtfToUpper, /* 337 */
Tcl_WriteChars, /* 338 */
Tcl_WriteObj, /* 339 */
Tcl_GetString, /* 340 */
| | | | | 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 |
Tcl_UtfToLower, /* 334 */
Tcl_UtfToTitle, /* 335 */
Tcl_UtfToUniChar, /* 336 */
Tcl_UtfToUpper, /* 337 */
Tcl_WriteChars, /* 338 */
Tcl_WriteObj, /* 339 */
Tcl_GetString, /* 340 */
0, /* 341 */
0, /* 342 */
Tcl_AlertNotifier, /* 343 */
Tcl_ServiceModeHook, /* 344 */
Tcl_UniCharIsAlnum, /* 345 */
Tcl_UniCharIsAlpha, /* 346 */
Tcl_UniCharIsDigit, /* 347 */
Tcl_UniCharIsLower, /* 348 */
Tcl_UniCharIsSpace, /* 349 */
Tcl_UniCharIsUpper, /* 350 */
Tcl_UniCharIsWordChar, /* 351 */
Tcl_UniCharLen, /* 352 */
Tcl_UniCharNcmp, /* 353 */
Tcl_UniCharToUtfDString, /* 354 */
Tcl_UtfToUniCharDString, /* 355 */
Tcl_GetRegExpFromObj, /* 356 */
0, /* 357 */
Tcl_FreeParse, /* 358 */
Tcl_LogCommandInfo, /* 359 */
Tcl_ParseBraces, /* 360 */
Tcl_ParseCommand, /* 361 */
Tcl_ParseExpr, /* 362 */
Tcl_ParseQuotedString, /* 363 */
Tcl_ParseVarName, /* 364 */
|
| ︙ | ︙ | |||
1201 1202 1203 1204 1205 1206 1207 |
Tcl_IsChannelRegistered, /* 414 */
Tcl_CutChannel, /* 415 */
Tcl_SpliceChannel, /* 416 */
Tcl_ClearChannelHandlers, /* 417 */
Tcl_IsChannelExisting, /* 418 */
Tcl_UniCharNcasecmp, /* 419 */
Tcl_UniCharCaseMatch, /* 420 */
| | | | | | 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 |
Tcl_IsChannelRegistered, /* 414 */
Tcl_CutChannel, /* 415 */
Tcl_SpliceChannel, /* 416 */
Tcl_ClearChannelHandlers, /* 417 */
Tcl_IsChannelExisting, /* 418 */
Tcl_UniCharNcasecmp, /* 419 */
Tcl_UniCharCaseMatch, /* 420 */
0, /* 421 */
0, /* 422 */
Tcl_InitCustomHashTable, /* 423 */
Tcl_InitObjHashTable, /* 424 */
Tcl_CommandTraceInfo, /* 425 */
Tcl_TraceCommand, /* 426 */
Tcl_UntraceCommand, /* 427 */
Tcl_AttemptAlloc, /* 428 */
Tcl_AttemptDbCkalloc, /* 429 */
Tcl_AttemptRealloc, /* 430 */
Tcl_AttemptDbCkrealloc, /* 431 */
Tcl_AttemptSetObjLength, /* 432 */
Tcl_GetChannelThread, /* 433 */
Tcl_GetUnicodeFromObj, /* 434 */
0, /* 435 */
0, /* 436 */
Tcl_SubstObj, /* 437 */
Tcl_DetachChannel, /* 438 */
Tcl_IsStandardChannel, /* 439 */
Tcl_FSCopyFile, /* 440 */
Tcl_FSCopyDirectory, /* 441 */
Tcl_FSCreateDirectory, /* 442 */
Tcl_FSDeleteFile, /* 443 */
|
| ︙ | ︙ |
Changes to generic/tclStubLib.c.
| ︙ | ︙ | |||
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | * Copyright (c) 1998 Paul Duffin. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" MODULE_SCOPE const TclStubs *tclStubsPtr; MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr; MODULE_SCOPE const TclIntStubs *tclIntStubsPtr; MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr; const TclStubs *tclStubsPtr = NULL; const TclPlatStubs *tclPlatStubsPtr = NULL; const TclIntStubs *tclIntStubsPtr = NULL; const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; /* * Use our own ISDIGIT to avoid linking to libc on windows */ #define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9) | > > > > > | 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 | * Copyright (c) 1998 Paul Duffin. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclOOInt.h" MODULE_SCOPE const TclStubs *tclStubsPtr; MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr; MODULE_SCOPE const TclIntStubs *tclIntStubsPtr; MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr; MODULE_SCOPE const TclOOStubs *tclOOStubsPtr; MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr; const TclStubs *tclStubsPtr = NULL; const TclPlatStubs *tclPlatStubsPtr = NULL; const TclIntStubs *tclIntStubsPtr = NULL; const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; const TclOOStubs *tclOOStubsPtr = NULL; const TclOOIntStubs *tclOOIntStubsPtr = NULL; /* * Use our own ISDIGIT to avoid linking to libc on windows */ #define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9) |
| ︙ | ︙ | |||
61 62 63 64 65 66 67 |
/*
* We can't optimize this check by caching tclStubsPtr because that
* prevents apps from being able to load/unload Tcl dynamically multiple
* times. [Bug 615304]
*/
| | | | | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 |
/*
* We can't optimize this check by caching tclStubsPtr because that
* prevents apps from being able to load/unload Tcl dynamically multiple
* times. [Bug 615304]
*/
if (!stubsPtr || (stubsPtr->magic != magic)) {
iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism";
iPtr->legacyFreeProc = 0; /* TCL_STATIC */
return NULL;
}
actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
if (actualVersion == NULL) {
return NULL;
}
|
| ︙ | ︙ | |||
97 98 99 100 101 102 103 |
} else {
actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
if (actualVersion == NULL) {
return NULL;
}
}
}
| > > > | | > > | | | | > > > > | 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 |
} else {
actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
if (actualVersion == NULL) {
return NULL;
}
}
}
if (stubsPtr->reserved77) {
/* We are running Tcl 8.x */
stubsPtr = (TclStubs *)pkgData;
}
tclStubsPtr = stubsPtr;
if (stubsPtr->hooks) {
tclPlatStubsPtr = stubsPtr->hooks->tclPlatStubs;
tclIntStubsPtr = stubsPtr->hooks->tclIntStubs;
tclIntPlatStubsPtr = stubsPtr->hooks->tclIntPlatStubs;
tclOOStubsPtr = stubsPtr->hooks->tclOOStubs;
tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs;
} else {
tclPlatStubsPtr = NULL;
tclIntStubsPtr = NULL;
tclIntPlatStubsPtr = NULL;
tclOOStubsPtr = NULL;
tclOOIntStubsPtr = NULL;
}
return actualVersion;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclTest.c.
| ︙ | ︙ | |||
86 87 88 89 90 91 92 | static Tcl_Trace cmdTrace; /* * One of the following structures exists for each command created by * TestdelCmd: */ | | | < < < < < < < | | 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 |
static Tcl_Trace cmdTrace;
/*
* One of the following structures exists for each command created by
* TestdelCmd:
*/
typedef struct {
Tcl_Interp *interp; /* Interpreter in which command exists. */
char *deleteCmd; /* Script to execute when command is deleted.
* Malloc'ed. */
} DelCmd;
/*
* The following is used to keep track of an encoding that invokes a Tcl
* command.
*/
typedef struct {
Tcl_Interp *interp;
char *toUtfCmd;
char *fromUtfCmd;
} TclEncoding;
/*
* Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands.
*/
static int exitMainLoop = 0;
/*
* Event structure used in testing the event queue management procedures.
*/
typedef struct {
Tcl_Event header; /* Header common to all events */
Tcl_Interp *interp; /* Interpreter that will handle the event */
Tcl_Obj *command; /* Command to evaluate when the event occurs */
Tcl_Obj *tag; /* Tag for this event used to delete it */
} TestEvent;
/*
|
| ︙ | ︙ | |||
286 287 288 289 290 291 292 | static int TestinterpdeleteCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestlinkCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestlocaleCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); | < < < < < < | 279 280 281 282 283 284 285 286 287 288 289 290 291 292 | static int TestinterpdeleteCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestlinkCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestlocaleCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestmainthreadCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetmainloopCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestexitmainloopCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestpanicCmd(ClientData dummy, |
| ︙ | ︙ | |||
322 323 324 325 326 327 328 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestreturnObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); | < < | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestreturnObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); static int TestsaveresultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestsaveresultFree(char *blockPtr); static int TestsetassocdataCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int Testset2Cmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestseterrorcodeCmd(ClientData dummy, |
| ︙ | ︙ | |||
525 526 527 528 529 530 531 |
*----------------------------------------------------------------------
*/
int
Tcltest_Init(
Tcl_Interp *interp) /* Interpreter for application. */
{
| < < < < | | | | 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 |
*----------------------------------------------------------------------
*/
int
Tcltest_Init(
Tcl_Interp *interp) /* Interpreter for application. */
{
Tcl_Obj *listPtr;
Tcl_Obj **objv;
int objc, index;
static const char *const specialOptions[] = {
"-appinitprocerror", "-appinitprocdeleteinterp",
"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
};
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_TomMath_InitStubs(interp, TCL_VERSION) == NULL) {
return TCL_ERROR;
}
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
/* TIP #268: Full patchlevel instead of just major.minor */
if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
return TCL_ERROR;
}
/*
* Create additional commands and math functions for testing Tcl.
*/
|
| ︙ | ︙ | |||
649 650 651 652 653 654 655 |
NULL, NULL);
Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
NULL, NULL);
| < < | 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 |
NULL, NULL);
Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testseterr", TestsetCmd,
(ClientData) TCL_LEAVE_ERR_MSG, NULL);
Tcl_CreateCommand(interp, "testset2", Testset2Cmd,
|
| ︙ | ︙ | |||
674 675 676 677 678 679 680 |
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testtranslatefilename",
TesttranslatefilenameCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
| | < < < < < < < < < | 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 |
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testtranslatefilename",
TesttranslatefilenameCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
NULL);
Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
NULL, NULL);
#if defined(HAVE_CPUID) || defined(_WIN32)
Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
(ClientData) 0, NULL);
#endif
Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
NULL, NULL);
|
| ︙ | ︙ | |||
723 724 725 726 727 728 729 |
*/
listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
if (listPtr != NULL) {
if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
return TCL_ERROR;
}
| | | | 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 |
*/
listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
if (listPtr != NULL) {
if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
return TCL_ERROR;
}
if (objc && (Tcl_GetIndexFromObjStruct(NULL, objv[0], specialOptions,
sizeof(char *), NULL, TCL_EXACT, &index) == TCL_OK)) {
switch (index) {
case 0:
return TCL_ERROR;
case 1:
Tcl_DeleteInterp(interp);
return TCL_ERROR;
case 2: {
|
| ︙ | ︙ | |||
814 815 816 817 818 819 820 |
{
TestAsyncHandler *asyncPtr, *prevPtr;
int id, code;
static int nextId = 1;
if (argc < 2) {
wrongNumArgs:
| | | | 784 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 |
{
TestAsyncHandler *asyncPtr, *prevPtr;
int id, code;
static int nextId = 1;
if (argc < 2) {
wrongNumArgs:
Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
if (argc != 3) {
goto wrongNumArgs;
}
asyncPtr = ckalloc(sizeof(TestAsyncHandler));
asyncPtr->command = ckalloc(strlen(argv[2]) + 1);
strcpy(asyncPtr->command, argv[2]);
Tcl_MutexLock(&asyncTestMutex);
asyncPtr->id = nextId;
nextId++;
asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
INT2PTR(asyncPtr->id));
asyncPtr->nextPtr = firstHandler;
firstHandler = asyncPtr;
Tcl_MutexUnlock(&asyncTestMutex);
Tcl_SetObjResult(interp, Tcl_NewLongObj(asyncPtr->id));
} else if (strcmp(argv[1], "delete") == 0) {
if (argc == 2) {
Tcl_MutexLock(&asyncTestMutex);
while (firstHandler != NULL) {
asyncPtr = firstHandler;
firstHandler = asyncPtr->nextPtr;
Tcl_AsyncDelete(asyncPtr->handler);
|
| ︙ | ︙ | |||
904 905 906 907 908 909 910 |
for (asyncPtr = firstHandler; asyncPtr != NULL;
asyncPtr = asyncPtr->nextPtr) {
if (asyncPtr->id == id) {
Tcl_ThreadId threadID;
if (Tcl_CreateThread(&threadID, AsyncThreadProc,
INT2PTR(id), TCL_THREAD_STACK_DEFAULT,
TCL_THREAD_NOFLAGS) != TCL_OK) {
| | | 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 |
for (asyncPtr = firstHandler; asyncPtr != NULL;
asyncPtr = asyncPtr->nextPtr) {
if (asyncPtr->id == id) {
Tcl_ThreadId threadID;
if (Tcl_CreateThread(&threadID, AsyncThreadProc,
INT2PTR(id), TCL_THREAD_STACK_DEFAULT,
TCL_THREAD_NOFLAGS) != TCL_OK) {
Tcl_AppendResult(interp, "can't create thread", NULL);
Tcl_MutexUnlock(&asyncTestMutex);
return TCL_ERROR;
}
break;
}
}
Tcl_MutexUnlock(&asyncTestMutex);
|
| ︙ | ︙ | |||
1051 1052 1053 1054 1055 1056 1057 |
CmdDelProc1);
} else if (strcmp(argv[1], "delete") == 0) {
Tcl_DStringInit(&delString);
Tcl_DeleteCommand(interp, argv[2]);
Tcl_DStringResult(interp, &delString);
} else if (strcmp(argv[1], "get") == 0) {
if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) {
| | | 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 |
CmdDelProc1);
} else if (strcmp(argv[1], "delete") == 0) {
Tcl_DStringInit(&delString);
Tcl_DeleteCommand(interp, argv[2]);
Tcl_DStringResult(interp, &delString);
} else if (strcmp(argv[1], "get") == 0) {
if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) {
Tcl_AppendResult(interp, "??", NULL);
return TCL_OK;
}
if (info.proc == CmdProc1) {
Tcl_AppendResult(interp, "CmdProc1", " ",
(char *) info.clientData, NULL);
} else if (info.proc == CmdProc2) {
Tcl_AppendResult(interp, "CmdProc2", " ",
|
| ︙ | ︙ | |||
1086 1087 1088 1089 1090 1091 1092 |
info.proc = CmdProc2;
info.clientData = (ClientData) "new_command_data";
info.objProc = NULL;
info.objClientData = NULL;
info.deleteProc = CmdDelProc2;
info.deleteData = (ClientData) "new_delete_data";
if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
| | | | 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 |
info.proc = CmdProc2;
info.clientData = (ClientData) "new_command_data";
info.objProc = NULL;
info.objClientData = NULL;
info.deleteProc = CmdDelProc2;
info.deleteData = (ClientData) "new_delete_data";
if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
} else {
Tcl_SetObjResult(interp, Tcl_NewLongObj(1));
}
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be create, delete, get, or modify", NULL);
return TCL_ERROR;
}
return TCL_OK;
|
| ︙ | ︙ | |||
1178 1179 1180 1181 1182 1183 1184 |
" option arg\"", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
(ClientData) "original", NULL);
sprintf(buf, "%p", (void *)token);
| | | 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 |
" option arg\"", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
(ClientData) "original", NULL);
sprintf(buf, "%p", (void *)token);
Tcl_AppendResult(interp, buf, NULL);
} else if (strcmp(argv[1], "name") == 0) {
Tcl_Obj *objPtr;
if (sscanf(argv[2], "%p", &l) != 1) {
Tcl_AppendResult(interp, "bad command token \"", argv[2],
"\"", NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
1284 1285 1286 1287 1288 1289 1290 |
deleteCalled = 0;
cmdTrace = Tcl_CreateObjTrace(interp, 50000,
TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc,
(ClientData) &deleteCalled, ObjTraceDeleteProc);
result = Tcl_EvalEx(interp, argv[2], -1, 0);
Tcl_DeleteTrace(interp, cmdTrace);
if (!deleteCalled) {
| | | 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 |
deleteCalled = 0;
cmdTrace = Tcl_CreateObjTrace(interp, 50000,
TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc,
(ClientData) &deleteCalled, ObjTraceDeleteProc);
result = Tcl_EvalEx(interp, argv[2], -1, 0);
Tcl_DeleteTrace(interp, cmdTrace);
if (!deleteCalled) {
Tcl_AppendResult(interp, "Delete wasn't called", NULL);
return TCL_ERROR;
} else {
return result;
}
} else if (strcmp(argv[1], "doubletest") == 0) {
Tcl_Trace t1, t2;
|
| ︙ | ︙ | |||
1584 1585 1586 1587 1588 1589 1590 |
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
DelCmd *dPtr;
Tcl_Interp *slave;
if (argc != 4) {
| | | 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 |
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
DelCmd *dPtr;
Tcl_Interp *slave;
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
slave = Tcl_GetSlave(interp, argv[1]);
if (slave == NULL) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1736 1737 1738 1739 1740 1741 1742 |
|| TclIsNaN(objv[1]->internalRep.doubleValue)) {
status = TCL_OK;
memcpy(&d, &(objv[1]->internalRep.doubleValue), sizeof(double));
}
}
if (status != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK
| | | | | 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 |
|| TclIsNaN(objv[1]->internalRep.doubleValue)) {
status = TCL_OK;
memcpy(&d, &(objv[1]->internalRep.doubleValue), sizeof(double));
}
}
if (status != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK
|| Tcl_GetIndexFromObjStruct(interp, objv[3], options,
sizeof(char *), "conversion type", TCL_EXACT, &type) != TCL_OK) {
fprintf(stderr, "bad value? %g\n", d);
return TCL_ERROR;
}
type = types[type];
if (objc > 4) {
if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
return TCL_ERROR;
}
type |= TCL_DD_SHORTEN_FLAG;
}
str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
strObj = Tcl_NewStringObj(str, endPtr-str);
ckfree(str);
retval = Tcl_NewListObj(1, &strObj);
Tcl_ListObjAppendElement(NULL, retval, Tcl_NewLongObj(decpt));
strObj = Tcl_NewStringObj(signum ? "-" : "+", 1);
Tcl_ListObjAppendElement(NULL, retval, strObj);
Tcl_SetObjResult(interp, retval);
return TCL_OK;
}
/*
|
| ︙ | ︙ | |||
1789 1790 1791 1792 1793 1794 1795 |
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
int count;
if (argc < 2) {
wrongNumArgs:
| | | 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 |
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
int count;
if (argc < 2) {
wrongNumArgs:
Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "append") == 0) {
if (argc != 4) {
goto wrongNumArgs;
}
if (Tcl_GetInt(interp, argv[3], &count) != TCL_OK) {
|
| ︙ | ︙ | |||
1825 1826 1827 1828 1829 1830 1831 |
}
Tcl_SetResult(interp, Tcl_DStringValue(&dstring), TCL_VOLATILE);
} else if (strcmp(argv[1], "gresult") == 0) {
if (argc != 3) {
goto wrongNumArgs;
}
if (strcmp(argv[2], "staticsmall") == 0) {
| | | | | 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 |
}
Tcl_SetResult(interp, Tcl_DStringValue(&dstring), TCL_VOLATILE);
} else if (strcmp(argv[1], "gresult") == 0) {
if (argc != 3) {
goto wrongNumArgs;
}
if (strcmp(argv[2], "staticsmall") == 0) {
Tcl_AppendResult(interp, "short", NULL);
} else if (strcmp(argv[2], "staticlarge") == 0) {
Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL);
} else if (strcmp(argv[2], "free") == 0) {
char *s = ckalloc(100);
strcpy(s, "This is a malloc-ed string");
Tcl_SetResult(interp, s, TCL_DYNAMIC);
} else if (strcmp(argv[2], "special") == 0) {
char *s = (char*)ckalloc(100) + 16;
strcpy(s, "This is a specially-allocated string");
Tcl_SetResult(interp, s, SpecialFree);
} else {
Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
"\": must be staticsmall, staticlarge, free, or special",
NULL);
return TCL_ERROR;
}
Tcl_DStringGetResult(interp, &dstring);
} else if (strcmp(argv[1], "length") == 0) {
if (argc != 2) {
goto wrongNumArgs;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_DStringLength(&dstring)));
} else if (strcmp(argv[1], "result") == 0) {
if (argc != 2) {
goto wrongNumArgs;
}
Tcl_DStringResult(interp, &dstring);
} else if (strcmp(argv[1], "trunc") == 0) {
if (argc != 3) {
|
| ︙ | ︙ | |||
1923 1924 1925 1926 1927 1928 1929 |
static const char *const optionStrings[] = {
"create", "delete", NULL
};
enum options {
ENC_CREATE, ENC_DELETE
};
| | | | 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 |
static const char *const optionStrings[] = {
"create", "delete", NULL
};
enum options {
ENC_CREATE, ENC_DELETE
};
if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case ENC_CREATE: {
Tcl_EncodingType type;
|
| ︙ | ︙ | |||
1987 1988 1989 1990 1991 1992 1993 |
int *dstWrotePtr, /* Filled with number of bytes stored. */
int *dstCharsPtr) /* Filled with number of chars stored. */
{
int len;
TclEncoding *encodingPtr;
encodingPtr = (TclEncoding *) clientData;
| | | 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 |
int *dstWrotePtr, /* Filled with number of bytes stored. */
int *dstCharsPtr) /* Filled with number of chars stored. */
{
int len;
TclEncoding *encodingPtr;
encodingPtr = (TclEncoding *) clientData;
Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL);
len = strlen(Tcl_GetStringResult(encodingPtr->interp));
if (len > dstLen) {
len = dstLen;
}
memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
Tcl_ResetResult(encodingPtr->interp);
|
| ︙ | ︙ | |||
2019 2020 2021 2022 2023 2024 2025 |
int *dstWrotePtr, /* Filled with number of bytes stored. */
int *dstCharsPtr) /* Filled with number of chars stored. */
{
int len;
TclEncoding *encodingPtr;
encodingPtr = (TclEncoding *) clientData;
| | | 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 |
int *dstWrotePtr, /* Filled with number of bytes stored. */
int *dstCharsPtr) /* Filled with number of chars stored. */
{
int len;
TclEncoding *encodingPtr;
encodingPtr = (TclEncoding *) clientData;
Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL);
len = strlen(Tcl_GetStringResult(encodingPtr->interp));
if (len > dstLen) {
len = dstLen;
}
memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
Tcl_ResetResult(encodingPtr->interp);
|
| ︙ | ︙ | |||
2183 2184 2185 2186 2187 2188 2189 |
};
TestEvent *ev; /* Event to be queued */
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
return TCL_ERROR;
}
| | | | | | 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 |
};
TestEvent *ev; /* Event to be queued */
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcommands,
sizeof(char *), "subcommand", TCL_EXACT, &subCmdIndex) != TCL_OK) {
return TCL_ERROR;
}
switch (subCmdIndex) {
case 0: /* queue */
if (objc != 5) {
Tcl_WrongNumArgs(interp, 2, objv, "name position script");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[3], positions,
sizeof(char *), "position specifier", TCL_EXACT, &posIndex) != TCL_OK) {
return TCL_ERROR;
}
ev = ckalloc(sizeof(TestEvent));
ev->header.proc = TesteventProc;
ev->header.nextPtr = NULL;
ev->interp = interp;
ev->command = objv[4];
|
| ︙ | ︙ | |||
2427 2428 2429 2430 2431 2432 2433 |
int result;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" expression\"", NULL);
return TCL_ERROR;
}
| | | 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 |
int result;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" expression\"", NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprLong(interp, argv[1], &exprResult);
if (result != TCL_OK) {
return result;
}
sprintf(buf, ": %ld", exprResult);
Tcl_AppendResult(interp, buf, NULL);
return TCL_OK;
|
| ︙ | ︙ | |||
2469 2470 2471 2472 2473 2474 2475 |
char buf[4 + TCL_INTEGER_SPACE];
int result;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "expression");
return TCL_ERROR;
}
| | | 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 |
char buf[4 + TCL_INTEGER_SPACE];
int result;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "expression");
return TCL_ERROR;
}
Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprLongObj(interp, objv[1], &exprResult);
if (result != TCL_OK) {
return result;
}
sprintf(buf, ": %ld", exprResult);
Tcl_AppendResult(interp, buf, NULL);
return TCL_OK;
|
| ︙ | ︙ | |||
2512 2513 2514 2515 2516 2517 2518 |
int result;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" expression\"", NULL);
return TCL_ERROR;
}
| | | 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 |
int result;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" expression\"", NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprDouble(interp, argv[1], &exprResult);
if (result != TCL_OK) {
return result;
}
strcpy(buf, ": ");
Tcl_PrintDouble(interp, exprResult, buf+2);
Tcl_AppendResult(interp, buf, NULL);
|
| ︙ | ︙ | |||
2555 2556 2557 2558 2559 2560 2561 |
char buf[4 + TCL_DOUBLE_SPACE];
int result;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "expression");
return TCL_ERROR;
}
| | | 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 |
char buf[4 + TCL_DOUBLE_SPACE];
int result;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "expression");
return TCL_ERROR;
}
Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult);
if (result != TCL_OK) {
return result;
}
strcpy(buf, ": ");
Tcl_PrintDouble(interp, exprResult, buf+2);
Tcl_AppendResult(interp, buf, NULL);
|
| ︙ | ︙ | |||
3297 3298 3299 3300 3301 3302 3303 |
*/
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "category ?locale?");
return TCL_ERROR;
}
| | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 |
*/
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "category ?locale?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
if (objc == 3) {
locale = Tcl_GetString(objv[2]);
} else {
locale = NULL;
}
locale = setlocale(lcTypes[index], locale);
if (locale) {
Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1);
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* CleanupTestSetassocdataTests --
*
* This function is called when an interpreter is deleted to clean
|
| ︙ | ︙ | |||
3633 3634 3635 3636 3637 3638 3639 |
parsePtr->commentSize));
} else {
Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj("-", 1));
}
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
Tcl_ListObjAppendElement(NULL, objPtr,
| | | 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 |
parsePtr->commentSize));
} else {
Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj("-", 1));
}
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewLongObj(parsePtr->numWords));
for (i = 0; i < parsePtr->numTokens; i++) {
tokenPtr = &parsePtr->tokenPtr[i];
switch (tokenPtr->type) {
case TCL_TOKEN_EXPAND_WORD:
typeString = "expand";
break;
case TCL_TOKEN_WORD:
|
| ︙ | ︙ | |||
3673 3674 3675 3676 3677 3678 3679 | break; } Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(typeString, -1)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(tokenPtr->start, tokenPtr->size)); Tcl_ListObjAppendElement(NULL, objPtr, | | | 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 |
break;
}
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(typeString, -1));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewLongObj(tokenPtr->numComponents));
}
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
-1));
}
/*
|
| ︙ | ︙ | |||
3873 3874 3875 3876 3877 3878 3879 |
const char *name;
int index;
name = Tcl_GetString(objv[i]);
if (name[0] != '-') {
break;
}
| | | | 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 |
const char *name;
int index;
name = Tcl_GetString(objv[i]);
if (name[0] != '-') {
break;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
sizeof(char *), "switch", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case REGEXP_INDICES:
indices = 1;
break;
case REGEXP_NOCASE:
|
| ︙ | ︙ | |||
3949 3950 3951 3952 3953 3954 3955 |
}
if (match == 0) {
/*
* Set the interpreter's object result to an integer object w/
* value 0.
*/
| | | 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 |
}
if (match == 0) {
/*
* Set the interpreter's object result to an integer object w/
* value 0.
*/
Tcl_SetLongObj(Tcl_GetObjResult(interp), 0);
if (objc > 2 && (cflags®_EXPECT) && indices) {
const char *varName;
const char *value;
int start, end;
char resinfo[TCL_INTEGER_SPACE * 2];
varName = Tcl_GetString(objv[2]);
|
| ︙ | ︙ | |||
4045 4046 4047 4048 4049 4050 4051 |
}
}
/*
* Set the interpreter's object result to an integer object w/ value 1.
*/
| | | 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 |
}
}
/*
* Set the interpreter's object result to an integer object w/ value 1.
*/
Tcl_SetLongObj(Tcl_GetObjResult(interp), 1);
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
* TestregexpXflags --
|
| ︙ | ︙ | |||
4440 4441 4442 4443 4444 4445 4446 |
TestseterrorcodeCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
if (argc > 6) {
| | | 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 |
TestseterrorcodeCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
if (argc > 6) {
Tcl_AppendResult(interp, "too many args", NULL);
return TCL_ERROR;
}
switch (argc) {
case 1:
Tcl_SetErrorCode(interp, "NONE", NULL);
break;
case 2:
|
| ︙ | ︙ | |||
5044 5045 5046 5047 5048 5049 5050 |
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
int flags = PTR2INT(data);
const char *value;
if (argc == 2) {
| | | | 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 |
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
int flags = PTR2INT(data);
const char *value;
if (argc == 2) {
Tcl_AppendResult(interp, "before get", NULL);
value = Tcl_GetVar2(interp, argv[1], NULL, flags);
if (value == NULL) {
return TCL_ERROR;
}
Tcl_AppendElement(interp, value);
return TCL_OK;
} else if (argc == 3) {
Tcl_AppendResult(interp, "before set", NULL);
value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags);
if (value == NULL) {
return TCL_ERROR;
}
Tcl_AppendElement(interp, value);
return TCL_OK;
} else {
|
| ︙ | ︙ | |||
5076 5077 5078 5079 5080 5081 5082 |
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
int flags = PTR2INT(data);
const char *value;
if (argc == 3) {
| | | < | 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 |
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
int flags = PTR2INT(data);
const char *value;
if (argc == 3) {
Tcl_AppendResult(interp, "before get", NULL);
value = Tcl_GetVar2(interp, argv[1], argv[2], flags);
if (value == NULL) {
return TCL_ERROR;
}
Tcl_AppendElement(interp, value);
return TCL_OK;
} else if (argc == 4) {
Tcl_AppendResult(interp, "before set", NULL);
value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags);
if (value == NULL) {
return TCL_ERROR;
}
Tcl_AppendElement(interp, value);
return TCL_OK;
} else {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " varName elemName ?newValue?\"", NULL);
return TCL_ERROR;
}
}
/*
*----------------------------------------------------------------------
*
* TestsaveresultCmd --
*
* Implements the "testsaveresult" cmd that is used when testing the
* Tcl_SaveResult, Tcl_RestoreResult, and Tcl_DiscardResult interfaces.
|
| ︙ | ︙ | |||
5124 5125 5126 5127 5128 5129 5130 |
static int
TestsaveresultCmd(
ClientData dummy, /* Not used. */
register Tcl_Interp *interp,/* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
| < | | | < | < < < | | < | 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 |
static int
TestsaveresultCmd(
ClientData dummy, /* Not used. */
register Tcl_Interp *interp,/* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
int discard, result, index;
Tcl_SavedResult state;
Tcl_Obj *objPtr;
static const char *const optionStrings[] = {
"append", "dynamic", "free", "object", "small", NULL
};
enum options {
RESULT_APPEND, RESULT_DYNAMIC, RESULT_FREE, RESULT_OBJECT, RESULT_SMALL
};
/*
* Parse arguments
*/
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "type script discard");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) {
return TCL_ERROR;
}
objPtr = NULL; /* Lint. */
switch ((enum options) index) {
case RESULT_SMALL:
Tcl_AppendResult(interp, "small result", NULL);
break;
case RESULT_APPEND:
Tcl_AppendResult(interp, "append result", NULL);
break;
case RESULT_FREE: {
char *buf = ckalloc(200);
strcpy(buf, "free result");
Tcl_SetResult(interp, buf, TCL_DYNAMIC);
break;
}
case RESULT_DYNAMIC:
Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);
break;
case RESULT_OBJECT:
objPtr = Tcl_NewStringObj("object result", -1);
Tcl_SetObjResult(interp, objPtr);
break;
}
Tcl_SaveResult(interp, &state);
if (((enum options) index) == RESULT_OBJECT) {
result = Tcl_EvalObjEx(interp, objv[2], 0);
} else {
result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0);
}
if (discard) {
Tcl_DiscardResult(&state);
} else {
Tcl_RestoreResult(interp, &state);
result = TCL_OK;
}
switch ((enum options) index) {
case RESULT_DYNAMIC:
Tcl_AppendElement(interp, discard ? "called" : "notCalled");
Tcl_AppendElement(interp, !discard ? "present" : "missing");
break;
case RESULT_OBJECT:
Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
? "same" : "different");
break;
default:
break;
}
|
| ︙ | ︙ | |||
5230 5231 5232 5233 5234 5235 5236 |
*----------------------------------------------------------------------
*/
static void
TestsaveresultFree(
char *blockPtr)
{
| | < | 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 |
*----------------------------------------------------------------------
*/
static void
TestsaveresultFree(
char *blockPtr)
{
/* empty... */
}
/*
*----------------------------------------------------------------------
*
* TestmainthreadCmd --
*
* Implements the "testmainthread" cmd that is used to test the
|
| ︙ | ︙ | |||
5264 5265 5266 5267 5268 5269 5270 |
{
if (argc == 1) {
Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
} else {
| | | 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 |
{
if (argc == 1) {
Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
} else {
Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
6065 6066 6067 6068 6069 6070 6071 |
const char *msg;
if (objc < 3) {
/*
* Don't use Tcl_WrongNumArgs here, as that is the function
* we want to test!
*/
| | | | 5889 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 |
const char *msg;
if (objc < 3) {
/*
* Don't use Tcl_WrongNumArgs here, as that is the function
* we want to test!
*/
Tcl_AppendResult(interp, "insufficient arguments", NULL);
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
return TCL_ERROR;
}
msg = Tcl_GetStringFromObj(objv[2], &length);
if (length == 0) {
msg = NULL;
}
if (i > objc - 3) {
/*
* Asked for more arguments than were given.
*/
Tcl_AppendResult(interp, "insufficient arguments", NULL);
return TCL_ERROR;
}
Tcl_WrongNumArgs(interp, i, &(objv[3]), msg);
return TCL_OK;
}
|
| ︙ | ︙ | |||
6710 6711 6712 6713 6714 6715 6716 |
if (objc > 1) {
int len = -1;
if (objc > 2) {
(void) Tcl_GetStringFromObj(objv[1], &len);
}
len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len);
| | | 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 |
if (objc > 1) {
int len = -1;
if (objc > 2) {
(void) Tcl_GetStringFromObj(objv[1], &len);
}
len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len);
Tcl_SetObjResult(interp, Tcl_NewLongObj(len));
}
return TCL_OK;
}
#if defined(HAVE_CPUID) || defined(_WIN32)
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
6764 6765 6766 6767 6768 6769 6770 |
status = TclWinCPUID(index, regs);
if (status != TCL_OK) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("operation not available", -1));
return status;
}
for (i=0 ; i<4 ; ++i) {
| | | 6588 6589 6590 6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 |
status = TclWinCPUID(index, regs);
if (status != TCL_OK) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("operation not available", -1));
return status;
}
for (i=0 ; i<4 ; ++i) {
regsObjs[i] = Tcl_NewLongObj(regs[i]);
}
Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
return TCL_OK;
}
#endif
/*
|
| ︙ | ︙ | |||
6805 6806 6807 6808 6809 6810 6811 |
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
for (i=0 ; i<limit ; i++) {
hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
if (!isNew) {
| | | | | 6629 6630 6631 6632 6633 6634 6635 6636 6637 6638 6639 6640 6641 6642 6643 6644 6645 6646 6647 6648 6649 6650 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661 6662 6663 6664 6665 6666 |
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
for (i=0 ; i<limit ; i++) {
hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
if (!isNew) {
Tcl_SetObjResult(interp, Tcl_NewLongObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
Tcl_SetHashValue(hPtr, INT2PTR(i+42));
}
if (hash.numEntries != limit) {
Tcl_AppendResult(interp, "unexpected maximal size", NULL);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
for (i=0 ; i<limit ; i++) {
hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
if (hPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewLongObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) {
Tcl_SetObjResult(interp, Tcl_NewLongObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
Tcl_DeleteHashEntry(hPtr);
}
|
| ︙ | ︙ | |||
6859 6860 6861 6862 6863 6864 6865 |
TestgetintCmd(
ClientData dummy,
Tcl_Interp *interp,
int argc,
const char **argv)
{
if (argc < 2) {
| | | | 6683 6684 6685 6686 6687 6688 6689 6690 6691 6692 6693 6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 |
TestgetintCmd(
ClientData dummy,
Tcl_Interp *interp,
int argc,
const char **argv)
{
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
} else {
int val, i, total=0;
for (i=1 ; i<argc ; i++) {
if (Tcl_GetInt(interp, argv[i], &val) != TCL_OK) {
return TCL_ERROR;
}
total += val;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(total));
return TCL_OK;
}
}
static int
NREUnwind_callback(
ClientData data[],
|
| ︙ | ︙ | |||
6940 6941 6942 6943 6944 6945 6946 |
if (refDepth == NULL) {
refDepth = &depth;
}
depth = (refDepth - &depth);
| | | | | | | | 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 6776 6777 6778 6779 6780 6781 6782 6783 6784 6785 6786 6787 6788 6789 |
if (refDepth == NULL) {
refDepth = &depth;
}
depth = (refDepth - &depth);
levels[0] = Tcl_NewLongObj(depth);
levels[1] = Tcl_NewLongObj(iPtr->numLevels);
levels[2] = Tcl_NewLongObj(iPtr->cmdFramePtr->level);
levels[3] = Tcl_NewLongObj(iPtr->varFramePtr->level);
levels[4] = Tcl_NewLongObj(iPtr->execEnvPtr->execStackPtr->tosPtr
- iPtr->execEnvPtr->execStackPtr->stackWords);
while (cbPtr) {
i++;
cbPtr = cbPtr->nextPtr;
}
levels[5] = Tcl_NewLongObj(i);
Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
7298 7299 7300 7301 7302 7303 7304 |
TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
};
foo = 0;
if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
return TCL_ERROR;
}
| | | | 7122 7123 7124 7125 7126 7127 7128 7129 7130 7131 7132 7133 7134 7135 7136 7137 |
TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
};
foo = 0;
if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
return TCL_ERROR;
}
result[0] = Tcl_NewLongObj(foo);
result[1] = Tcl_NewLongObj(count);
result[2] = Tcl_NewListObj(count, remObjv);
Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
ckfree(remObjv);
return TCL_OK;
}
/**
|
| ︙ | ︙ | |||
7383 7384 7385 7386 7387 7388 7389 |
* When these conditions hold, this function resolves the
* passed-in cmd literal into a cmd "y" or "Y" depending on the
* context. The resolved procs are taken from the the global
* namespace (for simplicity).
*/
CallFrame *parentFramePtr = varFramePtr->callerPtr;
| | | 7207 7208 7209 7210 7211 7212 7213 7214 7215 7216 7217 7218 7219 7220 7221 |
* When these conditions hold, this function resolves the
* passed-in cmd literal into a cmd "y" or "Y" depending on the
* context. The resolved procs are taken from the the global
* namespace (for simplicity).
*/
CallFrame *parentFramePtr = varFramePtr->callerPtr;
const char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)";
if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
/* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/
} else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY);
|
| ︙ | ︙ | |||
7542 7543 7544 7545 7546 7547 7548 |
if (objc == 3) {
interp = Tcl_GetSlave(interp, Tcl_GetString(objv[2]));
if (interp == NULL) {
Tcl_AppendResult(interp, "provided interpreter not found", NULL);
return TCL_ERROR;
}
}
| | | | 7366 7367 7368 7369 7370 7371 7372 7373 7374 7375 7376 7377 7378 7379 7380 7381 |
if (objc == 3) {
interp = Tcl_GetSlave(interp, Tcl_GetString(objv[2]));
if (interp == NULL) {
Tcl_AppendResult(interp, "provided interpreter not found", NULL);
return TCL_ERROR;
}
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], table,
sizeof(char *), "operation", TCL_EXACT, &idx) != TCL_OK) {
return TCL_ERROR;
}
switch (idx) {
case 1: /* up */
Tcl_AddInterpResolvers(interp, RESOLVER_KEY, InterpCmdResolver,
InterpVarResolver, InterpCompiledVarResolver);
break;
|
| ︙ | ︙ |
Changes to generic/tclTestObj.c.
| ︙ | ︙ | |||
162 163 164 165 166 167 168 |
mp_int bignumValue, newValue;
Tcl_Obj **varPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
| | | | 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 |
mp_int bignumValue, newValue;
Tcl_Obj **varPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmds,
sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
string = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
|
| ︙ | ︙ | |||
336 337 338 339 340 341 342 |
* has ref count 1 (i.e. the object is unshared) we can modify that
* object directly. Otherwise, if RC>1 (i.e. the object is shared),
* we must create a new object to modify/set and decrement the old
* formerly-shared object's ref count. This is "copy on write".
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
| | | | 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 |
* has ref count 1 (i.e. the object is unshared) we can modify that
* object directly. Otherwise, if RC>1 (i.e. the object is shared),
* we must create a new object to modify/set and decrement the old
* formerly-shared object's ref count. This is "copy on write".
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], boolValue!=0);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(boolValue!=0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "get") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
|
| ︙ | ︙ | |||
361 362 363 364 365 366 367 |
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
&boolValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
| | | | 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 |
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
&boolValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], boolValue==0);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(boolValue==0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad option \"", Tcl_GetString(objv[1]),
"\": must be set, get, or not", NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
544 545 546 547 548 549 550 |
* lookups.
*/
if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
return TCL_ERROR;
}
| | > | | | | 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 |
* lookups.
*/
if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
return TCL_ERROR;
}
Tcl_GetIndexFromObjStruct(NULL, objv[1], tablePtr,
sizeof(char *), "token", 0, &index);
indexRep = objv[1]->internalRep.twoPtrValue.ptr1;
indexRep->index = index2;
result = Tcl_GetIndexFromObjStruct(NULL, objv[1],
tablePtr, sizeof(char *), "token", 0, &index);
if (result == TCL_OK) {
Tcl_SetLongObj(Tcl_GetObjResult(interp), index);
}
return result;
}
if (objc < 5) {
Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1);
return TCL_ERROR;
|
| ︙ | ︙ | |||
573 574 575 576 577 578 579 |
argv = ckalloc((objc-3) * sizeof(char *));
for (i = 4; i < objc; i++) {
argv[i-4] = Tcl_GetString(objv[i]);
}
argv[objc-4] = NULL;
| | > | < | | 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 |
argv = ckalloc((objc-3) * sizeof(char *));
for (i = 4; i < objc; i++) {
argv[i-4] = Tcl_GetString(objv[i]);
}
argv[objc-4] = NULL;
result = Tcl_GetIndexFromObjStruct((setError? interp : NULL), objv[3],
argv, sizeof(char *), "token",
INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT), &index);
ckfree(argv);
if (result == TCL_OK) {
Tcl_SetLongObj(Tcl_GetObjResult(interp), index);
}
return result;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
645 646 647 648 649 650 651 |
* has ref count 1 (i.e. the object is unshared) we can modify that
* object directly. Otherwise, if RC>1 (i.e. the object is shared), we
* must create a new object to modify/set and decrement the old
* formerly-shared object's ref count. This is "copy on write".
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
| | | | | | 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 |
* has ref count 1 (i.e. the object is unshared) we can modify that
* object directly. Otherwise, if RC>1 (i.e. the object is shared), we
* must create a new object to modify/set and decrement the old
* formerly-shared object's ref count. This is "copy on write".
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], intValue);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
if (objc != 4) {
goto wrongNumArgs;
}
string = Tcl_GetString(objv[3]);
if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
return TCL_ERROR;
}
intValue = i;
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], intValue);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue));
}
} else if (strcmp(subCmd, "setlong") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
string = Tcl_GetString(objv[3]);
if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
|
| ︙ | ︙ | |||
756 757 758 759 760 761 762 |
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
&intValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
| | | | | | 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 |
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
&intValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], intValue * 10);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue * 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "div10") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
&intValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], intValue / 10);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue / 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad option \"", Tcl_GetString(objv[1]),
"\": must be set, get, get2, mult10, or div10", NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
840 841 842 843 844 845 846 |
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
| | | | 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 |
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcommands,
sizeof(char *), "command", 0, &cmdIndex) != TCL_OK) {
return TCL_ERROR;
}
switch(cmdIndex) {
case LISTOBJ_SET:
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
} else {
|
| ︙ | ︙ | |||
944 945 946 947 948 949 950 |
SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[destIndex]);
} else if (strcmp(subCmd, "bug3598580") == 0) {
Tcl_Obj *listObjPtr, *elemObjPtr;
if (objc != 2) {
goto wrongNumArgs;
}
| | | 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 |
SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[destIndex]);
} else if (strcmp(subCmd, "bug3598580") == 0) {
Tcl_Obj *listObjPtr, *elemObjPtr;
if (objc != 2) {
goto wrongNumArgs;
}
elemObjPtr = Tcl_NewLongObj(123);
listObjPtr = Tcl_NewListObj(1, &elemObjPtr);
/* Replace the single list element through itself, nonsense but legal. */
Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr);
Tcl_SetObjResult(interp, listObjPtr);
return TCL_OK;
} else if (strcmp(subCmd, "convert") == 0) {
const char *typeName;
|
| ︙ | ︙ | |||
1052 1053 1054 1055 1056 1057 1058 |
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
| | | 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 |
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(varPtr[varIndex]->refCount));
} else if (strcmp(subCmd, "type") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
1137 1138 1139 1140 1141 1142 1143 |
varPtr = GetVarPtr(interp);
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
| | | | 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 |
varPtr = GetVarPtr(interp);
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
sizeof(char *), "option", 0, &option) != TCL_OK) {
return TCL_ERROR;
}
switch (option) {
case 0: /* append */
if (objc != 5) {
goto wrongNumArgs;
}
|
| ︙ | ︙ | |||
1216 1217 1218 1219 1220 1221 1222 |
string = Tcl_GetString(varPtr[varIndex]);
Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
break;
case 4: /* length */
if (objc != 3) {
goto wrongNumArgs;
}
| | | | 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 |
string = Tcl_GetString(varPtr[varIndex]);
Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
break;
case 4: /* length */
if (objc != 3) {
goto wrongNumArgs;
}
Tcl_SetLongObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
? varPtr[varIndex]->length : -1);
break;
case 5: /* length2 */
if (objc != 3) {
goto wrongNumArgs;
}
if (varPtr[varIndex] != NULL) {
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = (int) strPtr->allocated;
} else {
length = -1;
}
Tcl_SetLongObj(Tcl_GetObjResult(interp), length);
break;
case 6: /* set */
if (objc != 4) {
goto wrongNumArgs;
}
/*
|
| ︙ | ︙ | |||
1285 1286 1287 1288 1289 1290 1291 |
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = strPtr->maxChars;
} else {
length = -1;
}
| | | 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 |
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = strPtr->maxChars;
} else {
length = -1;
}
Tcl_SetLongObj(Tcl_GetObjResult(interp), length);
break;
case 10: /* getunicode */
if (objc != 3) {
goto wrongNumArgs;
}
Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL);
break;
|
| ︙ | ︙ |
Changes to generic/tclTestProcBodyObj.c.
| ︙ | ︙ | |||
30 31 32 33 34 35 36 | static const char procCommand[] = "proc"; /* * this struct describes an entry in the table of command names and command * procs */ | | | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
static const char procCommand[] = "proc";
/*
* this struct describes an entry in the table of command names and command
* procs
*/
typedef struct {
const char *cmdName; /* command name */
Tcl_ObjCmdProc *proc; /* command proc */
int exportIt; /* if 1, export the command */
} CmdTable;
/*
* Declarations for functions defined in this file.
|
| ︙ | ︙ | |||
181 182 183 184 185 186 187 |
cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
return TCL_ERROR;
}
}
| | | 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 |
cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
return TCL_ERROR;
}
}
return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL);
}
/*
*----------------------------------------------------------------------
*
* ProcBodyTestProcObjCmd --
*
|
| ︙ | ︙ |
Changes to generic/tclThreadAlloc.c.
| ︙ | ︙ | |||
78 79 80 81 82 83 84 | #define MAXALLOC (MINALLOC << (NBUCKETS - 1)) /* * The following structure defines a bucket of blocks with various accounting * and statistics information. */ | | | 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 |
#define MAXALLOC (MINALLOC << (NBUCKETS - 1))
/*
* The following structure defines a bucket of blocks with various accounting
* and statistics information.
*/
typedef struct {
Block *firstPtr; /* First block available */
Block *lastPtr; /* End of block list */
long numFree; /* Number of blocks available */
/* All fields below for accounting only */
long numRemoves; /* Number of removes from bucket */
|
| ︙ | ︙ |
Changes to generic/tclThreadStorage.c.
| ︙ | ︙ | |||
43 44 45 46 47 48 49 |
* which holds per-process data. */
} tsdMaster = { NULL, 0, NULL };
/*
* The type of the data held per thread in a system TSD.
*/
| | | 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 |
* which holds per-process data. */
} tsdMaster = { NULL, 0, NULL };
/*
* The type of the data held per thread in a system TSD.
*/
typedef struct {
ClientData *tablePtr; /* The table of Tcl TSDs. */
sig_atomic_t allocated; /* The size of the table in the current
* thread. */
} TSDTable;
/*
* The actual type of Tcl_ThreadDataKey.
|
| ︙ | ︙ |
Changes to generic/tclThreadTest.c.
| ︙ | ︙ | |||
58 59 60 61 62 63 64 |
/*
* An instance of the following structure contains all information that is
* passed into a new thread when the thread is created using either the
* "thread create" Tcl command or the ThreadCreate() C function.
*/
typedef struct ThreadCtrl {
| | | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 |
/*
* An instance of the following structure contains all information that is
* passed into a new thread when the thread is created using either the
* "thread create" Tcl command or the ThreadCreate() C function.
*/
typedef struct ThreadCtrl {
const char *script; /* The Tcl command this thread should
* execute */
int flags; /* Initial value of the "flags" field in the
* ThreadSpecificData structure for the new
* thread. Might contain TP_Detached or
* TP_TclThread. */
Tcl_Condition condWait; /* This condition variable is used to
* synchronize the parent and child threads.
|
| ︙ | ︙ | |||
225 226 227 228 229 230 231 |
THREAD_WAIT, THREAD_ERRORPROC
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
| | | | 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 |
THREAD_WAIT, THREAD_ERRORPROC
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], threadOptions,
sizeof(char *), "option", 0, &option) != TCL_OK) {
return TCL_ERROR;
}
/*
* Make sure the initial thread is on the list before doing anything.
*/
|
| ︙ | ︙ | |||
364 365 366 367 368 369 370 |
}
if (Tcl_GetWideIntFromObj(interp, objv[2], &id) != TCL_OK) {
return TCL_ERROR;
}
result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status);
if (result == TCL_OK) {
| | | 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 |
}
if (Tcl_GetWideIntFromObj(interp, objv[2], &id) != TCL_OK) {
return TCL_ERROR;
}
result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status);
if (result == TCL_OK) {
Tcl_SetLongObj(Tcl_GetObjResult(interp), status);
} else {
char buf[20];
sprintf(buf, "%" TCL_LL_MODIFIER "d", id);
Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
}
return result;
|
| ︙ | ︙ | |||
411 412 413 414 415 416 417 |
return ThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait);
}
case THREAD_EVENT: {
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
| | | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 |
return ThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait);
}
case THREAD_EVENT: {
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(
Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT)));
return TCL_OK;
}
case THREAD_ERRORPROC: {
/*
* Arrange for this proc to handle thread death errors.
*/
|
| ︙ | ︙ |
Changes to generic/tclTimer.c.
| ︙ | ︙ | |||
819 820 821 822 823 824 825 |
*/
if (objv[1]->typePtr == &tclIntType
#ifndef TCL_WIDE_INT_IS_LONG
|| objv[1]->typePtr == &tclWideIntType
#endif
|| objv[1]->typePtr == &tclBignumType
| | | | 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 |
*/
if (objv[1]->typePtr == &tclIntType
#ifndef TCL_WIDE_INT_IS_LONG
|| objv[1]->typePtr == &tclWideIntType
#endif
|| objv[1]->typePtr == &tclBignumType
|| (Tcl_GetIndexFromObjStruct(NULL, objv[1], afterSubCmds,
sizeof(char *), "", 0, &index) != TCL_OK)) {
index = -1;
if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
const char *arg = Tcl_GetString(objv[1]);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad argument \"%s\": must be"
" cancel, idle, info, or an integer", arg));
|
| ︙ | ︙ |
Changes to generic/tclTomMath.decls.
| ︙ | ︙ | |||
14 15 16 17 18 19 20 |
library tcl
# Define the unsupported generic interfaces.
interface tclTomMath
# hooks {tclTomMathInt}
| | | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 |
library tcl
# Define the unsupported generic interfaces.
interface tclTomMath
# hooks {tclTomMathInt}
scspec TCLAPI
# Declare each of the functions in the Tcl tommath interface
declare 0 {
int TclBN_epoch(void)
}
declare 1 {
|
| ︙ | ︙ |
Changes to generic/tclTomMathDecls.h.
| ︙ | ︙ | |||
111 112 113 114 115 116 117 | #define mp_xor TclBN_mp_xor #define mp_zero TclBN_mp_zero #define s_mp_add TclBN_s_mp_add #define s_mp_mul_digs TclBN_s_mp_mul_digs #define s_mp_sqr TclBN_s_mp_sqr #define s_mp_sub TclBN_s_mp_sub | < < < < < < < < < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 149 150 151 152 153 154 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 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 |
#define mp_xor TclBN_mp_xor
#define mp_zero TclBN_mp_zero
#define s_mp_add TclBN_s_mp_add
#define s_mp_mul_digs TclBN_s_mp_mul_digs
#define s_mp_sqr TclBN_s_mp_sqr
#define s_mp_sub TclBN_s_mp_sub
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
* script. Any modifications to the function declarations below should be made
* in the generic/tclInt.decls script.
*/
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
/*
* Exported function declarations:
*/
/* 0 */
TCLAPI int TclBN_epoch(void);
/* 1 */
TCLAPI int TclBN_revision(void);
/* 2 */
TCLAPI int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c);
/* 3 */
TCLAPI int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c);
/* 4 */
TCLAPI int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c);
/* 5 */
TCLAPI void TclBN_mp_clamp(mp_int *a);
/* 6 */
TCLAPI void TclBN_mp_clear(mp_int *a);
/* 7 */
TCLAPI void TclBN_mp_clear_multi(mp_int *a, ...);
/* 8 */
TCLAPI int TclBN_mp_cmp(const mp_int *a, const mp_int *b);
/* 9 */
TCLAPI int TclBN_mp_cmp_d(const mp_int *a, mp_digit b);
/* 10 */
TCLAPI int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b);
/* 11 */
TCLAPI int TclBN_mp_copy(const mp_int *a, mp_int *b);
/* 12 */
TCLAPI int TclBN_mp_count_bits(const mp_int *a);
/* 13 */
TCLAPI int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q,
mp_int *r);
/* 14 */
TCLAPI int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q,
mp_digit *r);
/* 15 */
TCLAPI int TclBN_mp_div_2(mp_int *a, mp_int *q);
/* 16 */
TCLAPI int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q,
mp_int *r);
/* 17 */
TCLAPI int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r);
/* 18 */
TCLAPI void TclBN_mp_exch(mp_int *a, mp_int *b);
/* 19 */
TCLAPI int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
/* 20 */
TCLAPI int TclBN_mp_grow(mp_int *a, int size);
/* 21 */
TCLAPI int TclBN_mp_init(mp_int *a);
/* 22 */
TCLAPI int TclBN_mp_init_copy(mp_int *a, mp_int *b);
/* 23 */
TCLAPI int TclBN_mp_init_multi(mp_int *a, ...);
/* 24 */
TCLAPI int TclBN_mp_init_set(mp_int *a, mp_digit b);
/* 25 */
TCLAPI int TclBN_mp_init_size(mp_int *a, int size);
/* 26 */
TCLAPI int TclBN_mp_lshd(mp_int *a, int shift);
/* 27 */
TCLAPI int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r);
/* 28 */
TCLAPI int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r);
/* 29 */
TCLAPI int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p);
/* 30 */
TCLAPI int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p);
/* 31 */
TCLAPI int TclBN_mp_mul_2(mp_int *a, mp_int *p);
/* 32 */
TCLAPI int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p);
/* 33 */
TCLAPI int TclBN_mp_neg(const mp_int *a, mp_int *b);
/* 34 */
TCLAPI int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c);
/* 35 */
TCLAPI int TclBN_mp_radix_size(mp_int *a, int radix, int *size);
/* 36 */
TCLAPI int TclBN_mp_read_radix(mp_int *a, const char *str,
int radix);
/* 37 */
TCLAPI void TclBN_mp_rshd(mp_int *a, int shift);
/* 38 */
TCLAPI int TclBN_mp_shrink(mp_int *a);
/* 39 */
TCLAPI void TclBN_mp_set(mp_int *a, mp_digit b);
/* 40 */
TCLAPI int TclBN_mp_sqr(mp_int *a, mp_int *b);
/* 41 */
TCLAPI int TclBN_mp_sqrt(mp_int *a, mp_int *b);
/* 42 */
TCLAPI int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c);
/* 43 */
TCLAPI int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
/* 44 */
TCLAPI int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b);
/* 45 */
TCLAPI int TclBN_mp_to_unsigned_bin_n(mp_int *a,
unsigned char *b, unsigned long *outlen);
/* 46 */
TCLAPI int TclBN_mp_toradix_n(mp_int *a, char *str, int radix,
int maxlen);
/* 47 */
TCLAPI int TclBN_mp_unsigned_bin_size(mp_int *a);
/* 48 */
TCLAPI int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c);
/* 49 */
TCLAPI void TclBN_mp_zero(mp_int *a);
/* 50 */
TCLAPI void TclBN_reverse(unsigned char *s, int len);
/* 51 */
TCLAPI int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b,
mp_int *c, int digs);
/* 52 */
TCLAPI int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b);
/* 53 */
TCLAPI int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b,
mp_int *c);
/* 54 */
TCLAPI int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b);
/* 55 */
TCLAPI int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
/* 56 */
TCLAPI int TclBN_mp_toom_sqr(mp_int *a, mp_int *b);
/* 57 */
TCLAPI int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c);
/* 58 */
TCLAPI int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c,
int digs);
/* 59 */
TCLAPI int TclBN_s_mp_sqr(mp_int *a, mp_int *b);
/* 60 */
TCLAPI int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
/* 61 */
TCLAPI int TclBN_mp_init_set_int(mp_int *a, unsigned long i);
/* 62 */
TCLAPI int TclBN_mp_set_int(mp_int *a, unsigned long i);
/* 63 */
TCLAPI int TclBN_mp_cnt_lsb(const mp_int *a);
/* 64 */
TCLAPI void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
/* 65 */
TCLAPI void TclBNInitBignumFromWideInt(mp_int *bignum,
Tcl_WideInt initVal);
/* 66 */
TCLAPI void TclBNInitBignumFromWideUInt(mp_int *bignum,
Tcl_WideUInt initVal);
typedef struct TclTomMathStubs {
int magic;
void *hooks;
int (*tclBN_epoch) (void); /* 0 */
|
| ︙ | ︙ | |||
508 509 510 511 512 513 514 | #define TclBNInitBignumFromWideUInt \ (tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ | < < < | 497 498 499 500 501 502 503 504 | #define TclBNInitBignumFromWideUInt \ (tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLINTDECLS */ |
Changes to generic/tclTrace.c.
| ︙ | ︙ | |||
1845 1846 1847 1848 1849 1850 1851 | Tcl_Obj *resultCode; const char *resultCodeStr; /* * Append result code. */ | | | 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 | Tcl_Obj *resultCode; const char *resultCodeStr; /* * Append result code. */ resultCode = Tcl_NewLongObj(code); resultCodeStr = Tcl_GetString(resultCode); Tcl_DStringAppendElement(&cmd, resultCodeStr); Tcl_DecrRefCount(resultCode); /* * Append result string. */ |
| ︙ | ︙ | |||
1976 1977 1978 1979 1980 1981 1982 |
TraceVarInfo *tvarPtr = clientData;
char *result;
int code, destroy = 0;
Tcl_DString cmd;
int rewind = ((Interp *)interp)->execEnvPtr->rewind;
/*
| | | 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 |
TraceVarInfo *tvarPtr = clientData;
char *result;
int code, destroy = 0;
Tcl_DString cmd;
int rewind = ((Interp *)interp)->execEnvPtr->rewind;
/*
* We might call Tcl_EvalEx() below, and that might evaluate [trace vdelete]
* which might try to free tvarPtr. We want to use tvarPtr until the end
* of this function, so we use Tcl_Preserve() and Tcl_Release() to be sure
* it is not freed while we still need it.
*/
result = NULL;
if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp)
|
| ︙ | ︙ | |||
2801 2802 2803 2804 2805 2806 2807 |
Tcl_DecrRefCount((Tcl_Obj *) result);
}
}
/*
*----------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 |
Tcl_DecrRefCount((Tcl_Obj *) result);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_UntraceVar2 --
*
* Remove a previously-created trace for a variable.
*
* Results:
* None.
*
|
| ︙ | ︙ | |||
2964 2965 2966 2967 2968 2969 2970 |
TclCleanupVar(varPtr, NULL);
}
}
/*
*----------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 |
TclCleanupVar(varPtr, NULL);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_VarTraceInfo2 --
*
* Same as Tcl_VarTraceInfo, except takes name in two pieces instead of
* one.
*
* Results:
* Same as Tcl_VarTraceInfo.
|
| ︙ | ︙ | |||
3071 3072 3073 3074 3075 3076 3077 |
if (tracePtr->traceProc == proc) {
return tracePtr->clientData;
}
}
}
return NULL;
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 |
if (tracePtr->traceProc == proc) {
return tracePtr->clientData;
}
}
}
return NULL;
}
/*
*----------------------------------------------------------------------
*
* Tcl_TraceVar2 --
*
* Arrange for reads and/or writes to a variable to cause a function to
|
| ︙ | ︙ |
Changes to generic/tclUtf.c.
| ︙ | ︙ | |||
947 948 949 950 951 952 953 |
*----------------------------------------------------------------------
*/
int
TclpUtfNcmp2(
const char *cs, /* UTF string to compare to ct. */
const char *ct, /* UTF string cs is compared to. */
| | | 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 |
*----------------------------------------------------------------------
*/
int
TclpUtfNcmp2(
const char *cs, /* UTF string to compare to ct. */
const char *ct, /* UTF string cs is compared to. */
size_t numBytes) /* Number of *bytes* to compare. */
{
/*
* We can't simply call 'memcmp(cs, ct, numBytes);' because we need to
* check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes
* fine in the strcmp manner.
*/
|
| ︙ | ︙ | |||
994 995 996 997 998 999 1000 |
*----------------------------------------------------------------------
*/
int
Tcl_UtfNcmp(
const char *cs, /* UTF string to compare to ct. */
const char *ct, /* UTF string cs is compared to. */
| | | 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 |
*----------------------------------------------------------------------
*/
int
Tcl_UtfNcmp(
const char *cs, /* UTF string to compare to ct. */
const char *ct, /* UTF string cs is compared to. */
size_t numChars) /* Number of UTF chars to compare. */
{
Tcl_UniChar ch1, ch2;
/*
* Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the
* pair of bytes 0xc0,0x80) is larger than byte representation of \u0001
* (the byte 0x01.)
|
| ︙ | ︙ | |||
1042 1043 1044 1045 1046 1047 1048 |
*----------------------------------------------------------------------
*/
int
Tcl_UtfNcasecmp(
const char *cs, /* UTF string to compare to ct. */
const char *ct, /* UTF string cs is compared to. */
| | | 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 |
*----------------------------------------------------------------------
*/
int
Tcl_UtfNcasecmp(
const char *cs, /* UTF string to compare to ct. */
const char *ct, /* UTF string cs is compared to. */
size_t numChars) /* Number of UTF chars to compare. */
{
Tcl_UniChar ch1, ch2;
while (numChars-- > 0) {
/*
* n must be interpreted as chars, not bytes.
* This should be called only when both strings are of
* at least n chars long (no need for \0 check)
|
| ︙ | ︙ | |||
1246 1247 1248 1249 1250 1251 1252 |
*----------------------------------------------------------------------
*/
int
Tcl_UniCharNcmp(
const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */
const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
| | | 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 |
*----------------------------------------------------------------------
*/
int
Tcl_UniCharNcmp(
const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */
const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
size_t numChars) /* Number of unichars to compare. */
{
#ifdef WORDS_BIGENDIAN
/*
* We are definitely on a big-endian machine; memcmp() is safe
*/
return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));
|
| ︙ | ︙ | |||
1291 1292 1293 1294 1295 1296 1297 |
*----------------------------------------------------------------------
*/
int
Tcl_UniCharNcasecmp(
const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */
const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
| | | 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 |
*----------------------------------------------------------------------
*/
int
Tcl_UniCharNcasecmp(
const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */
const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
size_t numChars) /* Number of unichars to compare. */
{
for ( ; numChars != 0; numChars--, ucs++, uct++) {
if (*ucs != *uct) {
Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
Tcl_UniChar lct = Tcl_UniCharToLower(*uct);
if (lcs != lct) {
|
| ︙ | ︙ |
Changes to generic/tclUtil.c.
| ︙ | ︙ | |||
933 934 935 936 937 938 939 | * None. * *---------------------------------------------------------------------- */ int Tcl_ScanElement( | | | | | 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 |
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_ScanElement(
const char *src, /* String to convert to list element. */
int *flagPtr) /* Where to store information to guide
* Tcl_ConvertCountedElement. */
{
return Tcl_ScanCountedElement(src, -1, flagPtr);
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
970 971 972 973 974 975 976 |
int
Tcl_ScanCountedElement(
const char *src, /* String to convert to Tcl list element. */
int length, /* Number of bytes in src, or -1. */
int *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
| | | 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 |
int
Tcl_ScanCountedElement(
const char *src, /* String to convert to Tcl list element. */
int length, /* Number of bytes in src, or -1. */
int *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
char flags = CONVERT_ANY;
int numBytes = TclScanElement(src, length, &flags);
*flagPtr = flags;
return numBytes;
}
/*
|
| ︙ | ︙ | |||
1011 1012 1013 1014 1015 1016 1017 |
*----------------------------------------------------------------------
*/
int
TclScanElement(
const char *src, /* String to convert to Tcl list element. */
int length, /* Number of bytes in src, or -1. */
| | | 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 |
*----------------------------------------------------------------------
*/
int
TclScanElement(
const char *src, /* String to convert to Tcl list element. */
int length, /* Number of bytes in src, or -1. */
char *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
const char *p = src;
int nestingLevel = 0; /* Brace nesting count */
int forbidNone = 0; /* Do not permit CONVERT_NONE mode. Something
* needs protection or escape. */
int requireEscape = 0; /* Force use of CONVERT_ESCAPE mode. For some
|
| ︙ | ︙ | |||
1296 1297 1298 1299 1300 1301 1302 | * None. * *---------------------------------------------------------------------- */ int Tcl_ConvertElement( | | | | | 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 |
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_ConvertElement(
const char *src, /* Source information for list element. */
char *dst, /* Place to put list-ified element. */
int flags) /* Flags produced by Tcl_ScanElement. */
{
return Tcl_ConvertCountedElement(src, -1, dst, flags);
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1362 1363 1364 1365 1366 1367 1368 |
*/
int
TclConvertElement(
register const char *src, /* Source information for list element. */
int length, /* Number of bytes in src, or -1. */
char *dst, /* Place to put list-ified element. */
| | | | 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 |
*/
int
TclConvertElement(
register const char *src, /* Source information for list element. */
int length, /* Number of bytes in src, or -1. */
char *dst, /* Place to put list-ified element. */
char flags) /* Flags produced by Tcl_ScanElement. */
{
char conversion = flags & CONVERT_MASK;
char *p = dst;
/*
* Let the caller demand we use escape sequences rather than braces.
*/
if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
|
| ︙ | ︙ | |||
1543 1544 1545 1546 1547 1548 1549 |
*/
char *
Tcl_Merge(
int argc, /* How many strings to merge. */
const char *const *argv) /* Array of string values. */
{
| | | | < < < < < < < < < < < < < < < | | 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 |
*/
char *
Tcl_Merge(
int argc, /* How many strings to merge. */
const char *const *argv) /* Array of string values. */
{
#define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE];
int i, bytesNeeded = 0;
char *result, *dst, *flagPtr = NULL;
/*
* Handle empty list case first, so logic of the general case can be
* simpler.
*/
if (argc == 0) {
result = ckalloc(1);
result[0] = '\0';
return result;
}
/*
* Pass 1: estimate space, gather flags.
*/
if (argc <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
flagPtr = ckalloc(argc);
}
for (i = 0; i < argc; i++) {
flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]);
if (bytesNeeded < 0) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
|
| ︙ | ︙ | |||
1614 1615 1616 1617 1618 1619 1620 |
dst[-1] = 0;
if (flagPtr != localFlags) {
ckfree(flagPtr);
}
return result;
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 |
dst[-1] = 0;
if (flagPtr != localFlags) {
ckfree(flagPtr);
}
return result;
}
/*
*----------------------------------------------------------------------
*
* TclTrimRight --
*
* Takes two counted strings in the Tcl encoding which must both be null
|
| ︙ | ︙ | |||
2713 2714 2715 2716 2717 2718 2719 |
Tcl_DStringAppendElement(
Tcl_DString *dsPtr, /* Structure describing dynamic string. */
const char *element) /* String to append. Must be
* null-terminated. */
{
char *dst = dsPtr->string + dsPtr->length;
int needSpace = TclNeedSpace(dsPtr->string, dst);
| | | 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 |
Tcl_DStringAppendElement(
Tcl_DString *dsPtr, /* Structure describing dynamic string. */
const char *element) /* String to append. Must be
* null-terminated. */
{
char *dst = dsPtr->string + dsPtr->length;
int needSpace = TclNeedSpace(dsPtr->string, dst);
char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
int newSize = dsPtr->length + needSpace
+ TclScanElement(element, -1, &flags);
/*
* Allocate a larger buffer for the string if the current one isn't large
* enough. Allocate extra space in the new buffer so that there will be
* room to grow before we have to allocate again. SPECIAL NOTE: must use
|
| ︙ | ︙ | |||
2890 2891 2892 2893 2894 2895 2896 |
void
Tcl_DStringResult(
Tcl_Interp *interp, /* Interpreter whose result is to be reset. */
Tcl_DString *dsPtr) /* Dynamic string that is to become the
* result of interp. */
{
| < | 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 |
void
Tcl_DStringResult(
Tcl_Interp *interp, /* Interpreter whose result is to be reset. */
Tcl_DString *dsPtr) /* Dynamic string that is to become the
* result of interp. */
{
Tcl_SetObjResult(interp, TclDStringToObj(dsPtr));
}
/*
*----------------------------------------------------------------------
*
* Tcl_DStringGetResult --
|
| ︙ | ︙ | |||
2920 2921 2922 2923 2924 2925 2926 |
void
Tcl_DStringGetResult(
Tcl_Interp *interp, /* Interpreter whose result is to be reset. */
Tcl_DString *dsPtr) /* Dynamic string that is to become the result
* of interp. */
{
| < < < < < < < < < < < < < < < < < < < < < < < < < < | < < | < < < < < | < < | < < < < | | < < < < < < < < < < < < < < < < < < < < < < < < < < | 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 |
void
Tcl_DStringGetResult(
Tcl_Interp *interp, /* Interpreter whose result is to be reset. */
Tcl_DString *dsPtr) /* Dynamic string that is to become the result
* of interp. */
{
int length;
char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
Tcl_DStringFree(dsPtr);
Tcl_DStringAppend(dsPtr, bytes, length);
Tcl_ResetResult(interp);
}
/*
*----------------------------------------------------------------------
*
* TclDStringToObj --
*
|
| ︙ | ︙ | |||
3337 3338 3339 3340 3341 3342 3343 |
* When the variable is read, reset its value from our shared value. This
* is needed in case the variable was modified in some other interpreter
* so that this interpreter's value is out of date.
*/
if (flags & TCL_TRACE_READS) {
| | | 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 |
* When the variable is read, reset its value from our shared value. This
* is needed in case the variable was modified in some other interpreter
* so that this interpreter's value is out of date.
*/
if (flags & TCL_TRACE_READS) {
Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewLongObj(*precisionPtr),
flags & TCL_GLOBAL_ONLY);
return NULL;
}
/*
* The variable is being written. Check the new value and disallow it if
* it isn't reasonable or if this is a safe interpreter (we don't want
|
| ︙ | ︙ | |||
3642 3643 3644 3645 3646 3647 3648 |
bytes = Tcl_GetString(objPtr);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad index \"%s\": must be integer?[+-]integer? or"
" end?[+-]integer?", bytes));
if (!strncmp(bytes, "end-", 4)) {
bytes += 4;
}
| < | 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 |
bytes = Tcl_GetString(objPtr);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad index \"%s\": must be integer?[+-]integer? or"
" end?[+-]integer?", bytes));
if (!strncmp(bytes, "end-", 4)) {
bytes += 4;
}
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
3782 3783 3784 3785 3786 3787 3788 |
TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = offset;
objPtr->typePtr = &tclEndOffsetType;
return TCL_OK;
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 |
TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = offset;
objPtr->typePtr = &tclEndOffsetType;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ClearHash --
*
* Remove all the entries in the hash table *tablePtr.
|
| ︙ | ︙ | |||
4199 4200 4201 4202 4203 4204 4205 |
Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes);
if (numBytes == 0) {
return NULL;
}
return bytes;
}
| < < < < < < < < < < < < < < < < < < < < < < < < < | 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 |
Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes);
if (numBytes == 0) {
return NULL;
}
return bytes;
}
/*
*----------------------------------------------------------------------
*
* TclGetPlatform --
*
* This is a kludge that allows the test library to get access the
|
| ︙ | ︙ |
Changes to generic/tclVar.c.
| ︙ | ︙ | |||
145 146 147 148 149 150 151 |
/*
* The following structure describes an enumerative search in progress on an
* array variable; this are invoked with options to the "array" command.
*/
typedef struct ArraySearch {
| < | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 |
/*
* The following structure describes an enumerative search in progress on an
* array variable; this are invoked with options to the "array" command.
*/
typedef struct ArraySearch {
int id; /* Integer id used to distinguish among
* multiple concurrent searches for the same
* array. */
struct Var *varPtr; /* Pointer to array variable that's being
* searched. */
Tcl_HashSearch search; /* Info kept by the hash module about progress
* through the array. */
|
| ︙ | ︙ | |||
185 186 187 188 189 190 191 | const char *otherP2, const int otherFlags, Tcl_Obj *myNamePtr, int myFlags, int index); static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr, Tcl_Obj *varNamePtr, Tcl_Obj *handleObj); static void UnsetVarStruct(Var *varPtr, Var *arrayPtr, Interp *iPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, int index); | | > | 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 | const char *otherP2, const int otherFlags, Tcl_Obj *myNamePtr, int myFlags, int index); static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr, Tcl_Obj *varNamePtr, Tcl_Obj *handleObj); static void UnsetVarStruct(Var *varPtr, Var *arrayPtr, Interp *iPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, int index); static int SetArraySearchObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* * Functions defined in this file that may be exported in the future for use * by the bytecode compiler and engine or to the public interface. */ MODULE_SCOPE Var * TclLookupSimpleVar(Tcl_Interp *interp, |
| ︙ | ︙ | |||
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 |
* Types of Tcl_Objs used to cache variable lookups.
*
* localVarName - INTERNALREP DEFINITION:
* twoPtrValue.ptr1: pointer to name obj in varFramePtr->localCache
* or NULL if it is this same obj
* twoPtrValue.ptr2: index into locals table
*
* parsedVarName - INTERNALREP DEFINITION:
* twoPtrValue.ptr1: pointer to the array name Tcl_Obj, or NULL if it is a
* scalar variable
* twoPtrValue.ptr2: pointer to the element name string (owned by this
* Tcl_Obj), or NULL if it is a scalar variable
*/
static const Tcl_ObjType localVarNameType = {
"localVarName",
FreeLocalVarName, DupLocalVarName, NULL, NULL
};
static const Tcl_ObjType tclParsedVarNameType = {
"parsedVarName",
FreeParsedVarName, DupParsedVarName, NULL, NULL
};
Var *
TclVarHashCreateVar(
TclVarHashTable *tablePtr,
const char *key,
int *newPtr)
{
| > > > > > > > > > > > > > > > > > > > > | 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 |
* Types of Tcl_Objs used to cache variable lookups.
*
* localVarName - INTERNALREP DEFINITION:
* twoPtrValue.ptr1: pointer to name obj in varFramePtr->localCache
* or NULL if it is this same obj
* twoPtrValue.ptr2: index into locals table
*
* nsVarName - INTERNALREP DEFINITION:
* twoPtrValue.ptr1: pointer to the namespace containing the reference
* twoPtrValue.ptr2: pointer to the corresponding Var
*
* parsedVarName - INTERNALREP DEFINITION:
* twoPtrValue.ptr1: pointer to the array name Tcl_Obj, or NULL if it is a
* scalar variable
* twoPtrValue.ptr2: pointer to the element name string (owned by this
* Tcl_Obj), or NULL if it is a scalar variable
*/
static const Tcl_ObjType localVarNameType = {
"localVarName",
FreeLocalVarName, DupLocalVarName, NULL, NULL
};
static const Tcl_ObjType tclParsedVarNameType = {
"parsedVarName",
FreeParsedVarName, DupParsedVarName, NULL, NULL
};
/*
* Type of Tcl_Objs used to speed up array searches.
*
* INTERNALREP DEFINITION:
* twoPtrValue.ptr1: searchIdNumber (cast to pointer)
* twoPtrValue.ptr2: variableNameStartInString (cast to pointer)
*
* Note that the value stored in ptr2 is the offset into the string of the
* start of the variable name and not the address of the variable name itself,
* as this can be safely copied.
*/
const Tcl_ObjType tclArraySearchType = {
"array search",
NULL, NULL, NULL, SetArraySearchObj
};
Var *
TclVarHashCreateVar(
TclVarHashTable *tablePtr,
const char *key,
int *newPtr)
{
|
| ︙ | ︙ | |||
1044 1045 1046 1047 1048 1049 1050 |
}
return varPtr;
}
/*
*----------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 |
}
return varPtr;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetVar2 --
*
* Return the value of a Tcl variable as a string, given a two-part name
* consisting of array name and element within array.
*
* Results:
* The return value points to the current value of the variable given by
|
| ︙ | ︙ | |||
1381 1382 1383 1384 1385 1386 1387 |
Tcl_SetObjResult(interp, varValueObj);
return TCL_OK;
} else {
Tcl_WrongNumArgs(interp, 1, objv, "varName ?newValue?");
return TCL_ERROR;
}
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 |
Tcl_SetObjResult(interp, varValueObj);
return TCL_OK;
} else {
Tcl_WrongNumArgs(interp, 1, objv, "varName ?newValue?");
return TCL_ERROR;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetVar2 --
*
* Given a two-part variable name, which may refer either to a scalar
|
| ︙ | ︙ | |||
1949 1950 1951 1952 1953 1954 1955 |
}
varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
flags, index);
if (TclIsVarInHash(varPtr)) {
VarHashRefCount(varPtr)--;
}
if (varValuePtr == NULL) {
| | | 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 |
}
varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
flags, index);
if (TclIsVarInHash(varPtr)) {
VarHashRefCount(varPtr)--;
}
if (varValuePtr == NULL) {
varValuePtr = Tcl_NewLongObj(0);
}
if (Tcl_IsShared(varValuePtr)) {
/* Copy on write */
varValuePtr = Tcl_DuplicateObj(varValuePtr);
if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
|
| ︙ | ︙ | |||
1980 1981 1982 1983 1984 1985 1986 |
return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
varValuePtr, flags, index);
} else {
return NULL;
}
}
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 |
return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
varValuePtr, flags, index);
} else {
return NULL;
}
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_UnsetVar2 --
*
* Delete a variable, given a 2-part name.
|
| ︙ | ︙ | |||
2843 2844 2845 2846 2847 2848 2849 | * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ | < | | > > | > > > > > | | > > > > > | > | | > < < < < < < < < < < < < < < < < < < < < < < < < < < | 2722 2723 2724 2725 2726 2727 2728 2729 2730 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 |
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static int
ArrayStartSearchCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
Tcl_HashEntry *hPtr;
Tcl_Obj *varNameObj;
int isNew;
ArraySearch *searchPtr;
const char *varName;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
return TCL_ERROR;
}
varNameObj = objv[1];
/*
* Locate the array variable.
*/
varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
varName = TclGetString(varNameObj);
/*
* Special array trace used to keep the env array in sync for array names,
* array get, etc.
*/
if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
}
/*
* Verify that it is indeed an array variable. This test comes after the
* traces - the variable may actually become an array as an effect of said
* traces.
*/
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" isn't an array", varName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
return TCL_ERROR;
}
/*
* Make a new array search with a free name.
*/
|
| ︙ | ︙ | |||
2931 2932 2933 2934 2935 2936 2937 |
searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
}
searchPtr->varPtr = varPtr;
searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
&searchPtr->search);
Tcl_SetHashValue(hPtr, searchPtr);
| < < | > | 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 |
searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
}
searchPtr->varPtr = varPtr;
searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
&searchPtr->search);
Tcl_SetHashValue(hPtr, searchPtr);
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("s-%d-%s", searchPtr->id, varName));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ArrayAnyMoreCmd --
|
| ︙ | ︙ | |||
2963 2964 2965 2966 2967 2968 2969 |
ArrayAnyMoreCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
| | > > > > | > > > > > > > > > > > > > > > > > > > > > > | > > > > > | 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 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 2880 2881 2882 2883 2884 2885 2886 |
ArrayAnyMoreCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
Tcl_Obj *varNameObj, *searchObj;
int gotValue;
ArraySearch *searchPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
return TCL_ERROR;
}
varNameObj = objv[1];
searchObj = objv[2];
/*
* Locate the array variable.
*/
varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
/*
* Special array trace used to keep the env array in sync for array names,
* array get, etc.
*/
if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
}
/*
* Verify that it is indeed an array variable. This test comes after the
* traces - the variable may actually become an array as an effect of said
* traces.
*/
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" isn't an array", TclGetString(varNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
TclGetString(varNameObj), NULL);
return TCL_ERROR;
}
/*
* Get the search.
*/
|
| ︙ | ︙ | |||
3038 3039 3040 3041 3042 3043 3044 |
static int
ArrayNextElementCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
| > | > > > > | > > > > > > > > > > > > > > > > > > > > > > | > > > > > | 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 |
static int
ArrayNextElementCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
Tcl_Obj *varNameObj, *searchObj;
ArraySearch *searchPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
return TCL_ERROR;
}
varNameObj = objv[1];
searchObj = objv[2];
/*
* Locate the array variable.
*/
varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
/*
* Special array trace used to keep the env array in sync for array names,
* array get, etc.
*/
if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
}
/*
* Verify that it is indeed an array variable. This test comes after the
* traces - the variable may actually become an array as an effect of said
* traces.
*/
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" isn't an array", TclGetString(varNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
TclGetString(varNameObj), NULL);
return TCL_ERROR;
}
/*
* Get the search.
*/
|
| ︙ | ︙ | |||
3116 3117 3118 3119 3120 3121 3122 |
ArrayDoneSearchCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
| | > > > > | > > > > > > > > > > > > > > > > > > > > > > | > > > > > | 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 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 |
ArrayDoneSearchCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
Tcl_HashEntry *hPtr;
Tcl_Obj *varNameObj, *searchObj;
ArraySearch *searchPtr, *prevPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
return TCL_ERROR;
}
varNameObj = objv[1];
searchObj = objv[2];
/*
* Locate the array variable.
*/
varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
/*
* Special array trace used to keep the env array in sync for array names,
* array get, etc.
*/
if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
}
/*
* Verify that it is indeed an array variable. This test comes after the
* traces - the variable may actually become an array as an effect of said
* traces.
*/
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" isn't an array", TclGetString(varNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
TclGetString(varNameObj), NULL);
return TCL_ERROR;
}
/*
* Get the search.
*/
|
| ︙ | ︙ | |||
3163 3164 3165 3166 3167 3168 3169 |
for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
if (prevPtr->nextPtr == searchPtr) {
prevPtr->nextPtr = searchPtr->nextPtr;
break;
}
}
}
| < | 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 |
for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
if (prevPtr->nextPtr == searchPtr) {
prevPtr->nextPtr = searchPtr->nextPtr;
break;
}
}
}
ckfree(searchPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
3487 3488 3489 3490 3491 3492 3493 |
}
}
/*
* Finish parsing the arguments.
*/
| | | | 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 |
}
}
/*
* Finish parsing the arguments.
*/
if ((objc == 4) && Tcl_GetIndexFromObjStruct(interp, objv[2], options,
sizeof(char *), "option", 0, &mode) != TCL_OK) {
return TCL_ERROR;
}
/*
* Verify that it is indeed an array variable. This test comes after the
* traces - the variable may actually become an array as an effect of said
* traces. If not an array, the result is empty.
|
| ︙ | ︙ | |||
3747 3748 3749 3750 3751 3752 3753 |
varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
if (!TclIsVarUndefined(varPtr2)) {
size++;
}
}
}
| | | 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 |
varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
if (!TclIsVarUndefined(varPtr2)) {
size++;
}
}
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(size));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ArrayStatsCmd --
|
| ︙ | ︙ | |||
4298 4299 4300 4301 4302 4303 4304 |
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 |
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_UpVar2 --
*
* This function links one variable to another, just like the "upvar"
* command.
*
* Results:
* A standard Tcl completion code. If an error occurs then an error
|
| ︙ | ︙ | |||
4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 |
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ParseSearchId --
*
* This function translates from a tcl object to a pointer to an active
* array search (if there is one that matches the string).
*
* Results:
* The return value is a pointer to the array search indicated by string,
* or NULL if there isn't one. If NULL is returned, the interp's result
* contains an error message.
*
*----------------------------------------------------------------------
*/
static ArraySearch *
ParseSearchId(
Tcl_Interp *interp, /* Interpreter containing variable. */
const Var *varPtr, /* Array variable search is for. */
Tcl_Obj *varNamePtr, /* Name of array variable that search is
* supposed to be for. */
Tcl_Obj *handleObj) /* Object containing id of search. Must have
* form "search-num-var" where "num" is a
* decimal number and "var" is a variable
* name. */
{
Interp *iPtr = (Interp *) interp;
ArraySearch *searchPtr;
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | > > > > > > > > > > > > > > > > > > > > < | < < < < < | < < < < < | < < < < < < < | < > | | 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 |
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* SetArraySearchObj --
*
* This function converts the given tcl object into one that has the
* "array search" internal type.
*
* Results:
* TCL_OK if the conversion succeeded, and TCL_ERROR if it failed (when
* an error message will be placed in the interpreter's result.)
*
* Side effects:
* Updates the internal type and representation of the object to make
* this an array-search object. See the tclArraySearchType declaration
* above for details of the internal representation.
*
*----------------------------------------------------------------------
*/
static int
SetArraySearchObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr)
{
const char *string;
char *end; /* Can't be const due to strtoul defn. */
int id;
size_t offset;
/*
* Get the string representation. Make it up-to-date if necessary.
*/
string = TclGetString(objPtr);
/*
* Parse the id into the three parts separated by dashes.
*/
if ((string[0] != 's') || (string[1] != '-')) {
goto syntax;
}
id = strtoul(string+2, &end, 10);
if ((end == (string+2)) || (*end != '-')) {
goto syntax;
}
/*
* Can't perform value check in this context, so place reference to place
* in string to use for the check in the object instead.
*/
end++;
offset = end - string;
TclFreeIntRep(objPtr);
objPtr->typePtr = &tclArraySearchType;
objPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(id);
objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(offset);
return TCL_OK;
syntax:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"illegal search identifier \"%s\"", string));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* ParseSearchId --
*
* This function translates from a tcl object to a pointer to an active
* array search (if there is one that matches the string).
*
* Results:
* The return value is a pointer to the array search indicated by string,
* or NULL if there isn't one. If NULL is returned, the interp's result
* contains an error message.
*
* Side effects:
* The tcl object might have its internal type and representation
* modified.
*
*----------------------------------------------------------------------
*/
static ArraySearch *
ParseSearchId(
Tcl_Interp *interp, /* Interpreter containing variable. */
const Var *varPtr, /* Array variable search is for. */
Tcl_Obj *varNamePtr, /* Name of array variable that search is
* supposed to be for. */
Tcl_Obj *handleObj) /* Object containing id of search. Must have
* form "search-num-var" where "num" is a
* decimal number and "var" is a variable
* name. */
{
Interp *iPtr = (Interp *) interp;
register const char *string;
register size_t offset;
int id;
ArraySearch *searchPtr;
const char *varName = TclGetString(varNamePtr);
/*
* Parse the id.
*/
if ((handleObj->typePtr != &tclArraySearchType)
&& (SetArraySearchObj(interp, handleObj) != TCL_OK)) {
return NULL;
}
/*
* Extract the information out of the Tcl_Obj.
*/
id = PTR2INT(handleObj->internalRep.twoPtrValue.ptr1);
string = TclGetString(handleObj);
offset = PTR2INT(handleObj->internalRep.twoPtrValue.ptr2);
/*
* This test cannot be placed inside the Tcl_Obj machinery, since it is
* dependent on the variable context.
*/
if (strcmp(string+offset, varName) != 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"search identifier \"%s\" isn't for variable \"%s\"",
string, varName));
goto badLookup;
}
/*
* Search through the list of active searches on the interpreter to see if
* the desired one exists.
*
* Note that we cannot store the searchPtr directly in the Tcl_Obj as that
* would run into trouble when DeleteSearches() was called so we must scan
* this list every time.
*/
if (varPtr->flags & VAR_SEARCH_ACTIVE) {
Tcl_HashEntry *hPtr =
Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
searchPtr = searchPtr->nextPtr) {
if (searchPtr->id == id) {
return searchPtr;
}
}
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't find search \"%s\"", string));
badLookup:
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
return NULL;
}
/*
*----------------------------------------------------------------------
*
* DeleteSearches --
|
| ︙ | ︙ | |||
4899 4900 4901 4902 4903 4904 4905 |
Tcl_HashEntry *sPtr;
if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
searchPtr = nextPtr) {
nextPtr = searchPtr->nextPtr;
| < | 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 |
Tcl_HashEntry *sPtr;
if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
searchPtr = nextPtr) {
nextPtr = searchPtr->nextPtr;
ckfree(searchPtr);
}
arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
Tcl_DeleteHashEntry(sPtr);
}
}
|
| ︙ | ︙ | |||
5028 5029 5030 5031 5032 5033 5034 |
void
TclDeleteVars(
Interp *iPtr, /* Interpreter to which variables belong. */
TclVarHashTable *tablePtr) /* Hash table containing variables to
* delete. */
{
| < | > > > | > > > > > > | | > | > > > | > | > | < | < > | | > | | | > > | > | 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 |
void
TclDeleteVars(
Interp *iPtr, /* Interpreter to which variables belong. */
TclVarHashTable *tablePtr) /* Hash table containing variables to
* delete. */
{
Tcl_HashSearch search;
register Var *varPtr;
for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
varPtr = VarHashFirstVar(tablePtr, &search)) {
VarHashRefCount(varPtr)++;
UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr),
NULL, TCL_TRACE_UNSETS, -1);
if (TclIsVarTraced(varPtr)) {
Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
VarTrace *tracePtr = Tcl_GetHashValue(tPtr);
ActiveVarTrace *activePtr;
while (tracePtr) {
VarTrace *prevPtr = tracePtr;
tracePtr = tracePtr->nextPtr;
prevPtr->nextPtr = NULL;
Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
}
Tcl_DeleteHashEntry(tPtr);
varPtr->flags &= ~VAR_ALL_TRACES;
for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == varPtr) {
activePtr->nextTracePtr = NULL;
}
}
}
if (!TclIsVarUndefined(varPtr)) {
UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr),
NULL, TCL_TRACE_UNSETS, -1);
}
VarHashRefCount(varPtr)--;
VarHashDeleteEntry(varPtr);
}
VarHashDeleteTable(tablePtr);
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ |
Changes to generic/tclZlib.c.
| ︙ | ︙ | |||
369 370 371 372 373 374 375 |
/*
* Catch-all. Should be unreachable because all cases are already
* listed above.
*/
default:
TclNewLiteralStringObj(objv[2], "UNKNOWN");
| | | 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 |
/*
* Catch-all. Should be unreachable because all cases are already
* listed above.
*/
default:
TclNewLiteralStringObj(objv[2], "UNKNOWN");
TclNewLongObj(objv[3], code);
return Tcl_NewListObj(4, objv);
}
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
543 544 545 546 547 548 549 |
}
}
Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1,
&tmp);
SetValue(dictObj, "comment", TclDStringToObj(&tmp));
}
| | | | 543 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 |
}
}
Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1,
&tmp);
SetValue(dictObj, "comment", TclDStringToObj(&tmp));
}
SetValue(dictObj, "crc", Tcl_NewLongObj(headerPtr->hcrc!=0));
if (headerPtr->name != Z_NULL) {
if (latin1enc == NULL) {
/*
* RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
*/
latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
if (latin1enc == NULL) {
Tcl_Panic("no latin-1 encoding");
}
}
Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1,
&tmp);
SetValue(dictObj, "filename", TclDStringToObj(&tmp));
}
if (headerPtr->os != 255) {
SetValue(dictObj, "os", Tcl_NewLongObj(headerPtr->os));
}
if (headerPtr->time != 0 /* magic - no time */) {
SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time));
}
if (headerPtr->text != Z_UNKNOWN) {
SetValue(dictObj, "type",
Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1));
|
| ︙ | ︙ | |||
2613 2614 2615 2616 2617 2618 2619 |
}
return Tcl_ZlibStreamClose(zstream);
case zs_eof: /* $strm eof */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
| | | 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 |
}
return Tcl_ZlibStreamClose(zstream);
case zs_eof: /* $strm eof */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_ZlibStreamEof(zstream)));
return TCL_OK;
case zs_checksum: /* $strm checksum */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
|
| ︙ | ︙ | |||
3910 3911 3912 3913 3914 3915 3916 |
cfg[1].key = NULL;
Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1");
/*
* Formally provide the package as a Tcl built-in.
*/
| | | 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 |
cfg[1].key = NULL;
Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1");
/*
* Formally provide the package as a Tcl built-in.
*/
return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL);
}
/*
*----------------------------------------------------------------------
* Stubs used when a suitable zlib installation was not found during
* configure.
*----------------------------------------------------------------------
|
| ︙ | ︙ |
Changes to library/init.tcl.
| ︙ | ︙ | |||
12 13 14 15 16 17 18 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# This test intentionally written in pre-7.5 Tcl
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
| | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# This test intentionally written in pre-7.5 Tcl
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
package require -exact Tcl 9.0a0
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
#
# The environment variable TCLLIBPATH
#
# tcl_library, which is the directory containing this init.tcl script.
|
| ︙ | ︙ |
Changes to library/msgcat/pkgIndex.tcl.
|
| | | 1 2 |
if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
package ifneeded msgcat 1.6.0 [list source [file join $dir msgcat.tcl]]
|
Changes to library/opt/optparse.tcl.
1 2 3 4 5 6 7 8 9 10 | # optparse.tcl -- # # (private) Option parsing package # Primarily used internally by the safe:: code. # # WARNING: This code will go away in a future release # of Tcl. It is NOT supported and you should not rely # on it. If your code does rely on this package you # may directly incorporate this code into your application. | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
# optparse.tcl --
#
# (private) Option parsing package
# Primarily used internally by the safe:: code.
#
# WARNING: This code will go away in a future release
# of Tcl. It is NOT supported and you should not rely
# on it. If your code does rely on this package you
# may directly incorporate this code into your application.
package require Tcl 8.2-
# When this version number changes, update the pkgIndex.tcl file
# and the install directory in the Makefiles.
package provide opt 0.4.6
namespace eval ::tcl {
# Exported APIs
|
| ︙ | ︙ |
Changes to library/opt/pkgIndex.tcl.
1 2 3 4 5 6 7 8 9 10 | # Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. | | | 1 2 3 4 5 6 7 8 9 10 11 12 |
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex -direct" command
# and sourced either when an application starts up or
# by a "package unknown" script. It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands. When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.2-]} {return}
package ifneeded opt 0.4.6 [list source [file join $dir optparse.tcl]]
|
Changes to library/package.tcl.
| ︙ | ︙ | |||
133 134 135 136 137 138 139 140 141 142 143 144 145 146 |
try {
set fileList [glob -directory $dir -tails -types {r f} -- \
{*}$patternList]
} on error {msg opt} {
return -options $opt $msg
}
foreach file $fileList {
# For each file, figure out what commands and packages it provides.
# To do this, create a child interpreter, load the file into the
# interpreter, and get a list of the new commands and packages that
# are defined.
if {$file eq "pkgIndex.tcl"} {
| > > > | 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 |
try {
set fileList [glob -directory $dir -tails -types {r f} -- \
{*}$patternList]
} on error {msg opt} {
return -options $opt $msg
}
if {[llength $fileList] == 0} {
return -code error "no files matched glob pattern \"$patternList\""
}
foreach file $fileList {
# For each file, figure out what commands and packages it provides.
# To do this, create a child interpreter, load the file into the
# interpreter, and get a list of the new commands and packages that
# are defined.
if {$file eq "pkgIndex.tcl"} {
|
| ︙ | ︙ |
Changes to library/tcltest/pkgIndex.tcl.
1 2 3 4 5 6 7 8 9 10 | # Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. | | | 1 2 3 4 5 6 7 8 9 10 11 12 |
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex -direct" command
# and sourced either when an application starts up or
# by a "package unknown" script. It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands. When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
package ifneeded tcltest 2.4.0 [list source [file join $dir tcltest.tcl]]
|
Deleted library/tzdata/SystemV/AST4.
|
| < < < < < |
Deleted library/tzdata/SystemV/AST4ADT.
|
| < < < < < |
Deleted library/tzdata/SystemV/CST6.
|
| < < < < < |
Deleted library/tzdata/SystemV/CST6CDT.
|
| < < < < < |
Deleted library/tzdata/SystemV/EST5.
|
| < < < < < |
Deleted library/tzdata/SystemV/EST5EDT.
|
| < < < < < |
Deleted library/tzdata/SystemV/HST10.
|
| < < < < < |
Deleted library/tzdata/SystemV/MST7.
|
| < < < < < |
Deleted library/tzdata/SystemV/MST7MDT.
|
| < < < < < |
Deleted library/tzdata/SystemV/PST8.
|
| < < < < < |
Deleted library/tzdata/SystemV/PST8PDT.
|
| < < < < < |
Deleted library/tzdata/SystemV/YST9.
|
| < < < < < |
Deleted library/tzdata/SystemV/YST9YDT.
|
| < < < < < |
Changes to macosx/Tcl-Common.xcconfig.
| ︙ | ︙ | |||
30 31 32 33 34 35 36 | PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc) PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64) PREFIX = /usr/local TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION) TCL_PACKAGE_PATH = "$(LIBDIR)" TCL_DEFS = HAVE_TCL_CONFIG_H | | | 30 31 32 33 34 35 36 37 | PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc) PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64) PREFIX = /usr/local TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION) TCL_PACKAGE_PATH = "$(LIBDIR)" TCL_DEFS = HAVE_TCL_CONFIG_H VERSION = 9.0 |
Changes to macosx/Tcl.xcode/project.pbxproj.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 |
F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; };
F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; };
F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; };
F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; };
F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; };
F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; };
F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; };
| < | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; };
F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; };
F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; };
F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; };
F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; };
F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; };
F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; };
F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; };
F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; };
F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; };
F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F966C07408F2820D005CB29B /* CoreFoundation.framework */; };
F96D456F08F272BB004A47F5 /* regcomp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED008F272A7004A47F5 /* regcomp.c */; };
F96D457208F272BB004A47F5 /* regerror.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED308F272A7004A47F5 /* regerror.c */; };
F96D457508F272BB004A47F5 /* regexec.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED608F272A7004A47F5 /* regexec.c */; };
|
| ︙ | ︙ | |||
205 206 207 208 209 210 211 |
F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = "<group>"; };
F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = "<group>"; };
F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = "<group>"; };
F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = "<group>"; };
F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; };
F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; };
F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; };
| < | 204 205 206 207 208 209 210 211 212 213 214 215 216 217 |
F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = "<group>"; };
F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = "<group>"; };
F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = "<group>"; };
F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = "<group>"; };
F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; };
F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; };
F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; };
F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = "<group>"; };
F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = "<group>"; };
F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = "<group>"; };
F93599D20DF1F8DF00E04F67 /* copy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = copy.n; sourceTree = "<group>"; };
F93599D30DF1F8F500E04F67 /* define.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = define.n; sourceTree = "<group>"; };
F93599D40DF1F91900E04F67 /* Method.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Method.3; sourceTree = "<group>"; };
F93599D50DF1F93700E04F67 /* my.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = my.n; sourceTree = "<group>"; };
|
| ︙ | ︙ | |||
1284 1285 1286 1287 1288 1289 1290 | F93599BA0DF1F76A00E04F67 /* tclOODecls.h */, F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */, F93599BD0DF1F77400E04F67 /* tclOOInfo.c */, F93599BF0DF1F77900E04F67 /* tclOOInt.h */, F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, F93599C10DF1F78300E04F67 /* tclOOMethod.c */, F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, | < | 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 | F93599BA0DF1F76A00E04F67 /* tclOODecls.h */, F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */, F93599BD0DF1F77400E04F67 /* tclOOInfo.c */, F93599BF0DF1F77900E04F67 /* tclOOInt.h */, F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, F93599C10DF1F78300E04F67 /* tclOOMethod.c */, F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, F96D3F0E08F272A7004A47F5 /* tclPanic.c */, F96D3F0F08F272A7004A47F5 /* tclParse.c */, F96D3F1108F272A7004A47F5 /* tclPathObj.c */, F96D3F1208F272A7004A47F5 /* tclPipe.c */, F96D3F1308F272A7004A47F5 /* tclPkg.c */, F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */, F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */, |
| ︙ | ︙ | |||
2017 2018 2019 2020 2021 2022 2023 | F93599B30DF1F75400E04F67 /* tclOO.c in Sources */, F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */, F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */, F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */, F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, | < | 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 | F93599B30DF1F75400E04F67 /* tclOO.c in Sources */, F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */, F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */, F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */, F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */, F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */, F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */, F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */, F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */, F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */, F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */, |
| ︙ | ︙ |
Changes to macosx/Tcl.xcodeproj/project.pbxproj.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 |
F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; };
F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; };
F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; };
F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; };
F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; };
F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; };
F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; };
| < | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; };
F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; };
F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; };
F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; };
F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; };
F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; };
F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; };
F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; };
F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; };
F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; };
F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F966C07408F2820D005CB29B /* CoreFoundation.framework */; };
F96D456F08F272BB004A47F5 /* regcomp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED008F272A7004A47F5 /* regcomp.c */; };
F96D457208F272BB004A47F5 /* regerror.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED308F272A7004A47F5 /* regerror.c */; };
F96D457508F272BB004A47F5 /* regexec.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED608F272A7004A47F5 /* regexec.c */; };
|
| ︙ | ︙ | |||
205 206 207 208 209 210 211 |
F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = "<group>"; };
F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = "<group>"; };
F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = "<group>"; };
F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = "<group>"; };
F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; };
F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; };
F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; };
| < | 204 205 206 207 208 209 210 211 212 213 214 215 216 217 |
F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = "<group>"; };
F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = "<group>"; };
F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = "<group>"; };
F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = "<group>"; };
F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; };
F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; };
F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; };
F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = "<group>"; };
F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = "<group>"; };
F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = "<group>"; };
F93599D20DF1F8DF00E04F67 /* copy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = copy.n; sourceTree = "<group>"; };
F93599D30DF1F8F500E04F67 /* define.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = define.n; sourceTree = "<group>"; };
F93599D40DF1F91900E04F67 /* Method.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Method.3; sourceTree = "<group>"; };
F93599D50DF1F93700E04F67 /* my.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = my.n; sourceTree = "<group>"; };
|
| ︙ | ︙ | |||
1284 1285 1286 1287 1288 1289 1290 | F93599BA0DF1F76A00E04F67 /* tclOODecls.h */, F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */, F93599BD0DF1F77400E04F67 /* tclOOInfo.c */, F93599BF0DF1F77900E04F67 /* tclOOInt.h */, F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, F93599C10DF1F78300E04F67 /* tclOOMethod.c */, F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, | < | 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 | F93599BA0DF1F76A00E04F67 /* tclOODecls.h */, F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */, F93599BD0DF1F77400E04F67 /* tclOOInfo.c */, F93599BF0DF1F77900E04F67 /* tclOOInt.h */, F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, F93599C10DF1F78300E04F67 /* tclOOMethod.c */, F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, F96D3F0E08F272A7004A47F5 /* tclPanic.c */, F96D3F0F08F272A7004A47F5 /* tclParse.c */, F96D3F1108F272A7004A47F5 /* tclPathObj.c */, F96D3F1208F272A7004A47F5 /* tclPipe.c */, F96D3F1308F272A7004A47F5 /* tclPkg.c */, F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */, F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */, |
| ︙ | ︙ | |||
2017 2018 2019 2020 2021 2022 2023 | F93599B30DF1F75400E04F67 /* tclOO.c in Sources */, F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */, F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */, F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */, F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, | < | 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 | F93599B30DF1F75400E04F67 /* tclOO.c in Sources */, F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */, F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */, F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */, F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */, F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */, F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */, F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */, F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */, F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */, F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */, |
| ︙ | ︙ |
Changes to macosx/tclMacOSXFCmd.c.
| ︙ | ︙ | |||
188 189 190 191 192 193 194 |
OSSwapBigToHostInt32(finder->creator));
break;
case MACOSX_TYPE_ATTRIBUTE:
*attributePtrPtr = NewOSTypeObj(
OSSwapBigToHostInt32(finder->type));
break;
case MACOSX_HIDDEN_ATTRIBUTE:
| | | 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 |
OSSwapBigToHostInt32(finder->creator));
break;
case MACOSX_TYPE_ATTRIBUTE:
*attributePtrPtr = NewOSTypeObj(
OSSwapBigToHostInt32(finder->type));
break;
case MACOSX_HIDDEN_ATTRIBUTE:
*attributePtrPtr = Tcl_NewLongObj(
(finder->fdFlags & kFinfoIsInvisible) != 0);
break;
case MACOSX_RSRCLENGTH_ATTRIBUTE:
*attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize);
break;
}
return TCL_OK;
|
| ︙ | ︙ |
Changes to pkgs/README.
| ︙ | ︙ | |||
35 36 37 38 39 40 41 |
TCLSH_PROG, TESTFLAGS variables.
clean: Delete all files generated by the default build target.
distclean: Delete all generated files.
dist: Produce a copy of the package's source code distribution.
| | | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 |
TCLSH_PROG, TESTFLAGS variables.
clean: Delete all files generated by the default build target.
distclean: Delete all generated files.
dist: Produce a copy of the package's source code distribution.
Must respect the DIST_ROOT variable determing where to
write the generated directory.
Packages that are written to make use of the Tcl Extension Architecture (TEA)
and that make use of the tclconfig collection of support files, should
conform to these conventions without further efforts.
These conventions are subject to revision and refinement over time to
|
| ︙ | ︙ |
Changes to tests/assemble.test.
| ︙ | ︙ | |||
777 778 779 780 781 782 783 |
test assemble-7.43 {uplus} {
-body {
assemble {
push NaN; uplus
}
}
-returnCodes error
| | | 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 |
test assemble-7.43 {uplus} {
-body {
assemble {
push NaN; uplus
}
}
-returnCodes error
-result {can't use non-numeric floating-point value "NaN" as operand of "+"}
}
test assemble-7.43.1 {tryCvtToNumeric} {
-body {
assemble {
push NaN; tryCvtToNumeric
}
}
|
| ︙ | ︙ |
Deleted tests/case.test.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to tests/cmdAH.test.
| ︙ | ︙ | |||
55 56 57 58 59 60 61 |
test cmdAH-0.1 {Tcl_BreakObjCmd, errors} -body {
break foo
} -returnCodes error -result {wrong # args: should be "break"}
test cmdAH-0.2 {Tcl_BreakObjCmd, success} {
list [catch {break} msg] $msg
} {3 {}}
| < < | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 |
test cmdAH-0.1 {Tcl_BreakObjCmd, errors} -body {
break foo
} -returnCodes error -result {wrong # args: should be "break"}
test cmdAH-0.2 {Tcl_BreakObjCmd, success} {
list [catch {break} msg] $msg
} {3 {}}
test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
catch
} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
list [catch {catch foo bar baz} msg] $msg
} {0 1}
test cmdAH-1.3 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
|
| ︙ | ︙ |
Changes to tests/compExpr-old.test.
| ︙ | ︙ | |||
14 15 16 17 18 19 20 |
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
| < < < < < < < | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
# Big test for correct ordering of data in [expr]
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
|
| ︙ | ︙ | |||
281 282 283 284 285 286 287 |
expr 2***3|6
} -returnCodes error -match glob -result *
test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
expr 2^x
} -returnCodes error -match glob -result *
test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {24.0^3}} msg] $msg
| | | | | | 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 |
expr 2***3|6
} -returnCodes error -match glob -result *
test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
expr 2^x
} -returnCodes error -match glob -result *
test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {24.0^3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "^"}}
test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {"a"^"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "^"}}
test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
test compExpr-old-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
test compExpr-old-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
test compExpr-old-7.5 {CompileBitAndExpr: error in equality expr} -body {
expr x==3
} -returnCodes error -match glob -result *
test compExpr-old-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
test compExpr-old-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
test compExpr-old-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
test compExpr-old-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
test compExpr-old-7.10 {CompileBitAndExpr: error compiling bitand arm} -body {
expr 2***3&6
} -returnCodes error -match glob -result *
test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
expr 2&x
} -returnCodes error -match glob -result *
test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {24.0&3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "&"}}
test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "&"}}
test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1
test compExpr-old-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1
test compExpr-old-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0
test compExpr-old-8.5 {CompileEqualityExpr: error in relational expr} -body {
expr x>3
|
| ︙ | ︙ | |||
373 374 375 376 377 378 379 |
expr 2***3>>6
} -returnCodes error -match glob -result *
test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body {
expr 2<<x
} -returnCodes error -match glob -result *
test compExpr-old-10.10 {CompileShiftExpr: runtime error} {
list [catch {expr {24.0>>43}} msg] $msg
| | | | | | 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 |
expr 2***3>>6
} -returnCodes error -match glob -result *
test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body {
expr 2<<x
} -returnCodes error -match glob -result *
test compExpr-old-10.10 {CompileShiftExpr: runtime error} {
list [catch {expr {24.0>>43}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
test compExpr-old-10.11 {CompileShiftExpr: runtime error} {
list [catch {expr {"a"<<"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "<<"}}
test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
test compExpr-old-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
test compExpr-old-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6
test compExpr-old-11.5 {CompileAddExpr: error in multiply expr} -body {
expr x*3
} -returnCodes error -match glob -result *
test compExpr-old-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
test compExpr-old-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
test compExpr-old-11.8 {CompileAddExpr: error compiling add arm} -body {
expr 2***3+6
} -returnCodes error -match glob -result *
test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body {
expr 2-x
} -returnCodes error -match glob -result *
test compExpr-old-11.10 {CompileAddExpr: runtime error} {
list [catch {expr {24.0+"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
test compExpr-old-11.11 {CompileAddExpr: runtime error} {
list [catch {expr {"a"-"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
test compExpr-old-11.12 {CompileAddExpr: runtime error} {
list [catch {expr {3/0}} msg] $msg
} {1 {divide by zero}}
test compExpr-old-11.13a {CompileAddExpr: runtime error} ieeeFloatingPoint {
list [catch {expr {2.3/0.0}} msg] $msg
} {0 Inf}
test compExpr-old-11.13b {CompileAddExpr: runtime error} !ieeeFloatingPoint {
|
| ︙ | ︙ | |||
426 427 428 429 430 431 432 |
expr 2*3%%6
} -returnCodes error -match glob -result *
test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
expr 2*x
} -returnCodes error -match glob -result *
test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} {
list [catch {expr {24.0*"xx"}} msg] $msg
| | | | | | 419 420 421 422 423 424 425 426 427 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 |
expr 2*3%%6
} -returnCodes error -match glob -result *
test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
expr 2*x
} -returnCodes error -match glob -result *
test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} {
list [catch {expr {24.0*"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "*"}}
test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} {
list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
test compExpr-old-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
test compExpr-old-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
test compExpr-old-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
test compExpr-old-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
test compExpr-old-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
test compExpr-old-13.8 {CompileUnaryExpr: error compiling unary expr} -body {
expr ~x
} -returnCodes error -match glob -result *
test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
expr !1.x
set msg
} -returnCodes error -match glob -result *
test compExpr-old-13.10 {CompileUnaryExpr: runtime error} {
list [catch {expr {~"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "~"}}
test compExpr-old-13.11 {CompileUnaryExpr: runtime error} {
list [catch {expr ~4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "~"}}
test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} {
set a 27
expr $a
} 27
test compExpr-old-13.14 {CompileUnaryExpr: just primary expr} {
expr double(27)
|
| ︙ | ︙ | |||
598 599 600 601 602 603 604 |
set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr pow(1)"}
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
expr sin(1
} -returnCodes error -match glob -result *
| < < < < < < < < < < < < < < < | 591 592 593 594 595 596 597 598 599 600 601 602 603 604 |
set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr pow(1)"}
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
expr sin(1
} -returnCodes error -match glob -result *
test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
catch {unset a}
set a(VALUE) ff15
set i 123
if {[expr 0x$a(VALUE)] & 16} {
set i {}
|
| ︙ | ︙ |
Changes to tests/compExpr.test.
| ︙ | ︙ | |||
10 11 12 13 14 15 16 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
| < < < < < < < | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
# Constrain memory leak tests
testConstraint memory [llength [info commands memory]]
catch {unset a}
test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {
|
| ︙ | ︙ | |||
315 316 317 318 319 320 321 |
test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
format %.6g [expr atan2(1.0, 2.0)]
} 0.463648
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
expr {do_it()}
} -returnCodes error -match glob -result {* "*do_it"}
| < < < < < < | 308 309 310 311 312 313 314 315 316 317 318 319 320 321 |
test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
format %.6g [expr atan2(1.0, 2.0)]
} 0.463648
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
expr {do_it()}
} -returnCodes error -match glob -result {* "*do_it"}
test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body {
expr {atan2(1.0)}
} -returnCodes error -match glob -result {too few arguments for math function*}
test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} {
format %.6g [expr pow(2.1, 27.5-(24.4*(5%2)))]
} 9.97424
test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body {
|
| ︙ | ︙ |
Changes to tests/compile.test.
| ︙ | ︙ | |||
319 320 321 322 323 324 325 |
}}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
apply {{} { set r [list foobar] ; string index a bogus }}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
apply {{} { set r [list foobar] ; string index a 0o9 }}
| | | 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 |
}}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
apply {{} { set r [list foobar] ; string index a bogus }}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
apply {{} { set r [list foobar] ; string index a 0o9 }}
} -returnCodes error -match glob -result {*}
test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
apply {{} { set r [list foobar] ; array set var {one two many} }}
} -returnCodes error -result {list must have an even number of elements}
test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
apply {{} { set r [list foobar] ; incr foo bar baz}}
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
|
| ︙ | ︙ |
Changes to tests/execute.test.
| ︙ | ︙ | |||
170 171 172 173 174 175 176 |
test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} {
set x [teststringobj set 0 1.0]
expr {$x + 1}
} 2.0
test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {$x + 1}} msg] $msg
| | | 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 |
test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} {
set x [teststringobj set 0 1.0]
expr {$x + 1}
} 2.0
test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {$x + 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "+"}}
test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
set x [testintobj set 0 1]
expr {1 + $x}
} 2
test execute-3.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} {
set x [testdoubleobj set 0 1]
expr {1 + $x}
|
| ︙ | ︙ | |||
195 196 197 198 199 200 201 |
test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} {
set x [teststringobj set 0 1.0]
expr {1 + $x}
} 2.0
test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {1 + $x}} msg] $msg
| | | 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 |
test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} {
set x [teststringobj set 0 1.0]
expr {1 + $x}
} 2.0
test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {1 + $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "+"}}
# INST_SUB is partially tested:
test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
set x [testintobj set 0 1]
expr {$x - 1}
} 0
test execute-3.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} {
|
| ︙ | ︙ | |||
222 223 224 225 226 227 228 |
test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} {
set x [teststringobj set 0 1.0]
expr {$x - 1}
} 0.0
test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {$x - 1}} msg] $msg
| | | 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 |
test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} {
set x [teststringobj set 0 1.0]
expr {$x - 1}
} 0.0
test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {$x - 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "-"}}
test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
set x [testintobj set 0 1]
expr {1 - $x}
} 0
test execute-3.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} {
set x [testdoubleobj set 0 1]
expr {1 - $x}
|
| ︙ | ︙ | |||
247 248 249 250 251 252 253 |
test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} {
set x [teststringobj set 0 1.0]
expr {1 - $x}
} 0.0
test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {1 - $x}} msg] $msg
| | | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 |
test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} {
set x [teststringobj set 0 1.0]
expr {1 - $x}
} 0.0
test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {1 - $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "-"}}
# INST_MULT is partially tested:
test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
set x [testintobj set 1 1]
expr {$x * 1}
} 1
test execute-3.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} {
|
| ︙ | ︙ | |||
274 275 276 277 278 279 280 |
test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {$x * 1}
} 1.0
test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {$x * 1}} msg] $msg
| | | 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 |
test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {$x * 1}
} 1.0
test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {$x * 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "*"}}
test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
set x [testintobj set 1 1]
expr {1 * $x}
} 1
test execute-3.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} {
set x [testdoubleobj set 1 2.0]
expr {1 * $x}
|
| ︙ | ︙ | |||
299 300 301 302 303 304 305 |
test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {1 * $x}
} 1.0
test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {1 * $x}} msg] $msg
| | | 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 |
test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {1 * $x}
} 1.0
test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {1 * $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "*"}}
# INST_DIV is partially tested:
test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
set x [testintobj set 1 1]
expr {$x / 1}
} 1
test execute-3.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} {
|
| ︙ | ︙ | |||
326 327 328 329 330 331 332 |
test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {$x / 1}
} 1.0
test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {$x / 1}} msg] $msg
| | | 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 |
test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {$x / 1}
} 1.0
test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {$x / 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "/"}}
test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
set x [testintobj set 1 1]
expr {2 / $x}
} 2
test execute-3.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} {
set x [testdoubleobj set 1 1.0]
expr {2 / $x}
|
| ︙ | ︙ | |||
351 352 353 354 355 356 357 |
test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {2 / $x}
} 2.0
test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {1 / $x}} msg] $msg
| | | 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 |
test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {2 / $x}
} 2.0
test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {1 / $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "/"}}
# INST_UPLUS is partially tested:
test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
set x [testintobj set 1 1]
expr {+ $x}
} 1
test execute-3.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} {
|
| ︙ | ︙ | |||
378 379 380 381 382 383 384 |
test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {+ $x}
} 1.0
test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {+ $x}} msg] $msg
| | | 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 |
test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {+ $x}
} 1.0
test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {+ $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "+"}}
# INST_UMINUS is partially tested:
test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
set x [testintobj set 1 1]
expr {- $x}
} -1
test execute-3.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} {
|
| ︙ | ︙ | |||
405 406 407 408 409 410 411 |
test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {- $x}
} -1.0
test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {- $x}} msg] $msg
| | | 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 |
test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {
set x [teststringobj set 1 1.0]
expr {- $x}
} -1.0
test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {- $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "-"}}
# INST_LNOT is partially tested:
test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
set x [testintobj set 1 2]
expr {! $x}
} 0
test execute-3.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
|
| ︙ | ︙ | |||
453 454 455 456 457 458 459 |
test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
set x [teststringobj set 1 0.0]
expr {! $x}
} 1
test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {! $x}} msg] $msg
| | | 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 |
test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
set x [teststringobj set 1 0.0]
expr {! $x}
} 1
test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {! $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "!"}}
# INST_BITNOT not tested
# INST_CALL_BUILTIN_FUNC1 not tested
# INST_CALL_FUNC1 not tested
# INST_TRY_CVT_TO_NUMERIC is partially tested:
test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} {
|
| ︙ | ︙ |
Changes to tests/expr-old.test.
| ︙ | ︙ | |||
20 21 22 23 24 25 26 |
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testexprlong [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
| < < < < < < | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testexprlong [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
# Big test for correct ordering of data in [expr]
proc testIEEE {} {
variable ieeeValues
binary scan [binary format dd -1.0 1.0] c* c
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
|
| ︙ | ︙ | |||
193 194 195 196 197 198 199 |
list [catch {expr 028.1 + 09.2} msg] $msg
} {0 37.3}
# Operators that aren't legal on floating-point numbers
test expr-old-3.1 {illegal floating-point operations} {
list [catch {expr ~4.0} msg] $msg
| | | | | | | | | | | | 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 |
list [catch {expr 028.1 + 09.2} msg] $msg
} {0 37.3}
# Operators that aren't legal on floating-point numbers
test expr-old-3.1 {illegal floating-point operations} {
list [catch {expr ~4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "~"}}
test expr-old-3.2 {illegal floating-point operations} {
list [catch {expr 27%4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "%"}}
test expr-old-3.3 {illegal floating-point operations} {
list [catch {expr 27.0%4} msg] $msg
} {1 {can't use floating-point value "27.0" as operand of "%"}}
test expr-old-3.4 {illegal floating-point operations} {
list [catch {expr 1.0<<3} msg] $msg
} {1 {can't use floating-point value "1.0" as operand of "<<"}}
test expr-old-3.5 {illegal floating-point operations} {
list [catch {expr 3<<1.0} msg] $msg
} {1 {can't use floating-point value "1.0" as operand of "<<"}}
test expr-old-3.6 {illegal floating-point operations} {
list [catch {expr 24.0>>3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
test expr-old-3.7 {illegal floating-point operations} {
list [catch {expr 24>>3.0} msg] $msg
} {1 {can't use floating-point value "3.0" as operand of ">>"}}
test expr-old-3.8 {illegal floating-point operations} {
list [catch {expr 24&3.0} msg] $msg
} {1 {can't use floating-point value "3.0" as operand of "&"}}
test expr-old-3.9 {illegal floating-point operations} {
list [catch {expr 24.0|3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "|"}}
test expr-old-3.10 {illegal floating-point operations} {
list [catch {expr 24.0^3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "^"}}
# Check the string operators individually.
test expr-old-4.1 {string operators} {expr {"abc" > "def"}} 0
test expr-old-4.2 {string operators} {expr {"def" > "def"}} 0
test expr-old-4.3 {string operators} {expr {"g" > "def"}} 1
test expr-old-4.4 {string operators} {expr {"abc" < "abd"}} 1
|
| ︙ | ︙ | |||
261 262 263 264 265 266 267 |
test expr-old-4.31 {string operators} {expr {1?"foo":"bar"}} foo
test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar
# Operators that aren't legal on string operands.
test expr-old-5.1 {illegal string operations} {
list [catch {expr {-"a"}} msg] $msg
| | | | | | | | | | | | | | | | 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 |
test expr-old-4.31 {string operators} {expr {1?"foo":"bar"}} foo
test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar
# Operators that aren't legal on string operands.
test expr-old-5.1 {illegal string operations} {
list [catch {expr {-"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
test expr-old-5.2 {illegal string operations} {
list [catch {expr {+"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
test expr-old-5.3 {illegal string operations} {
list [catch {expr {~"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "~"}}
test expr-old-5.4 {illegal string operations} {
list [catch {expr {!"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "!"}}
test expr-old-5.5 {illegal string operations} {
list [catch {expr {"a"*"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "*"}}
test expr-old-5.6 {illegal string operations} {
list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
test expr-old-5.7 {illegal string operations} {
list [catch {expr {"a"%"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "%"}}
test expr-old-5.8 {illegal string operations} {
list [catch {expr {"a"+"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
test expr-old-5.9 {illegal string operations} {
list [catch {expr {"a"-"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
test expr-old-5.10 {illegal string operations} {
list [catch {expr {"a"<<"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "<<"}}
test expr-old-5.11 {illegal string operations} {
list [catch {expr {"a">>"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of ">>"}}
test expr-old-5.12 {illegal string operations} {
list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "&"}}
test expr-old-5.13 {illegal string operations} {
list [catch {expr {"a"^"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "^"}}
test expr-old-5.14 {illegal string operations} {
list [catch {expr {"a"|"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "|"}}
test expr-old-5.15 {illegal string operations} {
list [catch {expr {"a"&&"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
test expr-old-5.16 {illegal string operations} {
list [catch {expr {"a"||"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
test expr-old-5.17 {illegal string operations} {
|
| ︙ | ︙ | |||
489 490 491 492 493 494 495 |
test expr-old-25.19 {type conversions} {expr 2.0e15} 2000000000000000.0
test expr-old-25.20 {type conversions} {expr 10.0} 10.0
# Various error conditions.
test expr-old-26.1 {error conditions} {
list [catch {expr 2+"a"} msg] $msg
| | | | | 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 |
test expr-old-25.19 {type conversions} {expr 2.0e15} 2000000000000000.0
test expr-old-25.20 {type conversions} {expr 10.0} 10.0
# Various error conditions.
test expr-old-26.1 {error conditions} {
list [catch {expr 2+"a"} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
test expr-old-26.2 {error conditions} -body {
expr 2+4*
} -returnCodes error -match glob -result *
test expr-old-26.3 {error conditions} -body {
expr 2+4*(
} -returnCodes error -match glob -result *
unset -nocomplain _non_existent_
test expr-old-26.4 {error conditions} {
list [catch {expr 2+$_non_existent_} msg] $msg
} {1 {can't read "_non_existent_": no such variable}}
set a xx
test expr-old-26.5 {error conditions} {
list [catch {expr {2+$a}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
test expr-old-26.6 {error conditions} {
list [catch {expr {2+[set a]}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
test expr-old-26.7 {error conditions} -body {
expr {2+(4}
} -returnCodes error -match glob -result *
test expr-old-26.8 {error conditions} {
list [catch {expr 2/0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.9 {error conditions} {
|
| ︙ | ︙ | |||
530 531 532 533 534 535 536 |
expr 2#
} -returnCodes error -match glob -result *
test expr-old-26.12 {error conditions} -body {
expr a.b
} -returnCodes error -match glob -result *
test expr-old-26.13 {error conditions} {
list [catch {expr {"a"/"b"}} msg] $msg
| | | 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 |
expr 2#
} -returnCodes error -match glob -result *
test expr-old-26.12 {error conditions} -body {
expr a.b
} -returnCodes error -match glob -result *
test expr-old-26.13 {error conditions} {
list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
test expr-old-26.14 {error conditions} -body {
expr 2:3
} -returnCodes error -match glob -result *
test expr-old-26.15 {error conditions} -body {
expr a@b
} -returnCodes error -match glob -result *
test expr-old-26.16 {error conditions} {
|
| ︙ | ︙ | |||
843 844 845 846 847 848 849 |
} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.41 {math functions in expressions} {
list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
} {0 16.0}
test expr-old-32.42 {math functions in expressions} {
list [catch {expr hypot(5*.8,3)} msg] $msg
} {0 5.0}
| < < < < < < | 837 838 839 840 841 842 843 844 845 846 847 848 849 850 |
} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.41 {math functions in expressions} {
list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
} {0 16.0}
test expr-old-32.42 {math functions in expressions} {
list [catch {expr hypot(5*.8,3)} msg] $msg
} {0 5.0}
test expr-old-32.45 {math functions in expressions} {
expr (0 <= rand()) && (rand() < 1)
} {1}
test expr-old-32.46 {math functions in expressions} -body {
list [catch {expr rand(24)} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-32.47 {math functions in expressions} -body {
|
| ︙ | ︙ | |||
948 949 950 951 952 953 954 |
} -5076964154930102272
test expr-old-34.15 {errors in math functions} {
expr round(1.0e30)
} 1000000000000000019884624838656
test expr-old-34.16 {errors in math functions} {
expr round(-1.0e30)
} -1000000000000000019884624838656
| < < < < | | 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 |
} -5076964154930102272
test expr-old-34.15 {errors in math functions} {
expr round(1.0e30)
} 1000000000000000019884624838656
test expr-old-34.16 {errors in math functions} {
expr round(-1.0e30)
} -1000000000000000019884624838656
test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
set x 0o289
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "0o289" as operand of "+"}}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
list [catch {expr 0289.1} msg] $msg
} {0 289.1}
test expr-old-36.4 {ExprLooksLikeInt procedure} {
set x 0289.1
list [catch {expr {$x+1}} msg] $msg
} {0 290.1}
|
| ︙ | ︙ | |||
999 1000 1001 1002 1003 1004 1005 |
expr {$x+1}
} 665802003400000000000001
# tests for [Bug #587140]
test expr-old-36.12 {ExprLooksLikeInt procedure} {
set x "10;"
list [catch {expr {$x+1}} msg] $msg
| | | | | 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 |
expr {$x+1}
} 665802003400000000000001
# tests for [Bug #587140]
test expr-old-36.12 {ExprLooksLikeInt procedure} {
set x "10;"
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "10;" as operand of "+"}}
test expr-old-36.13 {ExprLooksLikeInt procedure} {
set x " +"
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string " +" as operand of "+"}}
test expr-old-36.14 {ExprLooksLikeInt procedure} {
set x "123456789012345678901234567890 "
expr {$x+1}
} 123456789012345678901234567891
test expr-old-36.15 {ExprLooksLikeInt procedure} {
set x "0o99 "
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "0o99 " as operand of "+"}}
test expr-old-36.16 {ExprLooksLikeInt procedure} {
set x " 0xffffffffffffffffffffffffffffffffffffff "
expr {$x+1}
} [expr 0x100000000000000000000000000000000000000]
test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
testexprlong 4+1
|
| ︙ | ︙ |
Changes to tests/expr.test.
| ︙ | ︙ | |||
12 13 14 15 16 17 18 |
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
| < < < < < | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint wideIs64bit \
|
| ︙ | ︙ | |||
253 254 255 256 257 258 259 |
test expr-4.9 {CompileLorExpr: long lor arm} {
set a "abcdefghijkl"
set i 7
expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]}
} 1
test expr-4.10 {CompileLorExpr: error compiling ! operand} {
list [catch {expr {!"a"}} msg] $msg
| | | 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 |
test expr-4.9 {CompileLorExpr: long lor arm} {
set a "abcdefghijkl"
set i 7
expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]}
} 1
test expr-4.10 {CompileLorExpr: error compiling ! operand} {
list [catch {expr {!"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "!"}}
test expr-4.11 {CompileLorExpr: error compiling land arms} {
list [catch {expr {"a"||0}} msg] $msg
} {1 {expected boolean value but got "a"}}
test expr-4.12 {CompileLorExpr: error compiling land arms} {
list [catch {expr {0||"a"}} msg] $msg
} {1 {expected boolean value but got "a"}}
|
| ︙ | ︙ | |||
300 301 302 303 304 305 306 |
expr 2***3|6
} -returnCodes error -match glob -result *
test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
expr 2^x
} -returnCodes error -match glob -result *
test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {24.0^3}} msg] $msg
| | | | | | 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 |
expr 2***3|6
} -returnCodes error -match glob -result *
test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
expr 2^x
} -returnCodes error -match glob -result *
test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {24.0^3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "^"}}
test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {"a"^"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "^"}}
test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
test expr-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
test expr-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
test expr-7.5 {CompileBitAndExpr: error in equality expr} -body {
expr x==3
} -returnCodes error -match glob -result *
test expr-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
test expr-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
test expr-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
test expr-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
test expr-7.10 {CompileBitAndExpr: error compiling bitand arm} -body {
expr 2***3&6
} -returnCodes error -match glob -result *
test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
expr 2&x
} -returnCodes error -match glob -result *
test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {24.0&3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "&"}}
test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "&"}}
test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
test expr-7.20 {CompileBitAndExpr: error in equality expr} -body {
expr xne3
} -returnCodes error -match glob -result *
test expr-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
|
| ︙ | ︙ | |||
452 453 454 455 456 457 458 |
expr 2***3>>6
} -returnCodes error -match glob -result *
test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body {
expr 2<<x
} -returnCodes error -match glob -result *
test expr-10.10 {CompileShiftExpr: runtime error} {
list [catch {expr {24.0>>43}} msg] $msg
| | | | | | 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 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 |
expr 2***3>>6
} -returnCodes error -match glob -result *
test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body {
expr 2<<x
} -returnCodes error -match glob -result *
test expr-10.10 {CompileShiftExpr: runtime error} {
list [catch {expr {24.0>>43}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
test expr-10.11 {CompileShiftExpr: runtime error} {
list [catch {expr {"a"<<"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "<<"}}
test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
test expr-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6
test expr-11.5 {CompileAddExpr: error in multiply expr} -body {
expr x*3
} -returnCodes error -match glob -result *
test expr-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
test expr-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
test expr-11.8 {CompileAddExpr: error compiling add arm} -body {
expr 2***3+6
} -returnCodes error -match glob -result *
test expr-11.9 {CompileAddExpr: error compiling add arm} -body {
expr 2-x
} -returnCodes error -match glob -result *
test expr-11.10 {CompileAddExpr: runtime error} {
list [catch {expr {24.0+"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
test expr-11.11 {CompileAddExpr: runtime error} {
list [catch {expr {"a"-"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
test expr-11.12 {CompileAddExpr: runtime error} {
list [catch {expr {3/0}} msg] $msg
} {1 {divide by zero}}
test expr-11.13a {CompileAddExpr: runtime error} !ieeeFloatingPoint {
list [catch {expr {2.3/0.0}} msg] $msg
} {1 {divide by zero}}
test expr-11.13b {CompileAddExpr: runtime error} ieeeFloatingPoint {
|
| ︙ | ︙ | |||
505 506 507 508 509 510 511 |
expr 2*3%%6
} -returnCodes error -match glob -result *
test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
expr 2*x
} -returnCodes error -match glob -result *
test expr-12.10 {CompileMultiplyExpr: runtime error} {
list [catch {expr {24.0*"xx"}} msg] $msg
| | | | | | 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 |
expr 2*3%%6
} -returnCodes error -match glob -result *
test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
expr 2*x
} -returnCodes error -match glob -result *
test expr-12.10 {CompileMultiplyExpr: runtime error} {
list [catch {expr {24.0*"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "*"}}
test expr-12.11 {CompileMultiplyExpr: runtime error} {
list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
test expr-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
test expr-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
test expr-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
test expr-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
test expr-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
test expr-13.8 {CompileUnaryExpr: error compiling unary expr} -body {
expr ~x
} -returnCodes error -match glob -result *
test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
expr !1.x
} -returnCodes error -match glob -result *
test expr-13.10 {CompileUnaryExpr: runtime error} {
list [catch {expr {~"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "~"}}
test expr-13.11 {CompileUnaryExpr: runtime error} {
list [catch {expr ~4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "~"}}
test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
test expr-13.13 {CompileUnaryExpr: just primary expr} {
set a 27
expr $a
} 27
test expr-13.14 {CompileUnaryExpr: just primary expr} {
expr double(27)
|
| ︙ | ︙ | |||
681 682 683 684 685 686 687 |
set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr pow(1)"}
test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
expr sin(1
} -returnCodes error -match glob -result *
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 676 677 678 679 680 681 682 683 684 685 686 687 688 689 |
set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr pow(1)"}
test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
expr sin(1
} -returnCodes error -match glob -result *
test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
catch {unset a}
set a(VALUE) ff15
set i 123
if {[expr 0x$a(VALUE)] & 16} {
|
| ︙ | ︙ | |||
840 841 842 843 844 845 846 |
test expr-21.11 {non-numeric boolean literals} {expr !no } 1
test expr-21.12 {non-numeric boolean literals} {expr !yes } 0
test expr-21.13 {non-numeric boolean literals} -body {
expr !truef
} -returnCodes error -match glob -result *
test expr-21.14 {non-numeric boolean literals} {
list [catch {expr !"truef"} err] $err
| | | | | | | | | | 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 |
test expr-21.11 {non-numeric boolean literals} {expr !no } 1
test expr-21.12 {non-numeric boolean literals} {expr !yes } 0
test expr-21.13 {non-numeric boolean literals} -body {
expr !truef
} -returnCodes error -match glob -result *
test expr-21.14 {non-numeric boolean literals} {
list [catch {expr !"truef"} err] $err
} {1 {can't use non-numeric string "truef" as operand of "!"}}
test expr-21.15 {non-numeric boolean variables} {
set v truef
list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "truef" as operand of "!"}}
test expr-21.16 {non-numeric boolean variables} {
set v "true "
list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "true " as operand of "!"}}
test expr-21.17 {non-numeric boolean variables} {
set v "tru"
list [catch {expr {!$v}} err] $err
} {0 0}
test expr-21.18 {non-numeric boolean variables} {
set v "fal"
list [catch {expr {!$v}} err] $err
} {0 1}
test expr-21.19 {non-numeric boolean variables} {
set v "y"
list [catch {expr {!$v}} err] $err
} {0 0}
test expr-21.20 {non-numeric boolean variables} {
set v "of"
list [catch {expr {!$v}} err] $err
} {0 1}
test expr-21.21 {non-numeric boolean variables} {
set v "o"
list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "o" as operand of "!"}}
test expr-21.22 {non-numeric boolean variables} {
set v ""
list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "" as operand of "!"}}
# Test for non-numeric float handling.
test expr-22.1 {non-numeric floats} {
list [catch {expr {NaN + 1}} msg] $msg
} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
test expr-22.2 {non-numeric floats} !ieeeFloatingPoint {
list [catch {expr {Inf + 1}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "+"}}
test expr-22.3 {non-numeric floats} {
set nan NaN
list [catch {expr {$nan + 1}} msg] $msg
} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
test expr-22.4 {non-numeric floats} !ieeeFloatingPoint {
set inf Inf
list [catch {expr {$inf + 1}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "+"}}
test expr-22.5 {non-numeric floats} {
list [catch {expr NaN} msg] $msg
} {1 {domain error: argument not in valid range}}
test expr-22.6 {non-numeric floats} !ieeeFloatingPoint {
list [catch {expr Inf} msg] $msg
} {1 {floating-point value too large to represent}}
test expr-22.7 {non-numeric floats} {
list [catch {expr {1 / NaN}} msg] $msg
} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}}
test expr-22.8 {non-numeric floats} !ieeeFloatingPoint {
list [catch {expr {1 / Inf}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "/"}}
# Make sure [Bug 761471] stays fixed.
test expr-22.9 {non-numeric floats: shared object equality and NaN} {
set x NaN
expr {$x == $x}
|
| ︙ | ︙ | |||
924 925 926 927 928 929 930 |
expr (-3-)**6
} -returnCodes error -match glob -result *
test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body {
expr 2**x
} -returnCodes error -match glob -result *
test expr-23.9 {CompileExponentialExpr: runtime error} {
list [catch {expr {24.0**"xx"}} msg] $msg
| | | | 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 |
expr (-3-)**6
} -returnCodes error -match glob -result *
test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body {
expr 2**x
} -returnCodes error -match glob -result *
test expr-23.9 {CompileExponentialExpr: runtime error} {
list [catch {expr {24.0**"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "**"}}
test expr-23.10 {CompileExponentialExpr: runtime error} {
list [catch {expr {"a"**2}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "**"}}
test expr-23.11 {CompileExponentialExpr: runtime error} {
list [catch {expr {0**-1}} msg] $msg
} {1 {exponentiation of zero by negative power}}
test expr-23.12 {CompileExponentialExpr: runtime error} {
list [catch {expr {0.0**-1.0}} msg] $msg
} {1 {exponentiation of zero by negative power}}
test expr-23.13 {CompileExponentialExpr: runtime error} {
|
| ︙ | ︙ |
Changes to tests/fCmd.test.
| ︙ | ︙ | |||
735 736 737 738 739 740 741 |
} -body {
file delete -tf1
} -returnCodes error -cleanup {
file delete -- -tf1
} -result {bad option "-tf1": must be -force or --}
test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
cleanup
| | | | 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 |
} -body {
file delete -tf1
} -returnCodes error -cleanup {
file delete -- -tf1
} -result {bad option "-tf1": must be -force or --}
test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
cleanup
} -constraints {notRoot} -body {
createfile --
createfile -force
file delete -force -force -- -- -force
glob -- -- -force
} -result {}
test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
-constraints {unix notRoot knownBug} -body {
# Labelled knownBug because it is dangerous [Bug: 3881]
file mkdir td1
file attr td1 -perm 040000
file rename ~$user td1
|
| ︙ | ︙ | |||
928 929 930 931 932 933 934 |
} -constraints {notRoot testchmod} -body {
createfile tf1
createfile tf2
file mkdir td1
testchmod 0o444 tf2
file rename tf1 [file join td1 tf3]
file rename tf2 [file join td1 tf4]
| | | | 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 |
} -constraints {notRoot testchmod} -body {
createfile tf1
createfile tf2
file mkdir td1
testchmod 0o444 tf2
file rename tf1 [file join td1 tf3]
file rename tf2 [file join td1 tf4]
list [glob tf*] [lsort [glob -directory td1 t*]] \
[file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
} -result [subst {{} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup {
cleanup
} -constraints {notRoot testchmod} -body {
file mkdir td1
file mkdir td2
file mkdir td3
if {!([testConstraint unix] || [testConstraint winVista])} {
|
| ︙ | ︙ |
Changes to tests/fileName.test.
| ︙ | ︙ | |||
692 693 694 695 696 697 698 |
testtranslatefilename ~ouster
} -constraints {nonPortable testtranslatefilename} -result {/home/ouster}
test filename-10.24 {Tcl_TranslateFileName} -body {
# this test fails if ~ouster is not /home/ouster
testtranslatefilename ~ouster/foo
} -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename}
| | | | | | 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 |
testtranslatefilename ~ouster
} -constraints {nonPortable testtranslatefilename} -result {/home/ouster}
test filename-10.24 {Tcl_TranslateFileName} -body {
# this test fails if ~ouster is not /home/ouster
testtranslatefilename ~ouster/foo
} -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename}
test filename-11.1 {Tcl_GlobCmd} -body {
glob
} -result {}
test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body {
glob -gorp
} -result {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
test filename-11.3 {Tcl_GlobCmd} -body {
glob -nocomplai
} -result {}
test filename-11.4 {Tcl_GlobCmd} -body {
glob -nocomplain
} -result {}
test filename-11.5 {Tcl_GlobCmd} -returnCodes error -body {
glob -nocomplain * ~xyqrszzz
} -result {user "xyqrszzz" doesn't exist}
test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body {
glob ~xyqrszzz
} -result {user "xyqrszzz" doesn't exist}
test filename-11.7 {Tcl_GlobCmd} -body {
glob -- -nocomplain
} -result {}
test filename-11.8 {Tcl_GlobCmd} -body {
glob -nocomplain -- -nocomplain
} -result {}
test filename-11.9 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
testsetplatform unix
glob ~\\xyqrszzz/bar
} -returnCodes error -result {user "\xyqrszzz" doesn't exist}
|
| ︙ | ︙ | |||
1081 1082 1083 1084 1085 1086 1087 |
unset horribleglobname
test filename-12.1 {simple globbing} {unixOrPc} {
glob {}
} {.}
test filename-12.1.1 {simple globbing} -constraints {unixOrPc} -body {
glob -types f {}
| | | 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 |
unset horribleglobname
test filename-12.1 {simple globbing} {unixOrPc} {
glob {}
} {.}
test filename-12.1.1 {simple globbing} -constraints {unixOrPc} -body {
glob -types f {}
} -result {}
test filename-12.1.2 {simple globbing} {unixOrPc} {
glob -types d {}
} {.}
test filename-12.1.3 {simple globbing} {unix} {
glob -types hidden {}
} {.}
test filename-12.1.4 {simple globbing} -constraints {win} -body {
|
| ︙ | ︙ | |||
1243 1244 1245 1246 1247 1248 1249 |
lsort [glob globTest/*.c goo/*]
} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.20 {asterisks, question marks, and brackets} {
glob -nocomplain goo/*
} {}
test filename-14.21 {asterisks, question marks, and brackets} -body {
glob globTest/*/gorp
| | | | 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 |
lsort [glob globTest/*.c goo/*]
} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.20 {asterisks, question marks, and brackets} {
glob -nocomplain goo/*
} {}
test filename-14.21 {asterisks, question marks, and brackets} -body {
glob globTest/*/gorp
} -result {}
test filename-14.22 {asterisks, question marks, and brackets} -body {
glob goo/* x*z foo?q
} -result {}
test filename-14.23 {slash globbing} {unix} {
glob /
} /
test filename-14.23.2 {slash globbing} {win} {
glob /
} [file norm /]
test filename-14.24 {slash globbing} {win} {
|
| ︙ | ︙ |
Changes to tests/get.test.
| ︙ | ︙ | |||
98 99 100 101 102 103 104 |
} {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}}
# Bug 7114ac6141
test get-3.3 {tcl_GetInt with iffy numbers} testgetint {
lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} {
catch {testgetint 44 $x} x
set x
}
| | | | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 |
} {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}}
# Bug 7114ac6141
test get-3.3 {tcl_GetInt with iffy numbers} testgetint {
lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} {
catch {testgetint 44 $x} x
set x
}
} {44 44 44 44 54 54 52 46}
test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj {
lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} {
catch {testdoubleobj set 1 $x} x
set x
}
} {0.0 0.0 0.0 0.0 0.0 9.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0}
# cleanup
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
|
| ︙ | ︙ |
Changes to tests/httpd11.tcl.
1 2 3 4 5 6 7 8 9 10 | # httpd11.tcl -- -*- tcl -*- # # A simple httpd for testing HTTP/1.1 client features. # Not suitable for use on a internet connected port. # # Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net> # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
# httpd11.tcl -- -*- tcl -*-
#
# A simple httpd for testing HTTP/1.1 client features.
# Not suitable for use on a internet connected port.
#
# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require Tcl 8.6-
proc ::tcl::dict::get? {dict key} {
if {[dict exists $dict $key]} {
return [dict get $dict $key]
}
return
}
|
| ︙ | ︙ |
Changes to tests/indexObj.test.
| ︙ | ︙ | |||
103 104 105 106 107 108 109 |
} "wrong # args: should be \"\""
test indexObj-5.5 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 1 "" mycmd foo
} "wrong # args: should be \"mycmd\""
test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 2 "" mycmd foo
} "wrong # args: should be \"mycmd foo\""
| < < < < < | 103 104 105 106 107 108 109 110 111 112 113 114 115 116 |
} "wrong # args: should be \"\""
test indexObj-5.5 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 1 "" mycmd foo
} "wrong # args: should be \"mycmd\""
test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 2 "" mycmd foo
} "wrong # args: should be \"mycmd foo\""
test indexObj-6.1 {Tcl_GetIndexFromObjStruct} testindexobj {
set x a
testgetindexfromobjstruct $x 0
} "wrong # args: should be \"testgetindexfromobjstruct a 0\""
test indexObj-6.2 {Tcl_GetIndexFromObjStruct} testindexobj {
set x a
|
| ︙ | ︙ |
Changes to tests/lindex.test.
| ︙ | ︙ | |||
66 67 68 69 70 71 72 |
test lindex-3.4 {integer 3} testevalex {
set x [string range 33 0 0]
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
test lindex-3.5 {bad octal} -constraints testevalex -body {
set x 0o8
list [catch { testevalex {lindex {a b c} $x} } result] $result
| | | | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
test lindex-3.4 {integer 3} testevalex {
set x [string range 33 0 0]
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
test lindex-3.5 {bad octal} -constraints testevalex -body {
set x 0o8
list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
test lindex-3.6 {bad octal} -constraints testevalex -body {
set x -0o9
list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
test lindex-3.7 {indexes don't shimmer wide ints} {
set x [expr {(wide(1)<<31) - 2}]
list $x [lindex {1 2 3} $x] [incr x] [incr x]
} {2147483646 {} 2147483647 2147483648}
# Indices relative to end
|
| ︙ | ︙ | |||
101 102 103 104 105 106 107 |
test lindex-4.5 {index = end-3} testevalex {
set x end-3
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
test lindex-4.6 {bad octal} -constraints testevalex -body {
set x end-0o8
list [catch { testevalex {lindex {a b c} $x} } result] $result
| | | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 |
test lindex-4.5 {index = end-3} testevalex {
set x end-3
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
test lindex-4.6 {bad octal} -constraints testevalex -body {
set x end-0o8
list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
test lindex-4.7 {bad octal} -constraints testevalex -body {
set x end--0o9
list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
test lindex-4.8 {bad integer, not octal} testevalex {
set x end-0a2
list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lindex-4.9 {obsolete test} testevalex {
set x end
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
|
| ︙ | ︙ | |||
257 258 259 260 261 262 263 |
list [lindex {a b c} $x] [lindex {a b c} $x]
} result
set result
} {{} {}}
test lindex-11.5 {bad octal} -body {
set x 0o8
list [catch { lindex {a b c} $x } result] $result
| | | | 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 |
list [lindex {a b c} $x] [lindex {a b c} $x]
} result
set result
} {{} {}}
test lindex-11.5 {bad octal} -body {
set x 0o8
list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
test lindex-11.6 {bad octal} -body {
set x -0o9
list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
# Indices relative to end
test lindex-12.1 {index = end} {
set x end
catch {
list [lindex {a b c} $x] [lindex {a b c} $x]
|
| ︙ | ︙ | |||
303 304 305 306 307 308 309 |
list [lindex {a b c} $x] [lindex {a b c} $x]
} result
set result
} {{} {}}
test lindex-12.6 {bad octal} -body {
set x end-0o8
list [catch { lindex {a b c} $x } result] $result
| | | | 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 |
list [lindex {a b c} $x] [lindex {a b c} $x]
} result
set result
} {{} {}}
test lindex-12.6 {bad octal} -body {
set x end-0o8
list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
test lindex-12.7 {bad octal} -body {
set x end--0o9
list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
test lindex-12.8 {bad integer, not octal} {
set x end-0a2
list [catch { lindex {a b c} $x } result] $result
} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lindex-12.9 {obsolete test} {
set x end
catch {
|
| ︙ | ︙ |
Changes to tests/mathop.test.
| ︙ | ︙ | |||
110 111 112 113 114 115 116 |
test mathop-1.6 {compiled +} { + 1 2 3.0 } 6.0
test mathop-1.7 {compiled +} { + 100000000000 2 3 } 100000000005
test mathop-1.8 {compiled +} { + 1 2 300000000000 } 300000000003
test mathop-1.9 {compiled +} { + 1000000000000000000000 2 3 } 1000000000000000000005
test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003
test mathop-1.11 {compiled +: errors} -returnCodes error -body {
+ x 0
| | | | | | | | 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 |
test mathop-1.6 {compiled +} { + 1 2 3.0 } 6.0
test mathop-1.7 {compiled +} { + 100000000000 2 3 } 100000000005
test mathop-1.8 {compiled +} { + 1 2 300000000000 } 300000000003
test mathop-1.9 {compiled +} { + 1000000000000000000000 2 3 } 1000000000000000000005
test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003
test mathop-1.11 {compiled +: errors} -returnCodes error -body {
+ x 0
} -result {can't use non-numeric string "x" as operand of "+"}
test mathop-1.12 {compiled +: errors} -returnCodes error -body {
+ nan 0
} -result {can't use non-numeric floating-point value "nan" as operand of "+"}
test mathop-1.13 {compiled +: errors} -returnCodes error -body {
+ 0 x
} -result {can't use non-numeric string "x" as operand of "+"}
test mathop-1.14 {compiled +: errors} -returnCodes error -body {
+ 0 nan
} -result {can't use non-numeric floating-point value "nan" as operand of "+"}
test mathop-1.15 {compiled +: errors} -returnCodes error -body {
+ 0o8 0
} -result {can't use non-numeric string "0o8" as operand of "+"}
test mathop-1.16 {compiled +: errors} -returnCodes error -body {
+ 0 0o8
} -result {can't use non-numeric string "0o8" as operand of "+"}
test mathop-1.17 {compiled +: errors} -returnCodes error -body {
+ 0 [error expectedError]
} -result expectedError
test mathop-1.18 {compiled +: argument processing order} -body {
# Bytecode compilation known hard for 3+ arguments
list [catch {
+ [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
|
| ︙ | ︙ | |||
148 149 150 151 152 153 154 |
test mathop-1.24 {interpreted +} { $op 1 2 3.0 } 6.0
test mathop-1.25 {interpreted +} { $op 100000000000 2 3 } 100000000005
test mathop-1.26 {interpreted +} { $op 1 2 300000000000 } 300000000003
test mathop-1.27 {interpreted +} { $op 1000000000000000000000 2 3 } 1000000000000000000005
test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003
test mathop-1.29 {interpreted +: errors} -returnCodes error -body {
$op x 0
| | | | | | | | 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 173 174 175 176 177 |
test mathop-1.24 {interpreted +} { $op 1 2 3.0 } 6.0
test mathop-1.25 {interpreted +} { $op 100000000000 2 3 } 100000000005
test mathop-1.26 {interpreted +} { $op 1 2 300000000000 } 300000000003
test mathop-1.27 {interpreted +} { $op 1000000000000000000000 2 3 } 1000000000000000000005
test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003
test mathop-1.29 {interpreted +: errors} -returnCodes error -body {
$op x 0
} -result {can't use non-numeric string "x" as operand of "+"}
test mathop-1.30 {interpreted +: errors} -returnCodes error -body {
$op nan 0
} -result {can't use non-numeric floating-point value "nan" as operand of "+"}
test mathop-1.31 {interpreted +: errors} -returnCodes error -body {
$op 0 x
} -result {can't use non-numeric string "x" as operand of "+"}
test mathop-1.32 {interpreted +: errors} -returnCodes error -body {
$op 0 nan
} -result {can't use non-numeric floating-point value "nan" as operand of "+"}
test mathop-1.33 {interpreted +: errors} -returnCodes error -body {
$op 0o8 0
} -result {can't use non-numeric string "0o8" as operand of "+"}
test mathop-1.34 {interpreted +: errors} -returnCodes error -body {
$op 0 0o8
} -result {can't use non-numeric string "0o8" as operand of "+"}
test mathop-1.35 {interpreted +: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
test mathop-1.36 {interpreted +: argument processing order} -body {
list [catch {
$op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
} msg] $msg $x
|
| ︙ | ︙ | |||
185 186 187 188 189 190 191 |
test mathop-2.6 {compiled *} { * 1 2 3.0 } 6.0
test mathop-2.7 {compiled *} { * 100000000000 2 3 } 600000000000
test mathop-2.8 {compiled *} { * 1 2 300000000000 } 600000000000
test mathop-2.9 {compiled *} { * 1000000000000000000000 2 3 } 6000000000000000000000
test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000
test mathop-2.11 {compiled *: errors} -returnCodes error -body {
* x 0
| | | | | | | | 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 |
test mathop-2.6 {compiled *} { * 1 2 3.0 } 6.0
test mathop-2.7 {compiled *} { * 100000000000 2 3 } 600000000000
test mathop-2.8 {compiled *} { * 1 2 300000000000 } 600000000000
test mathop-2.9 {compiled *} { * 1000000000000000000000 2 3 } 6000000000000000000000
test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000
test mathop-2.11 {compiled *: errors} -returnCodes error -body {
* x 0
} -result {can't use non-numeric string "x" as operand of "*"}
test mathop-2.12 {compiled *: errors} -returnCodes error -body {
* nan 0
} -result {can't use non-numeric floating-point value "nan" as operand of "*"}
test mathop-2.13 {compiled *: errors} -returnCodes error -body {
* 0 x
} -result {can't use non-numeric string "x" as operand of "*"}
test mathop-2.14 {compiled *: errors} -returnCodes error -body {
* 0 nan
} -result {can't use non-numeric floating-point value "nan" as operand of "*"}
test mathop-2.15 {compiled *: errors} -returnCodes error -body {
* 0o8 0
} -result {can't use non-numeric string "0o8" as operand of "*"}
test mathop-2.16 {compiled *: errors} -returnCodes error -body {
* 0 0o8
} -result {can't use non-numeric string "0o8" as operand of "*"}
test mathop-2.17 {compiled *: errors} -returnCodes error -body {
* 0 [error expectedError]
} -result expectedError
test mathop-2.18 {compiled *: argument processing order} -body {
# Bytecode compilation known hard for 3+ arguments
list [catch {
* [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
|
| ︙ | ︙ | |||
223 224 225 226 227 228 229 |
test mathop-2.24 {interpreted *} { $op 1 2 3.0 } 6.0
test mathop-2.25 {interpreted *} { $op 100000000000 2 3 } 600000000000
test mathop-2.26 {interpreted *} { $op 1 2 300000000000 } 600000000000
test mathop-2.27 {interpreted *} { $op 1000000000000000000000 2 3 } 6000000000000000000000
test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000
test mathop-2.29 {interpreted *: errors} -returnCodes error -body {
$op x 0
| | | | | | | | | | | | | | | | | | 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 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 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 |
test mathop-2.24 {interpreted *} { $op 1 2 3.0 } 6.0
test mathop-2.25 {interpreted *} { $op 100000000000 2 3 } 600000000000
test mathop-2.26 {interpreted *} { $op 1 2 300000000000 } 600000000000
test mathop-2.27 {interpreted *} { $op 1000000000000000000000 2 3 } 6000000000000000000000
test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000
test mathop-2.29 {interpreted *: errors} -returnCodes error -body {
$op x 0
} -result {can't use non-numeric string "x" as operand of "*"}
test mathop-2.30 {interpreted *: errors} -returnCodes error -body {
$op nan 0
} -result {can't use non-numeric floating-point value "nan" as operand of "*"}
test mathop-2.31 {interpreted *: errors} -returnCodes error -body {
$op 0 x
} -result {can't use non-numeric string "x" as operand of "*"}
test mathop-2.32 {interpreted *: errors} -returnCodes error -body {
$op 0 nan
} -result {can't use non-numeric floating-point value "nan" as operand of "*"}
test mathop-2.33 {interpreted *: errors} -returnCodes error -body {
$op 0o8 0
} -result {can't use non-numeric string "0o8" as operand of "*"}
test mathop-2.34 {interpreted *: errors} -returnCodes error -body {
$op 0 0o8
} -result {can't use non-numeric string "0o8" as operand of "*"}
test mathop-2.35 {interpreted *: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
test mathop-2.36 {interpreted *: argument processing order} -body {
list [catch {
$op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
} msg] $msg $x
} -result {1 expected 2}
test mathop-3.1 {compiled !} {! 0} 1
test mathop-3.2 {compiled !} {! 1} 0
test mathop-3.3 {compiled !} {! false} 1
test mathop-3.4 {compiled !} {! true} 0
test mathop-3.5 {compiled !} {! 0.0} 1
test mathop-3.6 {compiled !} {! 10000000000} 0
test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0
test mathop-3.8 {compiled !: errors} -body {
! foobar
} -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
test mathop-3.9 {compiled !: errors} -body {
! 0 0
} -returnCodes error -result "wrong # args: should be \"! boolean\""
test mathop-3.10 {compiled !: errors} -body {
!
} -returnCodes error -result "wrong # args: should be \"! boolean\""
set op !
test mathop-3.11 {interpreted !} {$op 0} 1
test mathop-3.12 {interpreted !} {$op 1} 0
test mathop-3.13 {interpreted !} {$op false} 1
test mathop-3.14 {interpreted !} {$op true} 0
test mathop-3.15 {interpreted !} {$op 0.0} 1
test mathop-3.16 {interpreted !} {$op 10000000000} 0
test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0
test mathop-3.18 {interpreted !: errors} -body {
$op foobar
} -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
test mathop-3.19 {interpreted !: errors} -body {
$op 0 0
} -returnCodes error -result "wrong # args: should be \"! boolean\""
test mathop-3.20 {interpreted !: errors} -body {
$op
} -returnCodes error -result "wrong # args: should be \"! boolean\""
test mathop-3.21 {compiled !: error} -returnCodes error -body {
! NaN
} -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
test mathop-3.22 {interpreted !: error} -returnCodes error -body {
$op NaN
} -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
test mathop-4.1 {compiled ~} {~ 0} -1
test mathop-4.2 {compiled ~} {~ 1} -2
test mathop-4.3 {compiled ~} {~ 31} -32
test mathop-4.4 {compiled ~} {~ -127} 126
test mathop-4.5 {compiled ~} {~ -0} -1
test mathop-4.6 {compiled ~} {~ 10000000000} -10000000001
test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001
test mathop-4.8 {compiled ~: errors} -body {
~ foobar
} -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
test mathop-4.9 {compiled ~: errors} -body {
~ 0 0
} -returnCodes error -result "wrong # args: should be \"~ integer\""
test mathop-4.10 {compiled ~: errors} -body {
~
} -returnCodes error -result "wrong # args: should be \"~ integer\""
test mathop-4.11 {compiled ~: errors} -returnCodes error -body {
~ 0.0
} -result {can't use floating-point value "0.0" as operand of "~"}
test mathop-4.12 {compiled ~: errors} -returnCodes error -body {
~ NaN
} -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
set op ~
test mathop-4.13 {interpreted ~} {$op 0} -1
test mathop-4.14 {interpreted ~} {$op 1} -2
test mathop-4.15 {interpreted ~} {$op 31} -32
test mathop-4.16 {interpreted ~} {$op -127} 126
test mathop-4.17 {interpreted ~} {$op -0} -1
test mathop-4.18 {interpreted ~} {$op 10000000000} -10000000001
test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001
test mathop-4.20 {interpreted ~: errors} -body {
$op foobar
} -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
test mathop-4.21 {interpreted ~: errors} -body {
$op 0 0
} -returnCodes error -result "wrong # args: should be \"~ integer\""
test mathop-4.22 {interpreted ~: errors} -body {
$op
} -returnCodes error -result "wrong # args: should be \"~ integer\""
test mathop-4.23 {interpreted ~: errors} -returnCodes error -body {
$op 0.0
} -result {can't use floating-point value "0.0" as operand of "~"}
test mathop-4.24 {interpreted ~: errors} -returnCodes error -body {
$op NaN
} -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
test mathop-5.1 {compiled eq} {eq {} a} 0
test mathop-5.2 {compiled eq} {eq a a} 1
test mathop-5.3 {compiled eq} {eq a {}} 0
test mathop-5.4 {compiled eq} {eq a b} 0
test mathop-5.5 {compiled eq} { eq } 1
test mathop-5.6 {compiled eq} {eq a} 1
|
| ︙ | ︙ | |||
373 374 375 376 377 378 379 |
test mathop-6.1 {compiled &} { & } -1
test mathop-6.2 {compiled &} { & 1 } 1
test mathop-6.3 {compiled &} { & 1 2 } 0
test mathop-6.4 {compiled &} { & 3 7 6 } 2
test mathop-6.5 {compiled &} -returnCodes error -body {
& 1.0 2 3
| | | | | | | | | | | | | | | | | | 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 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 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 |
test mathop-6.1 {compiled &} { & } -1
test mathop-6.2 {compiled &} { & 1 } 1
test mathop-6.3 {compiled &} { & 1 2 } 0
test mathop-6.4 {compiled &} { & 3 7 6 } 2
test mathop-6.5 {compiled &} -returnCodes error -body {
& 1.0 2 3
} -result {can't use floating-point value "1.0" as operand of "&"}
test mathop-6.6 {compiled &} -returnCodes error -body {
& 1 2 3.0
} -result {can't use floating-point value "3.0" as operand of "&"}
test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2
test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85
test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2
test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85
test mathop-6.11 {compiled &: errors} -returnCodes error -body {
& x 0
} -result {can't use non-numeric string "x" as operand of "&"}
test mathop-6.12 {compiled &: errors} -returnCodes error -body {
& nan 0
} -result {can't use non-numeric floating-point value "nan" as operand of "&"}
test mathop-6.13 {compiled &: errors} -returnCodes error -body {
& 0 x
} -result {can't use non-numeric string "x" as operand of "&"}
test mathop-6.14 {compiled &: errors} -returnCodes error -body {
& 0 nan
} -result {can't use non-numeric floating-point value "nan" as operand of "&"}
test mathop-6.15 {compiled &: errors} -returnCodes error -body {
& 0o8 0
} -result {can't use non-numeric string "0o8" as operand of "&"}
test mathop-6.16 {compiled &: errors} -returnCodes error -body {
& 0 0o8
} -result {can't use non-numeric string "0o8" as operand of "&"}
test mathop-6.17 {compiled &: errors} -returnCodes error -body {
& 0 [error expectedError]
} -result expectedError
test mathop-6.18 {compiled &: argument processing order} -body {
# Bytecode compilation known hard for 3+ arguments
list [catch {
& [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
} msg] $msg $x
} -result {1 expected 2}
set op &
test mathop-6.19 {interpreted &} { $op } -1
test mathop-6.20 {interpreted &} { $op 1 } 1
test mathop-6.21 {interpreted &} { $op 1 2 } 0
test mathop-6.22 {interpreted &} { $op 3 7 6 } 2
test mathop-6.23 {interpreted &} -returnCodes error -body {
$op 1.0 2 3
} -result {can't use floating-point value "1.0" as operand of "&"}
test mathop-6.24 {interpreted &} -returnCodes error -body {
$op 1 2 3.0
} -result {can't use floating-point value "3.0" as operand of "&"}
test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2
test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85
test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2
test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85
test mathop-6.29 {interpreted &: errors} -returnCodes error -body {
$op x 0
} -result {can't use non-numeric string "x" as operand of "&"}
test mathop-6.30 {interpreted &: errors} -returnCodes error -body {
$op nan 0
} -result {can't use non-numeric floating-point value "nan" as operand of "&"}
test mathop-6.31 {interpreted &: errors} -returnCodes error -body {
$op 0 x
} -result {can't use non-numeric string "x" as operand of "&"}
test mathop-6.32 {interpreted &: errors} -returnCodes error -body {
$op 0 nan
} -result {can't use non-numeric floating-point value "nan" as operand of "&"}
test mathop-6.33 {interpreted &: errors} -returnCodes error -body {
$op 0o8 0
} -result {can't use non-numeric string "0o8" as operand of "&"}
test mathop-6.34 {interpreted &: errors} -returnCodes error -body {
$op 0 0o8
} -result {can't use non-numeric string "0o8" as operand of "&"}
test mathop-6.35 {interpreted &: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
test mathop-6.36 {interpreted &: argument processing order} -body {
list [catch {
$op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
} msg] $msg $x
|
| ︙ | ︙ | |||
483 484 485 486 487 488 489 |
test mathop-7.1 {compiled |} { | } 0
test mathop-7.2 {compiled |} { | 1 } 1
test mathop-7.3 {compiled |} { | 1 2 } 3
test mathop-7.4 {compiled |} { | 3 7 6 } 7
test mathop-7.5 {compiled |} -returnCodes error -body {
| 1.0 2 3
| | | | | | | | | | | | | | | | | | 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 |
test mathop-7.1 {compiled |} { | } 0
test mathop-7.2 {compiled |} { | 1 } 1
test mathop-7.3 {compiled |} { | 1 2 } 3
test mathop-7.4 {compiled |} { | 3 7 6 } 7
test mathop-7.5 {compiled |} -returnCodes error -body {
| 1.0 2 3
} -result {can't use floating-point value "1.0" as operand of "|"}
test mathop-7.6 {compiled |} -returnCodes error -body {
| 1 2 3.0
} -result {can't use floating-point value "3.0" as operand of "|"}
test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110
test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503
test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110
test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503
test mathop-7.11 {compiled |: errors} -returnCodes error -body {
| x 0
} -result {can't use non-numeric string "x" as operand of "|"}
test mathop-7.12 {compiled |: errors} -returnCodes error -body {
| nan 0
} -result {can't use non-numeric floating-point value "nan" as operand of "|"}
test mathop-7.13 {compiled |: errors} -returnCodes error -body {
| 0 x
} -result {can't use non-numeric string "x" as operand of "|"}
test mathop-7.14 {compiled |: errors} -returnCodes error -body {
| 0 nan
} -result {can't use non-numeric floating-point value "nan" as operand of "|"}
test mathop-7.15 {compiled |: errors} -returnCodes error -body {
| 0o8 0
} -result {can't use non-numeric string "0o8" as operand of "|"}
test mathop-7.16 {compiled |: errors} -returnCodes error -body {
| 0 0o8
} -result {can't use non-numeric string "0o8" as operand of "|"}
test mathop-7.17 {compiled |: errors} -returnCodes error -body {
| 0 [error expectedError]
} -result expectedError
test mathop-7.18 {compiled |: argument processing order} -body {
# Bytecode compilation known hard for 3+ arguments
list [catch {
| [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
} msg] $msg $x
} -result {1 expected 2}
set op |
test mathop-7.19 {interpreted |} { $op } 0
test mathop-7.20 {interpreted |} { $op 1 } 1
test mathop-7.21 {interpreted |} { $op 1 2 } 3
test mathop-7.22 {interpreted |} { $op 3 7 6 } 7
test mathop-7.23 {interpreted |} -returnCodes error -body {
$op 1.0 2 3
} -result {can't use floating-point value "1.0" as operand of "|"}
test mathop-7.24 {interpreted |} -returnCodes error -body {
$op 1 2 3.0
} -result {can't use floating-point value "3.0" as operand of "|"}
test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110
test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503
test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110
test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503
test mathop-7.29 {interpreted |: errors} -returnCodes error -body {
$op x 0
} -result {can't use non-numeric string "x" as operand of "|"}
test mathop-7.30 {interpreted |: errors} -returnCodes error -body {
$op nan 0
} -result {can't use non-numeric floating-point value "nan" as operand of "|"}
test mathop-7.31 {interpreted |: errors} -returnCodes error -body {
$op 0 x
} -result {can't use non-numeric string "x" as operand of "|"}
test mathop-7.32 {interpreted |: errors} -returnCodes error -body {
$op 0 nan
} -result {can't use non-numeric floating-point value "nan" as operand of "|"}
test mathop-7.33 {interpreted |: errors} -returnCodes error -body {
$op 0o8 0
} -result {can't use non-numeric string "0o8" as operand of "|"}
test mathop-7.34 {interpreted |: errors} -returnCodes error -body {
$op 0 0o8
} -result {can't use non-numeric string "0o8" as operand of "|"}
test mathop-7.35 {interpreted |: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
test mathop-7.36 {interpreted |: argument processing order} -body {
list [catch {
$op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
} msg] $msg $x
|
| ︙ | ︙ | |||
593 594 595 596 597 598 599 |
test mathop-8.1 {compiled ^} { ^ } 0
test mathop-8.2 {compiled ^} { ^ 1 } 1
test mathop-8.3 {compiled ^} { ^ 1 2 } 3
test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2
test mathop-8.5 {compiled ^} -returnCodes error -body {
^ 1.0 2 3
| | | | | | | | | | | | | | | | | | 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 |
test mathop-8.1 {compiled ^} { ^ } 0
test mathop-8.2 {compiled ^} { ^ 1 } 1
test mathop-8.3 {compiled ^} { ^ 1 2 } 3
test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2
test mathop-8.5 {compiled ^} -returnCodes error -body {
^ 1.0 2 3
} -result {can't use floating-point value "1.0" as operand of "^"}
test mathop-8.6 {compiled ^} -returnCodes error -body {
^ 1 2 3.0
} -result {can't use floating-point value "3.0" as operand of "^"}
test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110
test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333
test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110
test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333
test mathop-8.11 {compiled ^: errors} -returnCodes error -body {
^ x 0
} -result {can't use non-numeric string "x" as operand of "^"}
test mathop-8.12 {compiled ^: errors} -returnCodes error -body {
^ nan 0
} -result {can't use non-numeric floating-point value "nan" as operand of "^"}
test mathop-8.13 {compiled ^: errors} -returnCodes error -body {
^ 0 x
} -result {can't use non-numeric string "x" as operand of "^"}
test mathop-8.14 {compiled ^: errors} -returnCodes error -body {
^ 0 nan
} -result {can't use non-numeric floating-point value "nan" as operand of "^"}
test mathop-8.15 {compiled ^: errors} -returnCodes error -body {
^ 0o8 0
} -result {can't use non-numeric string "0o8" as operand of "^"}
test mathop-8.16 {compiled ^: errors} -returnCodes error -body {
^ 0 0o8
} -result {can't use non-numeric string "0o8" as operand of "^"}
test mathop-8.17 {compiled ^: errors} -returnCodes error -body {
^ 0 [error expectedError]
} -result expectedError
test mathop-8.18 {compiled ^: argument processing order} -body {
# Bytecode compilation known hard for 3+ arguments
list [catch {
^ [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
} msg] $msg $x
} -result {1 expected 2}
set op ^
test mathop-8.19 {interpreted ^} { $op } 0
test mathop-8.20 {interpreted ^} { $op 1 } 1
test mathop-8.21 {interpreted ^} { $op 1 2 } 3
test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2
test mathop-8.23 {interpreted ^} -returnCodes error -body {
$op 1.0 2 3
} -result {can't use floating-point value "1.0" as operand of "^"}
test mathop-8.24 {interpreted ^} -returnCodes error -body {
$op 1 2 3.0
} -result {can't use floating-point value "3.0" as operand of "^"}
test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110
test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333
test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110
test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333
test mathop-8.29 {interpreted ^: errors} -returnCodes error -body {
$op x 0
} -result {can't use non-numeric string "x" as operand of "^"}
test mathop-8.30 {interpreted ^: errors} -returnCodes error -body {
$op nan 0
} -result {can't use non-numeric floating-point value "nan" as operand of "^"}
test mathop-8.31 {interpreted ^: errors} -returnCodes error -body {
$op 0 x
} -result {can't use non-numeric string "x" as operand of "^"}
test mathop-8.32 {interpreted ^: errors} -returnCodes error -body {
$op 0 nan
} -result {can't use non-numeric floating-point value "nan" as operand of "^"}
test mathop-8.33 {interpreted ^: errors} -returnCodes error -body {
$op 0o8 0
} -result {can't use non-numeric string "0o8" as operand of "^"}
test mathop-8.34 {interpreted ^: errors} -returnCodes error -body {
$op 0 0o8
} -result {can't use non-numeric string "0o8" as operand of "^"}
test mathop-8.35 {interpreted ^: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
test mathop-8.36 {interpreted ^: argument processing order} -body {
list [catch {
$op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
} msg] $msg $x
|
| ︙ | ︙ | |||
771 772 773 774 775 776 777 |
test mathop-20.6 { one arg, error } {
set res {}
set exp {}
foreach vals {x {1 x} {1 1 x} {1 x 1}} {
# skipping - for now, knownbug...
foreach op {+ * / & | ^ **} {
lappend res [TestOp $op {*}$vals]
| | | | 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 |
test mathop-20.6 { one arg, error } {
set res {}
set exp {}
foreach vals {x {1 x} {1 1 x} {1 x 1}} {
# skipping - for now, knownbug...
foreach op {+ * / & | ^ **} {
lappend res [TestOp $op {*}$vals]
lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\
ARITH DOMAIN {non-numeric string}"
}
}
foreach op {+ * / & | ^ **} {
lappend res [TestOp $op NaN 1]
lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\
ARITH DOMAIN {non-numeric floating-point value}"
}
expr {$res eq $exp ? 0 : $res}
} 0
test mathop-20.7 { multi arg } {
set res {}
foreach vals {{1 2} {3 4 5} {4 3 2 1}} {
|
| ︙ | ︙ | |||
846 847 848 849 850 851 852 |
set res
} [list 1.0 0.2 0.17857142857142858 -0.125 \
2.8196218755553604e-15 8.10000006561e-27]
test mathop-21.5 { unary ops, bad values } {
set res {}
set exp {}
lappend res [TestOp / x]
| | | | | | | 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 |
set res
} [list 1.0 0.2 0.17857142857142858 -0.125 \
2.8196218755553604e-15 8.10000006561e-27]
test mathop-21.5 { unary ops, bad values } {
set res {}
set exp {}
lappend res [TestOp / x]
lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp - x]
lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ~ x]
lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ! x]
lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ~ 5.0]
lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}"
expr {$res eq $exp ? 0 : $res}
} 0
test mathop-21.6 { unary ops, too many } {
set exp {}
foreach op {~ !} {
set res [TestOp $op 7 8]
if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
|
| ︙ | ︙ | |||
961 962 963 964 965 966 967 |
70720 \
]
test mathop-22.4 { unary ops, bad values } {
set res {}
set exp {}
foreach op {& | ^} {
lappend res [TestOp $op x 5]
| | | | 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 |
70720 \
]
test mathop-22.4 { unary ops, bad values } {
set res {}
set exp {}
foreach op {& | ^} {
lappend res [TestOp $op x 5]
lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp $op 5 x]
lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
}
expr {$res eq $exp ? 0 : $res}
} 0
test mathop-23.1 { comparison ops, numerical } {
set res {}
set todo {5 {1 6} {1 2 2 3} {4 3 2 1} {5.0 5.0} {6 3 3 1} {5.0 5}}
|
| ︙ | ︙ | |||
1076 1077 1078 1079 1080 1081 1082 |
0 \
]
test mathop-24.3 { binary ops, bad values } {
set res {}
set exp {}
foreach op {% << >>} {
lappend res [TestOp $op x 1]
| | | | | | 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 |
0 \
]
test mathop-24.3 { binary ops, bad values } {
set res {}
set exp {}
foreach op {% << >>} {
lappend res [TestOp $op x 1]
lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp $op 1 x]
lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
}
foreach op {% << >>} {
lappend res [TestOp $op 5.0 1]
lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
lappend res [TestOp $op 1 5.0]
lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
}
foreach op {in ni} {
lappend res [TestOp $op 5 "a b \{ c"]
lappend exp "unmatched open brace in list TCL VALUE LIST BRACE"
}
lappend res [TestOp % 5 0]
lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
|
| ︙ | ︙ | |||
1236 1237 1238 1239 1240 1241 1242 |
lappend res [TestOp ** $small $wide]
lappend exp "exponent too large NONE"
lappend res [TestOp ** 2 $big]
lappend exp "exponent too large NONE"
lappend res [TestOp ** $huge 2.1]
lappend exp "Inf"
lappend res [TestOp ** 2 foo]
| | | | 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 |
lappend res [TestOp ** $small $wide]
lappend exp "exponent too large NONE"
lappend res [TestOp ** 2 $big]
lappend exp "exponent too large NONE"
lappend res [TestOp ** $huge 2.1]
lappend exp "Inf"
lappend res [TestOp ** 2 foo]
lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ** foo 2]
lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
expr {$res eq $exp ? 0 : $res}
} 0
test mathop-26.1 { misc ops, size combinations } {
set big1 12135435435354435435342423948763867876
set big2 2746237174783836746262564892918327847
|
| ︙ | ︙ |
Changes to tests/obj.test.
| ︙ | ︙ | |||
22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
set r 1
foreach {t} {
bytearray
bytecode
cmdName
dict
end-offset
regexp
string
| > | 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 |
testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
set r 1
foreach {t} {
{array search}
bytearray
bytecode
cmdName
dict
end-offset
regexp
string
|
| ︙ | ︙ |
Changes to tests/parseExpr.test.
| ︙ | ︙ | |||
1040 1041 1042 1043 1044 1045 1046 |
dict get $o -errorcode
} -result {TCL PARSE EXPR EMPTY}
test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body {
testexprparser naner() -1
} -result {- {} 0 subexpr naner() 1 operator naner 0 {}}
test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body {
| | < | | 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 |
dict get $o -errorcode
} -result {TCL PARSE EXPR EMPTY}
test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body {
testexprparser naner() -1
} -result {- {} 0 subexpr naner() 1 operator naner 0 {}}
test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body {
testexprparser 08 -1
} -result {- {} 0 subexpr 08 1 text 08 0 {}}
test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body {
catch {testexprparser 0o8 -1} m o
dict get $o -errorcode
} -result {TCL PARSE EXPR BADNUMBER OCTAL}
test parseExpr-22.16 {Bug 3401704} -constraints testexprparser -body {
catch {testexprparser 0o08 -1} m o
dict get $o -errorcode
|
| ︙ | ︙ |
Changes to tests/reg.test.
| ︙ | ︙ | |||
509 510 511 512 513 514 515 |
expectMatch 9.37 bE {a[\]]b} "a\\]b" "a\\]b"
expectMatch 9.38 eE {a[\]]b} "a\\]b" "a\\]b"
expectMatch 9.39 EP {a[\\]b} "a\\b" "a\\b"
expectMatch 9.40 eE {a[\\]b} "a\\b" "a\\b"
expectMatch 9.41 bE {a[\\]b} "a\\b" "a\\b"
expectError 9.42 - {a[\Z]b} EESCAPE
expectMatch 9.43 & {a[[b]c} "a\[c" "a\[c"
| | | 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 |
expectMatch 9.37 bE {a[\]]b} "a\\]b" "a\\]b"
expectMatch 9.38 eE {a[\]]b} "a\\]b" "a\\]b"
expectMatch 9.39 EP {a[\\]b} "a\\b" "a\\b"
expectMatch 9.40 eE {a[\\]b} "a\\b" "a\\b"
expectMatch 9.41 bE {a[\\]b} "a\\b" "a\\b"
expectError 9.42 - {a[\Z]b} EESCAPE
expectMatch 9.43 & {a[[b]c} "a\[c" "a\[c"
expectMatch 9.44 M* "a\[\u00fe-\u0507\]\[\u00ff-\u0300\]b" \
"a\u0102\u02ffb" "a\u0102\u02ffb"
doing 10 "anchors and newlines"
expectMatch 10.1 & ^a a a
expectNomatch 10.2 &^ ^a a
expectIndices 10.3 &N ^ a {0 -1}
|
| ︙ | ︙ | |||
620 621 622 623 624 625 626 | expectMatch 13.9 MP "a\\chb" "a\bb" "a\bb" expectMatch 13.10 MP "a\\cHb" "a\bb" "a\bb" expectMatch 13.11 LMP "a\\e" "a\033" "a\033" expectMatch 13.12 P "a\\fb" "a\fb" "a\fb" expectMatch 13.13 P "a\\nb" "a\nb" "a\nb" expectMatch 13.14 P "a\\rb" "a\rb" "a\rb" expectMatch 13.15 P "a\\tb" "a\tb" "a\tb" | | < < | | | < | < | < | < | 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 |
expectMatch 13.9 MP "a\\chb" "a\bb" "a\bb"
expectMatch 13.10 MP "a\\cHb" "a\bb" "a\bb"
expectMatch 13.11 LMP "a\\e" "a\033" "a\033"
expectMatch 13.12 P "a\\fb" "a\fb" "a\fb"
expectMatch 13.13 P "a\\nb" "a\nb" "a\nb"
expectMatch 13.14 P "a\\rb" "a\rb" "a\rb"
expectMatch 13.15 P "a\\tb" "a\tb" "a\tb"
expectMatch 13.16 - "a\u0008x" "a\bx" "a\bx"
expectMatch 13.19 - "a\U00000008x" "a\bx" "a\bx"
expectMatch 13.20 - "a\U0000008x" "a\bx" "a\bx"
expectMatch 13.21 P "a\\vb" "a\vb" "a\vb"
expectMatch 13.22 MP "a\\x08x" "a\bx" "a\bx"
expectError 13.23 - {a\xq} EESCAPE
expectMatch 13.24 MP "a\\x08x" "a\bx" "a\bx"
expectError 13.25 - {a\z} EESCAPE
expectMatch 13.26 MP "a\\010b" "a\bb" "a\bb"
expectMatch 13.27 - "a\U00001234x" "a\u1234x" "a\u1234x"
expectMatch 13.29 - "a\U0001234x" "a\u1234x" "a\u1234x"
expectMatch 13.31 - "a\U000012345x" "a\u12345x" "a\u12345x"
expectMatch 13.33 - "a\U1000000x" "a\ufffd0x" "a\ufffd0x"
doing 14 "back references"
# ugh
expectMatch 14.1 RP {a(b*)c\1} abbcbb abbcbb bb
expectMatch 14.2 RP {a(b*)c\1} ac ac ""
expectNomatch 14.3 RP {a(b*)c\1} abbcb
|
| ︙ | ︙ |
Changes to tests/string.test.
| ︙ | ︙ | |||
276 277 278 279 280 281 282 |
test string-5.16 {string index, bytearray object with string obj shimmering} {
set str "0123456789\x00 abcdedfghi"
binary scan $str H* dump
string compare [string index $str 10] \x00
} 0
test string-5.17 {string index, bad integer} -body {
list [catch {string index "abc" 0o8} msg] $msg
| | | | 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 |
test string-5.16 {string index, bytearray object with string obj shimmering} {
set str "0123456789\x00 abcdedfghi"
binary scan $str H* dump
string compare [string index $str 10] \x00
} 0
test string-5.17 {string index, bad integer} -body {
list [catch {string index "abc" 0o8} msg] $msg
} -match glob -result {1 {*}}
test string-5.18 {string index, bad integer} -body {
list [catch {string index "abc" end-0o0289} msg] $msg
} -match glob -result {1 {*}}
test string-5.19 {string index, bytearray object out of bounds} {
string index [binary format I* {0x50515253 0x52}] -1
} {}
test string-5.20 {string index, bytearray object out of bounds} {
string index [binary format I* {0x50515253 0x52}] 20
} {}
|
| ︙ | ︙ |
Changes to tests/stringComp.test.
| ︙ | ︙ | |||
351 352 353 354 355 356 357 |
string compare [string index $str 10] \x00
}
foo
} 0
test stringComp-5.17 {string index, bad integer} -body {
proc foo {} {string index "abc" 0o8}
list [catch {foo} msg] $msg
| | | | 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 |
string compare [string index $str 10] \x00
}
foo
} 0
test stringComp-5.17 {string index, bad integer} -body {
proc foo {} {string index "abc" 0o8}
list [catch {foo} msg] $msg
} -match glob -result {1 {*}}
test stringComp-5.18 {string index, bad integer} -body {
proc foo {} {string index "abc" end-0o0289}
list [catch {foo} msg] $msg
} -match glob -result {1 {*}}
test stringComp-5.19 {string index, bytearray object out of bounds} {
proc foo {} {string index [binary format I* {0x50515253 0x52}] -1}
foo
} {}
test stringComp-5.20 {string index, bytearray object out of bounds} {
proc foo {} {string index [binary format I* {0x50515253 0x52}] 20}
foo
|
| ︙ | ︙ |
Changes to tests/tm.test.
| ︙ | ︙ | |||
198 199 200 201 202 203 204 205 206 207 208 209 210 211 |
proc genpaths {base} {
# Normalizing picks up drive letters on windows [Bug 1053568]
set base [file normalize $base]
lassign [split [package present Tcl] .] major minor
set results {}
set base [file join $base tcl$major]
lappend results [file join $base site-tcl]
for {set i 0} {$i <= $minor} {incr i} {
lappend results [file join $base ${major}.$i]
}
return $results
}
| > > > > > | 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 |
proc genpaths {base} {
# Normalizing picks up drive letters on windows [Bug 1053568]
set base [file normalize $base]
lassign [split [package present Tcl] .] major minor
set results {}
set base8 [file join $base tcl8]
lappend results [file join $base8 site-tcl]
for {set i 0} {$i <= 7} {incr i} {
lappend results [file join $base8 8.$i]
}
set base [file join $base tcl$major]
lappend results [file join $base site-tcl]
for {set i 0} {$i <= $minor} {incr i} {
lappend results [file join $base ${major}.$i]
}
return $results
}
|
| ︙ | ︙ |
Changes to tests/trace.test.
| ︙ | ︙ | |||
1223 1224 1225 1226 1227 1228 1229 |
} {x {} write}
# Be sure that procedure frames are released before unset traces
# are invoked.
test trace-18.1 {unset traces on procedure returns} {
proc p1 {x y} {set a 44; p2 14}
| | | 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 |
} {x {} write}
# Be sure that procedure frames are released before unset traces
# are invoked.
test trace-18.1 {unset traces on procedure returns} {
proc p1 {x y} {set a 44; p2 14}
proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 2 {info vars}]}}}
set info {}
p1 foo bar
set info
} {0 {a x y}}
test trace-18.2 {namespace delete / trace vdelete combo} {
namespace eval ::foo {
variable x 123
|
| ︙ | ︙ | |||
1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 |
append info [catch {set ::$vtraced}][llength [info vars ::ref::*]]
}
set info {}
namespace delete ::ref
rename doTrace {}
set info
} 1110
# Delete arrays when done, so they can be re-used as scalars
# elsewhere.
unset -nocomplain x y
test trace-19.0.1 {trace add command (command existence)} {
| > > > > > > > > > > > > > > > > > > > > > | 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 |
append info [catch {set ::$vtraced}][llength [info vars ::ref::*]]
}
set info {}
namespace delete ::ref
rename doTrace {}
set info
} 1110
test trace-18.5 {Bug 7f02ff1efa} -setup {
proc constant {name value} {
upvar 1 $name c
set c $value
trace variable c wu [list reset $value]
}
proc reset {v a i o} {
uplevel 1 [list constant $a $v]
}
proc demo {} {
constant pi 3.14
}
} -body {
unset -nocomplain pi
demo
info exists pi
} -cleanup {
rename demo {}
rename reset {}
rename constant {}
} -result 0
# Delete arrays when done, so they can be re-used as scalars
# elsewhere.
unset -nocomplain x y
test trace-19.0.1 {trace add command (command existence)} {
|
| ︙ | ︙ |
Changes to tests/while-old.test.
| ︙ | ︙ | |||
88 89 90 91 92 93 94 |
test while-old-4.3 {errors in while loops} {
set err [catch {while 1 2 3} msg]
list $err $msg
} {1 {wrong # args: should be "while test command"}}
test while-old-4.4 {errors in while loops} {
set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
list $err $msg
| | | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 |
test while-old-4.3 {errors in while loops} {
set err [catch {while 1 2 3} msg]
list $err $msg
} {1 {wrong # args: should be "while test command"}}
test while-old-4.4 {errors in while loops} {
set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
list $err $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
test while-old-4.5 {errors in while loops} {
catch {unset x}
set x 1
set err [catch {while {$x} {set x foo}} msg]
list $err $msg
} {1 {expected boolean value but got "foo"}}
test while-old-4.6 {errors in while loops} {
|
| ︙ | ︙ |
Changes to tests/while.test.
| ︙ | ︙ | |||
28 29 30 31 32 33 34 |
catch {while {$i<} break}
return $::errorInfo
} -cleanup {
unset i
} -match glob -result {*"while {$i<} break"}
test while-1.3 {TclCompileWhileCmd: error in test expression} -body {
while {"a"+"b"} {error "loop aborted"}
| | | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
catch {while {$i<} break}
return $::errorInfo
} -cleanup {
unset i
} -match glob -result {*"while {$i<} break"}
test while-1.3 {TclCompileWhileCmd: error in test expression} -body {
while {"a"+"b"} {error "loop aborted"}
} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
test while-1.4 {TclCompileWhileCmd: multiline test expr} -body {
set value 1
while {($tcl_platform(platform) != "foobar1") && \
($tcl_platform(platform) != "foobar2")} {
incr value
break
}
|
| ︙ | ︙ | |||
339 340 341 342 343 344 345 |
return $::errorInfo
} -match glob -cleanup {
unset i z
} -result {*"$z {$i<} {set x 1}"}
test while-4.4 {while (not compiled): error in test expression} -body {
set z while
$z {"a"+"b"} {error "loop aborted"}
| | | 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 |
return $::errorInfo
} -match glob -cleanup {
unset i z
} -result {*"$z {$i<} {set x 1}"}
test while-4.4 {while (not compiled): error in test expression} -body {
set z while
$z {"a"+"b"} {error "loop aborted"}
} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
test while-4.5 {while (not compiled): multiline test expr} -body {
set value 1
set z while
$z {($tcl_platform(platform) != "foobar1") && \
($tcl_platform(platform) != "foobar2")} {
incr value
break
|
| ︙ | ︙ |
Changes to tools/configure.ac.
1 2 3 4 | dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run to configure the dnl Makefile in this directory. AC_INIT(man2tcl.c) | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run to configure the
dnl Makefile in this directory.
AC_INIT(man2tcl.c)
AC_PREREQ(2.59)
# Recover information that Tcl computed with its configure script.
#--------------------------------------------------------------------
# See if there was a command-line option for where Tcl is; if
# not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------
DEF_VER=8.6
AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`)
if test ! -d $TCL_BIN_DIR; then
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
fi
if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
AC_MSG_ERROR(There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
|
| ︙ | ︙ |
Changes to tools/tcl.hpj.in.
1 2 3 4 5 6 7 | ; This file is maintained by HCW. Do not modify this file directly. [OPTIONS] HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | ; This file is maintained by HCW. Do not modify this file directly. [OPTIONS] HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual CNT=tcl90.cnt COPYRIGHT=Copyright © 2000 Ajuba Solutions HLP=tcl90.hlp [FILES] tcl.rtf [WINDOWS] main="Tcl/Tk Reference Manual",,0 |
| ︙ | ︙ |
Changes to tools/tsdPerf.c.
| ︙ | ︙ | |||
29 30 31 32 33 34 35 |
}
static int
tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) {
TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));
| | | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
}
static int
tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) {
TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));
Tcl_SetObjResult(interp, Tcl_NewLongObj(perf->value));
return TCL_OK;
}
int
Tsdperf_Init(Tcl_Interp *interp) {
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
|
| ︙ | ︙ |
Changes to unix/Makefile.in.
| ︙ | ︙ | |||
135 136 137 138 139 140 141 |
STUB_LIB_FILE = ${TCL_STUB_LIB_FILE}
TCL_STUB_LIB_FLAG = @TCL_STUB_LIB_FLAG@
#TCL_STUB_LIB_FLAG = -ltclstub
# To compile without backward compatibility and deprecated code uncomment the
# following
| | | | 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 |
STUB_LIB_FILE = ${TCL_STUB_LIB_FILE}
TCL_STUB_LIB_FLAG = @TCL_STUB_LIB_FLAG@
#TCL_STUB_LIB_FLAG = -ltclstub
# To compile without backward compatibility and deprecated code uncomment the
# following
#NO_DEPRECATED_FLAGS =
NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED
# Some versions of make, like SGI's, use the following variable to determine
# which shell to use for executing commands:
SHELL = @MAKEFILE_SHELL@
# Tcl used to let the configure script choose which program to use for
# installing, but there are just too many different versions of "install"
|
| ︙ | ︙ | |||
333 334 335 336 337 338 339 |
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 \
| < | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 |
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 \
${COMPAT_OBJS}
UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
tclUnixTime.o tclUnixInit.o tclUnixThrd.o \
tclUnixCompat.o
|
| ︙ | ︙ | |||
472 473 474 475 476 477 478 | $(GENERIC_DIR)/tclOODefineCmds.c \ $(GENERIC_DIR)/tclOOInfo.c \ $(GENERIC_DIR)/tclOOMethod.c \ $(GENERIC_DIR)/tclOOStubInit.c STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ | | < | 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 | $(GENERIC_DIR)/tclOODefineCmds.c \ $(GENERIC_DIR)/tclOOInfo.c \ $(GENERIC_DIR)/tclOOMethod.c \ $(GENERIC_DIR)/tclOOStubInit.c STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ $(GENERIC_DIR)/tclTomMathStubLib.c TOMMATH_SRCS = \ $(TOMMATH_DIR)/bncore.c \ $(TOMMATH_DIR)/bn_reverse.c \ $(TOMMATH_DIR)/bn_fast_s_mp_mul_digs.c \ $(TOMMATH_DIR)/bn_fast_s_mp_sqr.c \ $(TOMMATH_DIR)/bn_mp_add.c \ |
| ︙ | ︙ | |||
817 818 819 820 821 822 823 | do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ else true; \ fi; \ done; | | | | | | | | 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 | do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ else true; \ fi; \ done; @for i in opt0.4 http1.0 encoding ../tcl9 ../tcl9/9.0; \ do \ if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \ else true; \ fi; \ done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"; @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \ $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \ do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ done; @echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/"; @for i in $(TOP_DIR)/library/http1.0/*.tcl ; \ do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \ done; @echo "Installing package http 2.8.10 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/http-2.8.10.tm; @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"; @for i in $(TOP_DIR)/library/opt/*.tcl ; \ do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \ done; @echo "Installing package msgcat 1.6.0 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/msgcat-1.6.0.tm; @echo "Installing package tcltest 2.4.0 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/tcltest-2.4.0.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/platform-1.0.14.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/platform/shell-1.1.4.tm; @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/"; @for i in $(TOP_DIR)/library/encoding/*.enc ; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/encoding; \ done; @if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ]; then \ echo "Customizing tcl module path"; \ |
| ︙ | ︙ | |||
1694 1695 1696 1697 1698 1699 1700 | tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLib.c tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c | < < < | 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 | tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLib.c tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c .c.o: $(CC) -c $(CC_SWITCHES) $< #-------------------------------------------------------------------------- # Bundled Package targets #-------------------------------------------------------------------------- |
| ︙ | ︙ | |||
2061 2062 2063 2064 2065 2066 2067 | rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME) cd $(DISTROOT); tar cf $(DISTNAME)-src.tar $(DISTNAME); \ gzip -9 $(DISTNAME)-src.tar; zip -qr8 $(ZIPNAME) $(DISTNAME) #-------------------------------------------------------------------------- # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool | | | | 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 | rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME) cd $(DISTROOT); tar cf $(DISTNAME)-src.tar $(DISTNAME); \ gzip -9 $(DISTNAME)-src.tar; zip -qr8 $(ZIPNAME) $(DISTNAME) #-------------------------------------------------------------------------- # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool # workspace. It depends on the Tcl & Tk being in directories called tcl9.* & # tk9.* up two directories from the TOOL_DIR. # # Note that for platforms where this is important, it is more common to use a # build of this HTML documentation that has already been placed online. As # such, this rule is not guaranteed to work well on all systems; it only needs # to function on those of the Tcl/Tk maintainers. # # Also note that the 8.6 tool build requires an installed 8.6 native Tcl |
| ︙ | ︙ |
Changes to unix/configure.
1 2 | #! /bin/sh # Guess values for system-dependent variables and create Makefiles. | | | 1 2 3 4 5 6 7 8 9 10 | #! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.69 for tcl 9.0. # # # Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. # # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. |
| ︙ | ︙ | |||
573 574 575 576 577 578 579 | subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' | | | | 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 | subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' PACKAGE_VERSION='9.0' PACKAGE_STRING='tcl 9.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' # Factoring default headers for most tests. ac_includes_default="\ #include <stdio.h> #ifdef HAVE_SYS_TYPES_H |
| ︙ | ︙ | |||
1315 1316 1317 1318 1319 1320 1321 | # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF | | | 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 | # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures tcl 9.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. |
| ︙ | ︙ | |||
1376 1377 1378 1379 1380 1381 1382 | cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in | | | 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 |
cat <<\_ACEOF
_ACEOF
fi
if test -n "$ac_init_help"; then
case $ac_init_help in
short | recursive ) echo "Configuration of tcl 9.0:";;
esac
cat <<\_ACEOF
Optional Features:
--disable-option-checking ignore unrecognized --enable/--with options
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
|
| ︙ | ︙ | |||
1490 1491 1492 1493 1494 1495 1496 |
cd "$ac_pwd" || { ac_status=$?; break; }
done
fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
| | | 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 |
cd "$ac_pwd" || { ac_status=$?; break; }
done
fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
tcl configure 9.0
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
exit
|
| ︙ | ︙ | |||
1966 1967 1968 1969 1970 1971 1972 |
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
} # ac_fn_c_check_member
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
| | | 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 |
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
} # ac_fn_c_check_member
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by tcl $as_me 9.0, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
_ACEOF
exec 5>>config.log
{
|
| ︙ | ︙ | |||
2318 2319 2320 2321 2322 2323 2324 | ac_compiler_gnu=$ac_cv_c_compiler_gnu | | | | | 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 |
ac_compiler_gnu=$ac_cv_c_compiler_gnu
TCL_VERSION=9.0
TCL_MAJOR_VERSION=9
TCL_MINOR_VERSION=0
TCL_PATCH_LEVEL="a0"
VERSION=${TCL_VERSION}
EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"}
#------------------------------------------------------------------------
|
| ︙ | ︙ | |||
4981 4982 4983 4984 4985 4986 4987 |
TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
ECHO_VERSION='`echo ${VERSION}`'
TCL_LIB_VERSIONS_OK=ok
CFLAGS_DEBUG=-g
if test "$GCC" = yes; then :
CFLAGS_OPTIMIZE=-O2
| | | 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 |
TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
ECHO_VERSION='`echo ${VERSION}`'
TCL_LIB_VERSIONS_OK=ok
CFLAGS_DEBUG=-g
if test "$GCC" = yes; then :
CFLAGS_OPTIMIZE=-O2
CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement"
else
CFLAGS_OPTIMIZE=-O
CFLAGS_WARNING=""
fi
|
| ︙ | ︙ | |||
11016 11017 11018 11019 11020 11021 11022 | test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" | | | 11016 11017 11018 11019 11020 11021 11022 11023 11024 11025 11026 11027 11028 11029 11030 | test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by tcl $as_me 9.0, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ |
| ︙ | ︙ | |||
11073 11074 11075 11076 11077 11078 11079 | Report bugs to the package provider." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ | | | 11073 11074 11075 11076 11077 11078 11079 11080 11081 11082 11083 11084 11085 11086 11087 | Report bugs to the package provider." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ tcl config.status 9.0 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" Copyright (C) 2012 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." |
| ︙ | ︙ |
Changes to unix/configure.ac.
1 2 3 4 5 | #! /bin/bash -norc dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. | | | | | | | 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 |
#! /bin/bash -norc
dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
AC_INIT([tcl],[9.0])
AC_PREREQ(2.59)
dnl This is only used when included from macosx/configure.ac
m4_ifdef([SC_USE_CONFIG_HEADERS], [
AC_CONFIG_HEADERS([tclConfig.h:../unix/tclConfig.h.in])
AC_CONFIG_COMMANDS_PRE([DEFS="-DHAVE_TCL_CONFIG_H -imacros tclConfig.h"])
AH_TOP([
#ifndef _TCLCONFIG
#define _TCLCONFIG])
AH_BOTTOM([
/* Undef unused package specific autoheader defines so that we can
* include both tclConfig.h and tkConfig.h at the same time: */
/* override */ #undef PACKAGE_NAME
/* override */ #undef PACKAGE_STRING
/* override */ #undef PACKAGE_TARNAME
#endif /* _TCLCONFIG */])
])
TCL_VERSION=9.0
TCL_MAJOR_VERSION=9
TCL_MINOR_VERSION=0
TCL_PATCH_LEVEL="a0"
VERSION=${TCL_VERSION}
EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"}
#------------------------------------------------------------------------
|
| ︙ | ︙ |
Changes to unix/dltest/pkga.c.
1 2 3 4 5 6 7 8 9 10 11 12 | /* * pkga.c -- * * This file contains a simple Tcl package "pkga" that is intended for * testing the Tcl dynamic loading facilities. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | /* * pkga.c -- * * This file contains a simple Tcl package "pkga" that is intended for * testing the Tcl dynamic loading facilities. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" /* * Prototypes for procedures defined later in this file: */ static int Pkga_EqObjCmd(ClientData clientData, |
| ︙ | ︙ | |||
59 60 61 62 63 64 65 |
str1 = Tcl_GetStringFromObj(objv[1], &len1);
str2 = Tcl_GetStringFromObj(objv[2], &len2);
if (len1 == len2) {
result = (Tcl_UtfNcmp(str1, str2, len1) == 0);
} else {
result = 0;
}
| | | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 |
str1 = Tcl_GetStringFromObj(objv[1], &len1);
str2 = Tcl_GetStringFromObj(objv[2], &len2);
if (len1 == len2) {
result = (Tcl_UtfNcmp(str1, str2, len1) == 0);
} else {
result = 0;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Pkga_QuoteObjCmd --
|
| ︙ | ︙ | |||
119 120 121 122 123 124 125 |
DLLEXPORT int
Pkga_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
| | | | 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 |
DLLEXPORT int
Pkga_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvideEx(interp, "Pkga", "1.0", NULL);
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand(interp, "pkga_eq", Pkga_EqObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "pkga_quote", Pkga_QuoteObjCmd, NULL,
NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgb.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * pkgb.c -- * * This file contains a simple Tcl package "pkgb" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * pkgb.c -- * * This file contains a simple Tcl package "pkgb" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" /* * Prototypes for procedures defined later in this file: */ static int Pkgb_SubObjCmd(ClientData clientData, |
| ︙ | ︙ | |||
62 63 64 65 66 67 68 |
if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
|| (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
char buf[TCL_INTEGER_SPACE];
sprintf(buf, "%d", Tcl_GetErrorLine(interp));
Tcl_AppendResult(interp, " in line: ", buf, NULL);
return TCL_ERROR;
}
| | | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
|| (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
char buf[TCL_INTEGER_SPACE];
sprintf(buf, "%d", Tcl_GetErrorLine(interp));
Tcl_AppendResult(interp, " in line: ", buf, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(first - second));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Pkgb_UnsafeObjCmd --
|
| ︙ | ︙ |
Changes to unix/dltest/pkgc.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * pkgc.c -- * * This file contains a simple Tcl package "pkgc" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * pkgc.c -- * * This file contains a simple Tcl package "pkgc" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" /* * Prototypes for procedures defined later in this file: */ static int Pkgc_SubObjCmd(ClientData clientData, |
| ︙ | ︙ | |||
53 54 55 56 57 58 59 |
Tcl_WrongNumArgs(interp, 1, objv, "num num");
return TCL_ERROR;
}
if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
|| (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
return TCL_ERROR;
}
| | | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 |
Tcl_WrongNumArgs(interp, 1, objv, "num num");
return TCL_ERROR;
}
if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
|| (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(first - second));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Pkgc_UnsafeCmd --
|
| ︙ | ︙ | |||
109 110 111 112 113 114 115 |
DLLEXPORT int
Pkgc_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
| | | | 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 |
DLLEXPORT int
Pkgc_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL);
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd, NULL,
NULL);
return TCL_OK;
|
| ︙ | ︙ | |||
146 147 148 149 150 151 152 |
DLLEXPORT int
Pkgc_SafeInit(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
| | | | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 |
DLLEXPORT int
Pkgc_SafeInit(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL);
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgd.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * pkgd.c -- * * This file contains a simple Tcl package "pkgd" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * pkgd.c -- * * This file contains a simple Tcl package "pkgd" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" /* * Prototypes for procedures defined later in this file: */ static int Pkgd_SubObjCmd(ClientData clientData, |
| ︙ | ︙ | |||
53 54 55 56 57 58 59 |
Tcl_WrongNumArgs(interp, 1, objv, "num num");
return TCL_ERROR;
}
if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
|| (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
return TCL_ERROR;
}
| | | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 |
Tcl_WrongNumArgs(interp, 1, objv, "num num");
return TCL_ERROR;
}
if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
|| (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(first - second));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Pkgd_UnsafeCmd --
|
| ︙ | ︙ | |||
109 110 111 112 113 114 115 |
DLLEXPORT int
Pkgd_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
| | | | 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 |
DLLEXPORT int
Pkgd_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL);
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd, NULL,
NULL);
return TCL_OK;
|
| ︙ | ︙ | |||
146 147 148 149 150 151 152 |
DLLEXPORT int
Pkgd_SafeInit(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
| | | | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 |
DLLEXPORT int
Pkgd_SafeInit(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL);
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkge.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * pkge.c -- * * This file contains a simple Tcl package "pkge" that is intended for * testing the Tcl dynamic loading facilities. Its Init procedure returns * an error in order to test how this is handled. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ | < > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | /* * pkge.c -- * * This file contains a simple Tcl package "pkge" that is intended for * testing the Tcl dynamic loading facilities. Its Init procedure returns * an error in order to test how this is handled. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" /* *---------------------------------------------------------------------- * * Pkge_Init -- * * This is a package initialization procedure, which is called by Tcl |
| ︙ | ︙ | |||
34 35 36 37 38 39 40 |
DLLEXPORT int
Pkge_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
static const char script[] = "if 44 {open non_existent}";
| | | 34 35 36 37 38 39 40 41 42 43 44 45 |
DLLEXPORT int
Pkge_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
static const char script[] = "if 44 {open non_existent}";
if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
return Tcl_EvalEx(interp, script, -1, 0);
}
|
Changes to unix/dltest/pkgooa.c.
| ︙ | ︙ | |||
74 75 76 77 78 79 80 |
* stub table, since the test-case never actually
* calls this function. All that matters is that it's
* a function with a different memory address than
* the real Tcl_CopyObjectInstance function in Tcl. */
(Tcl_Object (*) (Tcl_Interp *, Tcl_Object, const char *,
const char *t)) Pkgooa_StubsOKObjCmd
/* More entries could be here, but those are not used
| | < < < < < < < < | | 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 |
* stub table, since the test-case never actually
* calls this function. All that matters is that it's
* a function with a different memory address than
* the real Tcl_CopyObjectInstance function in Tcl. */
(Tcl_Object (*) (Tcl_Interp *, Tcl_Object, const char *,
const char *t)) Pkgooa_StubsOKObjCmd
/* More entries could be here, but those are not used
* needed for this test-case. So, being NULL is OK. */
};
extern DLLEXPORT int
Pkgooa_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
if (tclStubsPtr == NULL) {
Tcl_AppendResult(interp, "Tcl stubs are not inialized, "
"did you compile using -DUSE_TCL_STUBS? ");
return TCL_ERROR;
}
|
| ︙ | ︙ |
Changes to unix/dltest/pkgua.c.
| ︙ | ︙ | |||
134 135 136 137 138 139 140 |
str1 = Tcl_GetStringFromObj(objv[1], &len1);
str2 = Tcl_GetStringFromObj(objv[2], &len2);
if (len1 == len2) {
result = (Tcl_UtfNcmp(str1, str2, len1) == 0);
} else {
result = 0;
}
| | | 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 |
str1 = Tcl_GetStringFromObj(objv[1], &len1);
str2 = Tcl_GetStringFromObj(objv[2], &len2);
if (len1 == len2) {
result = (Tcl_UtfNcmp(str1, str2, len1) == 0);
} else {
result = 0;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* PkguaQuoteObjCmd --
|
| ︙ | ︙ | |||
195 196 197 198 199 200 201 |
Pkgua_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code, cmdIndex = 0;
Tcl_Command *cmdTokens;
| | | | 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 |
Pkgua_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code, cmdIndex = 0;
Tcl_Command *cmdTokens;
if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
/*
* Initialise our Hash table, where we store the registered command tokens
* for each interpreter.
*/
PkguaInitTokensHashTable();
code = Tcl_PkgProvideEx(interp, "Pkgua", "1.0", NULL);
if (code != TCL_OK) {
return code;
}
Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE);
cmdTokens = PkguaInterpToTokens(interp);
|
| ︙ | ︙ |
Changes to unix/tcl.m4.
| ︙ | ︙ | |||
1092 1093 1094 1095 1096 1097 1098 |
UNSHARED_LIB_SUFFIX=""
TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
ECHO_VERSION='`echo ${VERSION}`'
TCL_LIB_VERSIONS_OK=ok
CFLAGS_DEBUG=-g
AS_IF([test "$GCC" = yes], [
CFLAGS_OPTIMIZE=-O2
| | | 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 |
UNSHARED_LIB_SUFFIX=""
TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
ECHO_VERSION='`echo ${VERSION}`'
TCL_LIB_VERSIONS_OK=ok
CFLAGS_DEBUG=-g
AS_IF([test "$GCC" = yes], [
CFLAGS_OPTIMIZE=-O2
CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement"
], [
CFLAGS_OPTIMIZE=-O
CFLAGS_WARNING=""
])
AC_CHECK_TOOL(AR, ar)
STLIB_LD='${AR} cr'
LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
|
| ︙ | ︙ |
Changes to unix/tcl.spec.
1 2 3 4 5 6 |
# This file is the basis for a binary Tcl RPM for Linux.
%{!?directory:%define directory /usr/local}
Name: tcl
Summary: Tcl scripting language development environment
| | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
# This file is the basis for a binary Tcl RPM for Linux.
%{!?directory:%define directory /usr/local}
Name: tcl
Summary: Tcl scripting language development environment
Version: 9.0a0
Release: 2
License: BSD
Group: Development/Languages
Source: http://prdownloads.sourceforge.net/tcl/tcl%{version}-src.tar.gz
URL: http://www.tcl.tk/
Buildroot: /var/tmp/%{name}%{version}
|
| ︙ | ︙ |
Changes to unix/tclConfig.h.in.
| ︙ | ︙ | |||
108 109 110 111 112 113 114 | /* Define to 1 if getpwuid_r takes 5 args. */ #undef HAVE_GETPWUID_R_5 /* Define to 1 if you have the `gmtime_r' function. */ #undef HAVE_GMTIME_R | < < < | 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | /* Define to 1 if getpwuid_r takes 5 args. */ #undef HAVE_GETPWUID_R_5 /* Define to 1 if you have the `gmtime_r' function. */ #undef HAVE_GMTIME_R /* Do we have the intptr_t type? */ #undef HAVE_INTPTR_T /* Define to 1 if you have the <inttypes.h> header file. */ #undef HAVE_INTTYPES_H /* Do we have nl_langinfo()? */ |
| ︙ | ︙ | |||
332 333 334 335 336 337 338 339 340 341 342 343 344 345 | #undef NO_UNAME /* Do we have a usable 'union wait'? */ #undef NO_UNION_WAIT /* Do we have <values.h>? */ #undef NO_VALUES_H /* Do we have wait3() */ #undef NO_WAIT3 /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT | > > > | 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 | #undef NO_UNAME /* Do we have a usable 'union wait'? */ #undef NO_UNION_WAIT /* Do we have <values.h>? */ #undef NO_VALUES_H /* Compiler support for module scope symbols */ #undef HAVE_HIDDEN /* Do we have wait3() */ #undef NO_WAIT3 /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT |
| ︙ | ︙ |
Changes to unix/tclUnixCompat.c.
1 2 3 4 5 6 7 8 9 10 | /* * tclUnixCompat.c * * Written by: Zoran Vasiljevic (vasiljevic@users.sourceforge.net). * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" | < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclUnixCompat.c * * Written by: Zoran Vasiljevic (vasiljevic@users.sourceforge.net). * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include <errno.h> #include <string.h> /* * See also: SC_BLOCKING_STYLE in unix/tcl.m4 */ |
| ︙ | ︙ |
Changes to unix/tclUnixFCmd.c.
| ︙ | ︙ | |||
37 38 39 40 41 42 43 | * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. */ #include "tclInt.h" | < < | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. */ #include "tclInt.h" #ifndef HAVE_STRUCT_STAT_ST_BLKSIZE #ifndef NO_FSTATFS #include <sys/statfs.h> #endif #endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */ #ifdef HAVE_FTS #include <fts.h> |
| ︙ | ︙ | |||
1365 1366 1367 1368 1369 1370 1371 |
}
return TCL_ERROR;
}
groupPtr = TclpGetGrGid(statBuf.st_gid);
if (groupPtr == NULL) {
| | | 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 |
}
return TCL_ERROR;
}
groupPtr = TclpGetGrGid(statBuf.st_gid);
if (groupPtr == NULL) {
*attributePtrPtr = Tcl_NewLongObj((long) statBuf.st_gid);
} else {
Tcl_DString ds;
const char *utf;
utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds);
*attributePtrPtr = Tcl_NewStringObj(utf, -1);
Tcl_DStringFree(&ds);
|
| ︙ | ︙ | |||
1419 1420 1421 1422 1423 1424 1425 |
}
return TCL_ERROR;
}
pwPtr = TclpGetPwUid(statBuf.st_uid);
if (pwPtr == NULL) {
| | | 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 |
}
return TCL_ERROR;
}
pwPtr = TclpGetPwUid(statBuf.st_uid);
if (pwPtr == NULL) {
*attributePtrPtr = Tcl_NewLongObj((long) statBuf.st_uid);
} else {
Tcl_DString ds;
(void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
*attributePtrPtr = TclDStringToObj(&ds);
}
return TCL_OK;
|
| ︙ | ︙ | |||
2437 2438 2439 2440 2441 2442 2443 |
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not read \"%s\": %s",
TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
| | | 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 |
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not read \"%s\": %s",
TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
*attributePtrPtr = Tcl_NewLongObj((statBuf.st_flags&UF_IMMUTABLE)!=0);
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to unix/tclUnixInit.c.
| ︙ | ︙ | |||
41 42 43 44 45 46 47 |
#define NUMPLATFORMS 4
static const char *const platforms[NUMPLATFORMS] = {
"Win32s", "Windows 95", "Windows NT", "Windows CE"
};
#define NUMPROCESSORS 11
| | | | | 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 |
#define NUMPLATFORMS 4
static const char *const platforms[NUMPLATFORMS] = {
"Win32s", "Windows 95", "Windows NT", "Windows CE"
};
#define NUMPROCESSORS 11
static const char *const processors[NUMPROCESSORS] = {
"intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
"amd64", "ia32_on_win64"
};
typedef struct {
union {
DWORD dwOemId;
struct {
int wProcessorArchitecture;
int wReserved;
};
};
DWORD dwPageSize;
void *lpMinimumApplicationAddress;
void *lpMaximumApplicationAddress;
void *dwActiveProcessorMask;
DWORD dwNumberOfProcessors;
DWORD dwProcessorType;
DWORD dwAllocationGranularity;
int wProcessorLevel;
int wProcessorRevision;
} SYSTEM_INFO;
typedef struct {
DWORD dwOSVersionInfoSize;
DWORD dwMajorVersion;
DWORD dwMinorVersion;
DWORD dwBuildNumber;
DWORD dwPlatformId;
wchar_t szCSDVersion[128];
} OSVERSIONINFOW;
|
| ︙ | ︙ |
Changes to unix/tclUnixPipe.c.
| ︙ | ︙ | |||
868 869 870 871 872 873 874 |
if (chanTypePtr != &pipeChannelType) {
return;
}
pipePtr = Tcl_GetChannelInstanceData(chan);
TclNewObj(pidsObj);
for (i = 0; i < pipePtr->numPids; i++) {
| | | 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 |
if (chanTypePtr != &pipeChannelType) {
return;
}
pipePtr = Tcl_GetChannelInstanceData(chan);
TclNewObj(pidsObj);
for (i = 0; i < pipePtr->numPids; i++) {
Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewLongObj(
PTR2INT(pipePtr->pidPtr[i])));
Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
}
Tcl_SetObjResult(interp, pidsObj);
if (pipePtr->numPids > 0) {
ckfree(pipePtr->pidPtr);
pipePtr->numPids = 0;
|
| ︙ | ︙ | |||
1286 1287 1288 1289 1290 1291 1292 |
* Extract the process IDs from the pipe structure.
*/
pipePtr = Tcl_GetChannelInstanceData(chan);
resultPtr = Tcl_NewObj();
for (i = 0; i < pipePtr->numPids; i++) {
Tcl_ListObjAppendElement(NULL, resultPtr,
| | | 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 |
* Extract the process IDs from the pipe structure.
*/
pipePtr = Tcl_GetChannelInstanceData(chan);
resultPtr = Tcl_NewObj();
for (i = 0; i < pipePtr->numPids; i++) {
Tcl_ListObjAppendElement(NULL, resultPtr,
Tcl_NewLongObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i]))));
}
Tcl_SetObjResult(interp, resultPtr);
}
return TCL_OK;
}
/*
|
| ︙ | ︙ |
Changes to unix/tclUnixTest.c.
| ︙ | ︙ | |||
64 65 66 67 68 69 70 | static Tcl_CmdProc TestalarmCmd; static Tcl_ObjCmdProc TestchmodCmd; static Tcl_CmdProc TestfilehandlerCmd; static Tcl_CmdProc TestfilewaitCmd; static Tcl_CmdProc TestfindexecutableCmd; static Tcl_ObjCmdProc TestforkObjCmd; | | | | 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | static Tcl_CmdProc TestalarmCmd; static Tcl_ObjCmdProc TestchmodCmd; static Tcl_CmdProc TestfilehandlerCmd; static Tcl_CmdProc TestfilewaitCmd; static Tcl_CmdProc TestfindexecutableCmd; static Tcl_ObjCmdProc TestforkObjCmd; static Tcl_ObjCmdProc TestgetdefencdirCmd; static Tcl_CmdProc TestgetopenfileCmd; static Tcl_CmdProc TestgotsigCmd; static Tcl_ObjCmdProc TestsetdefencdirCmd; static Tcl_FileProc TestFileHandlerProc; static void AlarmHandler(int signum); /* *---------------------------------------------------------------------- * * TclplatformtestInit -- |
| ︙ | ︙ | |||
104 105 106 107 108 109 110 |
NULL, NULL);
Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
NULL, NULL);
| | | | 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 |
NULL, NULL);
Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
NULL, NULL);
return TCL_OK;
}
|
| ︙ | ︙ | |||
513 514 515 516 517 518 519 |
*----------------------------------------------------------------------
*/
static int
TestsetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | > > | < | > | > > > > | 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 |
*----------------------------------------------------------------------
*/
static int
TestsetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
Tcl_Obj *searchPath;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "defaultDir");
return TCL_ERROR;
}
searchPath = Tcl_GetEncodingSearchPath();
searchPath = Tcl_DuplicateObj(searchPath);
Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &objv[1]);
Tcl_SetEncodingSearchPath(searchPath);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestforkObjCmd --
|
| ︙ | ︙ | |||
592 593 594 595 596 597 598 |
*----------------------------------------------------------------------
*/
static int
TestgetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | > > > | > > > | > > > | > | | 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 |
*----------------------------------------------------------------------
*/
static int
TestgetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
int numDirs;
Tcl_Obj *first, *searchPath;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
searchPath = Tcl_GetEncodingSearchPath();
Tcl_ListObjLength(interp, searchPath, &numDirs);
if (numDirs == 0) {
return TCL_ERROR;
}
Tcl_ListObjIndex(NULL, searchPath, 0, &first);
Tcl_SetObjResult(interp, first);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestalarmCmd --
|
| ︙ | ︙ |
Changes to unix/tclUnixThrd.c.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef TCL_THREADS | < < < < < < | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef TCL_THREADS /* * masterLock is used to serialize creation of mutexes, condition variables, * and thread local storage. This is the only place that can count on the * ability to statically initialize the mutex. */ static pthread_mutex_t masterLock = PTHREAD_MUTEX_INITIALIZER; |
| ︙ | ︙ | |||
618 619 620 621 622 623 624 |
if (pcondPtr != NULL) {
pthread_cond_destroy(pcondPtr);
ckfree(pcondPtr);
*condPtr = NULL;
}
}
#endif /* TCL_THREADS */
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 612 613 614 615 616 617 618 619 620 621 622 623 624 625 |
if (pcondPtr != NULL) {
pthread_cond_destroy(pcondPtr);
ckfree(pcondPtr);
*condPtr = NULL;
}
}
#endif /* TCL_THREADS */
#ifdef TCL_THREADS
/*
* Additions by AOL for specialized thread memory allocator.
*/
#ifdef USE_THREAD_ALLOC
|
| ︙ | ︙ |
Changes to unix/tclUnixTime.c.
| ︙ | ︙ | |||
12 13 14 15 16 17 18 | #include "tclInt.h" #include <locale.h> #if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL) #include <mach/mach_time.h> #endif | < < < < < < < < < < < < < < < < < < < < < < < < < | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | #include "tclInt.h" #include <locale.h> #if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL) #include <mach/mach_time.h> #endif /* * Static functions declared in this file. */ static void NativeScaleTime(Tcl_Time *timebuf, ClientData clientData); static void NativeGetTime(Tcl_Time *timebuf, ClientData clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. |
| ︙ | ︙ | |||
244 245 246 247 248 249 250 |
{
tclGetTimeProcPtr(timePtr, tclTimeClientData);
}
/*
*----------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 219 220 221 222 223 224 225 226 227 228 229 230 231 232 |
{
tclGetTimeProcPtr(timePtr, tclTimeClientData);
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetTimeProc --
*
* TIP #233 (Virtualized Time): Registers two handlers for the
* virtualization of Tcl's access to time information.
*
* Results:
* None.
|
| ︙ | ︙ | |||
463 464 465 466 467 468 469 |
{
struct timeval tv;
(void) gettimeofday(&tv, NULL);
timePtr->sec = tv.tv_sec;
timePtr->usec = tv.tv_usec;
}
| < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 |
{
struct timeval tv;
(void) gettimeofday(&tv, NULL);
timePtr->sec = tv.tv_sec;
timePtr->usec = tv.tv_usec;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to win/Makefile.in.
| ︙ | ︙ | |||
77 78 79 80 81 82 83 | CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ # To change the compiler switches, for example to change from optimization to # debugging symbols, change the following line: #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) | | | | | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ # To change the compiler switches, for example to change from optimization to # debugging symbols, change the following line: #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE # To compile without backward compatibility and deprecated code uncomment the # following #NO_DEPRECATED_FLAGS = NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED # To enable compilation debugging reverse the comment characters on one of the # following lines. COMPILE_DEBUG_FLAGS = #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS |
| ︙ | ︙ | |||
389 390 391 392 393 394 395 | DDE_OBJS = tclWinDde.$(OBJEXT) REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ | | < | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 | DDE_OBJS = tclWinDde.$(OBJEXT) REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) ZLIB_OBJS = \ adler32.$(OBJEXT) \ compress.$(OBJEXT) \ crc32.$(OBJEXT) \ |
| ︙ | ︙ | |||
524 525 526 527 528 529 530 |
tclStubLib.${OBJEXT}: tclStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
| < < < | 523 524 525 526 527 528 529 530 531 532 533 534 535 536 |
tclStubLib.${OBJEXT}: tclStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
# Implicit rule for all object files that will end up in the Tcl library
%.${OBJEXT}: %.c
$(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME)
.rc.$(RES):
$(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@
|
| ︙ | ︙ | |||
620 621 622 623 624 625 626 | do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ $(MKDIR) $$i; \ else true; \ fi; \ done; | | | 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 | do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ $(MKDIR) $$i; \ else true; \ fi; \ done; @for i in http1.0 opt0.4 encoding ../tcl9 ../tcl9/9.0; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ $(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \ else true; \ fi; \ done; |
| ︙ | ︙ | |||
648 649 650 651 652 653 654 | done; @echo "Installing library http1.0 directory"; @for j in $(ROOT_DIR)/library/http1.0/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; @echo "Installing package http 2.8.10 as a Tcl Module"; | | | | | | | 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 | done; @echo "Installing library http1.0 directory"; @for j in $(ROOT_DIR)/library/http1.0/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; @echo "Installing package http 2.8.10 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/http-2.8.10.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.6.0 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/msgcat-1.6.0.tm; @echo "Installing package tcltest 2.4.0 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/tcltest-2.4.0.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/platform-1.0.14.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/platform/shell-1.1.4.tm; @echo "Installing encodings"; @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ done; install-tzdata: @echo "Installing time zone data" |
| ︙ | ︙ | |||
848 849 850 851 852 853 854 | $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ "$(GENERIC_DIR_NATIVE)/tclOO.decls" # # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool | | | | 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 | $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ "$(GENERIC_DIR_NATIVE)/tclOO.decls" # # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool # workspace. It depends on the Tcl & Tk being in directories called tcl9.* & # tk9.* up two directories from the TOOL_DIR. # TOOL_DIR=$(ROOT_DIR)/tools HTML_INSTALL_DIR=$(ROOT_DIR)/html html: $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)" |
| ︙ | ︙ |
Changes to win/README.
|
| | | | 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 | Tcl 9.0 for Windows 1. Introduction --------------- This is the directory where you configure and compile the Windows version of Tcl. This directory also contains source files for Tcl that are specific to Microsoft Windows. The information in this file is maintained on the web at: http://www.tcl.tk/doc/howto/compile.html#win 2. Compiling Tcl ---------------- In order to compile Tcl for Windows, you need the following: Tcl 9.0 Source Distribution (plus any patches) and Visual C++ 6 or newer or |
| ︙ | ︙ | |||
75 76 77 78 79 80 81 | and Msys, you can download a suitable win32 or win64 compiler from [https://sourceforge.net/projects/mingw-w64/files/] Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. | | | | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | and Msys, you can download a suitable win32 or win64 compiler from [https://sourceforge.net/projects/mingw-w64/files/] Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. Note that in order to run tclsh90.exe, you must ensure that tcl90.dll is on your path, in the system directory, or in the directory containing tclsh90.exe. Note: Tcl no longer provides support for Win32s. 3. Test suite ------------- This distribution contains an extensive test suite for Tcl. Some of the |
| ︙ | ︙ |
Changes to win/configure.
| ︙ | ︙ | |||
2094 2095 2096 2097 2098 2099 2100 | # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh | | | | | 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 | # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 TCL_PATCH_LEVEL="a0" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION |
| ︙ | ︙ | |||
4161 4162 4163 4164 4165 4166 4167 |
LIBFLAGSUFFIX="\${DBGX}"
SHLIB_SUFFIX=.dll
EXTRA_CFLAGS="${extra_cflags}"
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
| | | 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 |
LIBFLAGSUFFIX="\${DBGX}"
SHLIB_SUFFIX=.dll
EXTRA_CFLAGS="${extra_cflags}"
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
# Specify the CC output file names based on the target name
CC_OBJNAME="-o \$@"
CC_EXENAME="-o \$@"
|
| ︙ | ︙ |
Changes to win/configure.ac.
1 2 3 4 5 6 7 8 9 10 11 12 13 | #! /bin/bash -norc # This file is an input file used by the GNU "autoconf" program to # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. AC_INIT(../generic/tcl.h) AC_PREREQ(2.69) # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | #! /bin/bash -norc # This file is an input file used by the GNU "autoconf" program to # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. AC_INIT(../generic/tcl.h) AC_PREREQ(2.69) # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 TCL_PATCH_LEVEL="a0" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION |
| ︙ | ︙ |
Changes to win/makefile.bc.
| ︙ | ︙ | |||
119 120 121 122 123 124 125 | ###################################################################### # Do not modify below this line ###################################################################### NAMEPREFIX = tcl STUBPREFIX = $(NAMEPREFIX)stub | | | | 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | ###################################################################### # Do not modify below this line ###################################################################### NAMEPREFIX = tcl STUBPREFIX = $(NAMEPREFIX)stub DOTVERSION = 9.0 VERSION = 90 DDEVERSION = 14 DDEDOTVERSION = 1.4 REGVERSION = 13 REGDOTVERSION = 1.3 |
| ︙ | ︙ | |||
276 277 278 279 280 281 282 | $(TMPDIR)\tclWinSock.obj \ $(TMPDIR)\tclWinThrd.obj \ $(TMPDIR)\tclWinTime.obj \ $(TMPDIR)\tclZlib.obj TCLSTUBOBJS = \ $(TMPDIR)\tclStubLib.obj \ | | < | 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 | $(TMPDIR)\tclWinSock.obj \ $(TMPDIR)\tclWinThrd.obj \ $(TMPDIR)\tclWinTime.obj \ $(TMPDIR)\tclZlib.obj TCLSTUBOBJS = \ $(TMPDIR)\tclStubLib.obj \ $(TMPDIR)\tclTomMathStubLib.obj WINDIR = $(ROOT)\win GENERICDIR = $(ROOT)\generic TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES) $(SYMDEFINES) \ $(PROFDEFINES) $(OPTDEFINES) $(SIXFOURDEFINES) \ |
| ︙ | ︙ | |||
528 529 530 531 532 533 534 | $(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? | < < < | 527 528 529 530 531 532 533 534 535 536 537 538 539 540 | $(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? # Dedependency rules $(GENERICDIR)\regcomp.c: \ $(GENERICDIR)\regguts.h \ $(GENERICDIR)\regc_lex.c \ $(GENERICDIR)\regc_color.c \ |
| ︙ | ︙ |
Changes to win/makefile.vc.
| ︙ | ︙ | |||
447 448 449 450 451 452 453 | $(TMP_DIR)\tcl.res !endif TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ | | < | 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 | $(TMP_DIR)\tcl.res !endif TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ $(TMP_DIR)\tclTomMathStubLib.obj ### The following paths CANNOT have spaces in them. COMPATDIR = $(ROOT)\compat DOCDIR = $(ROOT)\doc GENERICDIR = $(ROOT)\generic TOMMATHDIR = $(ROOT)\libtommath TOOLSDIR = $(ROOT)\tools |
| ︙ | ︙ | |||
733 734 735 736 737 738 739 | # Build the Windows HTML help file. #--------------------------------------------------------------------- # NOTE: you can define HHC on the command-line to override this !ifndef HHC HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe"" !endif | | | | < < | | | | | | | 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 | # Build the Windows HTML help file. #--------------------------------------------------------------------- # NOTE: you can define HHC on the command-line to override this !ifndef HHC HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe"" !endif HTMLDIR=$(ROOT)\html HTMLBASE=TclTk$(VERSION) HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm htmlhelp: chmsetup $(CHMFILE) $(CHMFILE): $(DOCDIR)\* @$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl @echo Compiling HTML help project @$(HHC) <<$(HHPFILE) >NUL [OPTIONS] Compatibility=1.1 or later Compiled file=$(HTMLBASE).chm Display compile progress=no Error log file=$(HTMLBASE).log Language=0x409 English (United States) Title=Tcl/Tk $(DOT_VERSION) Help [FILES] contents.htm docs.css Keywords TclCmd TclLib TkCmd TkLib UserCmd << chmsetup: @if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR) #------------------------------------------------------------------------- # Build the old-style Windows .hlp file |
| ︙ | ︙ | |||
988 989 990 991 992 993 994 | $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? | < < < | 985 986 987 988 989 990 991 992 993 994 995 996 997 998 | $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? $(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in @nmakehlp -s << $** >$@ @MACHINE@ $(MACHINE:IX86=X86) @TCL_WIN_VERSION@ $(DOTVERSION).0.0 << #--------------------------------------------------------------------- |
| ︙ | ︙ | |||
1098 1099 1100 1101 1102 1103 1104 | @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\" #" emacs fix install-libraries: tclConfig install-msgs install-tzdata @if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)" | | | | < < | < < < < | 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 | @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\" #" emacs fix install-libraries: tclConfig install-msgs install-tzdata @if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)" @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9$(NULL)" \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9" @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0$(NULL)" \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0" @echo Installing header files @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\" |
| ︙ | ︙ | |||
1139 1140 1141 1142 1143 1144 1145 | @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\http1.0\" @echo Installing library opt0.4 directory @$(CPY) "$(ROOT)\library\opt\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\opt0.4\" @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\http\http.tcl" \ | | | | | | | 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 | @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\http1.0\" @echo Installing library opt0.4 directory @$(CPY) "$(ROOT)\library\opt\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\opt0.4\" @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\http\http.tcl" \ "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\http-$(PKG_HTTP_VER).tm" @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \ "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\msgcat-$(PKG_MSGCAT_VER).tm" @echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \ "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\tcltest-$(PKG_TCLTEST_VER).tm" @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\platform\platform.tcl" \ "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform-$(PKG_PLATFORM_VER).tm" @echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\platform\shell.tcl" \ "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform\shell-$(PKG_SHELL_VER).tm" @echo Installing $(TCLDDELIBNAME) !if $(STATIC_BUILD) !if !$(TCL_USE_STATIC_PACKAGES) @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\" !endif !else @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\" |
| ︙ | ︙ |
Changes to win/rules.vc.
| ︙ | ︙ | |||
155 156 157 158 159 160 161 | !if [nmakehlp -c -RTC1] DEBUGFLAGS = $(DEBUGFLAGS) -RTC1 !elseif [nmakehlp -c -GZ] DEBUGFLAGS = $(DEBUGFLAGS) -GZ !endif | | | 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 | !if [nmakehlp -c -RTC1] DEBUGFLAGS = $(DEBUGFLAGS) -RTC1 !elseif [nmakehlp -c -GZ] DEBUGFLAGS = $(DEBUGFLAGS) -GZ !endif COMPILERFLAGS =-W3 -DUNICODE -D_UNICODE # In v13 -GL and -YX are incompatible. !if [nmakehlp -c -YX] !if ![nmakehlp -c -GL] OPTIMIZATIONS = $(OPTIMIZATIONS) -YX !endif !endif |
| ︙ | ︙ | |||
226 227 228 229 230 231 232 | !else !if [nmakehlp -f $(OPTS) "static"] !message *** Doing static STATIC_BUILD = 1 !else STATIC_BUILD = 0 !endif | < < < < < | 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 | !else !if [nmakehlp -f $(OPTS) "static"] !message *** Doing static STATIC_BUILD = 1 !else STATIC_BUILD = 0 !endif !if [nmakehlp -f $(OPTS) "msvcrt"] !message *** Doing msvcrt MSVCRT = 1 !else !if !$(STATIC_BUILD) MSVCRT = 1 !else MSVCRT = 0 !endif !endif !if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD) !message *** Doing staticpkg TCL_USE_STATIC_PACKAGES = 1 !else TCL_USE_STATIC_PACKAGES = 0 |
| ︙ | ︙ |
Changes to win/tcl.dsp.
| ︙ | ︙ | |||
1294 1295 1296 1297 1298 1299 1300 | SOURCE=..\generic\tclStubInit.c # End Source File # Begin Source File SOURCE=..\generic\tclStubLib.c # End Source File | < < < < | 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 | SOURCE=..\generic\tclStubInit.c # End Source File # Begin Source File SOURCE=..\generic\tclStubLib.c # End Source File # Begin Source File SOURCE=..\generic\tclTomMathStubLib.c # End Source File # Begin Source File SOURCE=..\generic\tclTest.c |
| ︙ | ︙ |
Changes to win/tcl.m4.
| ︙ | ︙ | |||
723 724 725 726 727 728 729 |
LIBFLAGSUFFIX="\${DBGX}"
SHLIB_SUFFIX=.dll
EXTRA_CFLAGS="${extra_cflags}"
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
| | | 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 |
LIBFLAGSUFFIX="\${DBGX}"
SHLIB_SUFFIX=.dll
EXTRA_CFLAGS="${extra_cflags}"
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
# Specify the CC output file names based on the target name
CC_OBJNAME="-o \[$]@"
CC_EXENAME="-o \[$]@"
|
| ︙ | ︙ | |||
1122 1123 1124 1125 1126 1127 1128 | # --with-tcl=... # # Defines the following vars: # TCL_BIN_DIR Full path to the tcl build dir. #------------------------------------------------------------------------ AC_DEFUN([SC_WITH_TCL], [ | | | | | | 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 |
# --with-tcl=...
#
# Defines the following vars:
# TCL_BIN_DIR Full path to the tcl build dir.
#------------------------------------------------------------------------
AC_DEFUN([SC_WITH_TCL], [
if test -d ../../tcl9.0$1/win; then
TCL_BIN_DEFAULT=../../tcl9.0$1/win
else
TCL_BIN_DEFAULT=../../tcl9.0/win
fi
AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 9.0 binaries from DIR],
TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
if test ! -d $TCL_BIN_DIR; then
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
fi
if test ! -f $TCL_BIN_DIR/Makefile; then
AC_MSG_ERROR(There is no Makefile in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
else
|
| ︙ | ︙ |
Changes to win/tcl.rc.
1 2 3 4 | // Version Resource Script // #include <winver.h> | | | 1 2 3 4 5 6 7 8 9 10 11 12 | // Version Resource Script // #include <winver.h> #include "tclWinInt.h" // // build-up the name suffix that defines the type of build this is. // #if TCL_THREADS #define SUFFIX_THREADS "t" #else |
| ︙ | ︙ |
Changes to win/tclWinDde.c.
| ︙ | ︙ | |||
55 56 57 58 59 60 61 |
struct Conversation *nextPtr;
/* The next conversation in the list. */
RegisteredInterp *riPtr; /* The info we know about the conversation. */
HCONV hConv; /* The DDE handle for this conversation. */
Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
} Conversation;
| | | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
struct Conversation *nextPtr;
/* The next conversation in the list. */
RegisteredInterp *riPtr; /* The info we know about the conversation. */
HCONV hConv; /* The DDE handle for this conversation. */
Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
} Conversation;
typedef struct {
Tcl_Interp *interp;
int result;
ATOM service;
ATOM topic;
HWND hwnd;
} DdeEnumServices;
typedef struct {
Conversation *currentConversations;
/* A list of conversations currently being
* processed. */
RegisteredInterp *interpListPtr;
/* List of all interpreters registered in the
|
| ︙ | ︙ | |||
100 101 102 103 104 105 106 | /* * Forward declarations for functions defined later in this file. */ static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); | | | | | 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 | /* * Forward declarations for functions defined later in this file. */ static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); static int DdeCreateClient(DdeEnumServices *es); static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); static void DdeExitProc(ClientData clientData); static int DdeGetServicesList(Tcl_Interp *interp, const TCHAR *serviceName, const TCHAR *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam); static void DeleteProc(ClientData clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); static int MakeDdeConnection(Tcl_Interp *interp, const TCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); DLLEXPORT int Dde_Init(Tcl_Interp *interp); DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- * * Dde_Init -- * * This function initializes the dde command. |
| ︙ | ︙ | |||
144 145 146 147 148 149 150 |
*----------------------------------------------------------------------
*/
int
Dde_Init(
Tcl_Interp *interp)
{
| | < < < < < < < | | 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 |
*----------------------------------------------------------------------
*/
int
Dde_Init(
Tcl_Interp *interp)
{
if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
return TCL_ERROR;
}
Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
Tcl_CreateExitHandler(DdeExitProc, NULL);
return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL);
}
/*
*----------------------------------------------------------------------
*
* Dde_SafeInit --
*
|
| ︙ | ︙ | |||
383 384 385 386 387 388 389 390 391 |
/*
* See if the name is already in use, if so increment suffix.
*/
for (n = 0; n < srvCount; ++n) {
Tcl_Obj* namePtr;
Tcl_DString ds;
Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
| > > > | | 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 |
/*
* See if the name is already in use, if so increment suffix.
*/
for (n = 0; n < srvCount; ++n) {
Tcl_Obj* namePtr;
Tcl_DString ds;
const char *nameStr;
int len;
Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
nameStr = Tcl_GetStringFromObj(namePtr, &len);
Tcl_WinUtfToTChar(nameStr, len, &ds);
if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) {
suffix++;
Tcl_DStringFree(&ds);
break;
}
Tcl_DStringFree(&ds);
}
|
| ︙ | ︙ | |||
570 571 572 573 574 575 576 |
if (result == TCL_OK) {
result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
}
returnPackagePtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, returnPackagePtr,
| | | > > > > > > > | > | 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 |
if (result == TCL_OK) {
result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
}
returnPackagePtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, returnPackagePtr,
Tcl_NewLongObj(result));
Tcl_ListObjAppendElement(NULL, returnPackagePtr,
Tcl_GetObjResult(riPtr->interp));
if (result == TCL_ERROR) {
Tcl_Obj *errorObjPtr;
Tcl_Obj *varName = Tcl_NewStringObj("errorCode", -1);
Tcl_IncrRefCount(varName);
errorObjPtr = Tcl_ObjGetVar2(riPtr->interp, varName, NULL,
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(varName);
if (errorObjPtr) {
Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
}
varName = Tcl_NewStringObj("errorInfo", -1);
Tcl_IncrRefCount(varName);
errorObjPtr = Tcl_ObjGetVar2(riPtr->interp, varName, NULL,
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(varName);
if (errorObjPtr) {
Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
}
}
return returnPackagePtr;
}
|
| ︙ | ︙ | |||
744 745 746 747 748 749 750 |
if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
if (uFmt == CF_TEXT) {
returnString =
Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
} else {
returnString = (char *)
Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
| | > > > > | | > | | 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 |
if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
if (uFmt == CF_TEXT) {
returnString =
Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
} else {
returnString = (char *)
Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
len = 2 * len + 1;
}
ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
(DWORD) len+1, 0, ddeItem, uFmt, 0);
} else {
if (Tcl_IsSafe(convPtr->riPtr->interp)) {
ddeReturn = NULL;
} else {
Tcl_DString ds;
Tcl_Obj *variableObjPtr;
Tcl_Obj *varName;
Tcl_WinTCharToUtf(utilString, -1, &ds);
varName = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
Tcl_IncrRefCount(varName);
variableObjPtr = Tcl_ObjGetVar2(
convPtr->riPtr->interp, varName, NULL,
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(varName);
if (variableObjPtr != NULL) {
if (uFmt == CF_TEXT) {
returnString = Tcl_GetStringFromObj(
variableObjPtr, &len);
} else {
returnString = (char *) Tcl_GetUnicodeFromObj(
variableObjPtr, &len);
len = 2 * len + 1;
}
ddeReturn = DdeCreateDataHandle(ddeInstance,
(BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
uFmt, 0);
} else {
ddeReturn = NULL;
}
|
| ︙ | ︙ | |||
802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 |
* Empty loop body.
*/
}
if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) {
Tcl_DString ds;
Tcl_Obj *variableObjPtr;
len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
CP_WINUNICODE);
Tcl_WinTCharToUtf(utilString, -1, &ds);
utilString = (TCHAR *) DdeAccessData(hData, &dlen);
if (uFmt == CF_TEXT) {
variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
} else {
variableObjPtr = Tcl_NewUnicodeObj(utilString, -1);
}
| > > > | | | 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 |
* Empty loop body.
*/
}
if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) {
Tcl_DString ds;
Tcl_Obj *variableObjPtr;
Tcl_Obj *varName;
len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
CP_WINUNICODE);
Tcl_WinTCharToUtf(utilString, -1, &ds);
utilString = (TCHAR *) DdeAccessData(hData, &dlen);
if (uFmt == CF_TEXT) {
variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
} else {
variableObjPtr = Tcl_NewUnicodeObj(utilString, -1);
}
varName = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
Tcl_IncrRefCount(varName);
Tcl_ObjSetVar2(convPtr->riPtr->interp, varName, NULL,
variableObjPtr, TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(varName);
Tcl_DStringFree(&ds);
Tcl_DStringFree(&dString);
ddeReturn = (HDDEDATA) DDE_FACK;
}
return ddeReturn;
#endif
|
| ︙ | ︙ | |||
1026 1027 1028 1029 1030 1031 1032 | * Sets the services list into the interp result. * *---------------------------------------------------------------------- */ static int DdeCreateClient( | | | | 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 |
* Sets the services list into the interp result.
*
*----------------------------------------------------------------------
*/
static int
DdeCreateClient(
DdeEnumServices *es)
{
WNDCLASSEX wc;
static const TCHAR *szDdeClientClassName = TEXT("TclEval client class");
static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window");
memset(&wc, 0, sizeof(wc));
wc.cbSize = sizeof(wc);
wc.lpfnWndProc = DdeClientWindowProc;
wc.lpszClassName = szDdeClientClassName;
wc.cbWndExtra = sizeof(DdeEnumServices *);
/*
* Register and create the callback window.
*/
RegisterClassEx(&wc);
es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName,
|
| ︙ | ︙ | |||
1058 1059 1060 1061 1062 1063 1064 |
UINT uMsg, /* The type of message received */
WPARAM wParam,
LPARAM lParam) /* (Potentially) our local handle */
{
switch (uMsg) {
case WM_CREATE: {
LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
| | | | 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 |
UINT uMsg, /* The type of message received */
WPARAM wParam,
LPARAM lParam) /* (Potentially) our local handle */
{
switch (uMsg) {
case WM_CREATE: {
LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
DdeEnumServices *es =
(DdeEnumServices *) lpcs->lpCreateParams;
#ifdef _WIN64
SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
#else
SetWindowLong(hwnd, GWL_USERDATA, (LONG) es);
#endif
return (LRESULT) 0L;
|
| ︙ | ︙ | |||
1084 1085 1086 1087 1088 1089 1090 |
HWND hwnd,
WPARAM wParam,
LPARAM lParam)
{
HWND hwndRemote = (HWND)wParam;
ATOM service = (ATOM)LOWORD(lParam);
ATOM topic = (ATOM)HIWORD(lParam);
| | | | | 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 |
HWND hwnd,
WPARAM wParam,
LPARAM lParam)
{
HWND hwndRemote = (HWND)wParam;
ATOM service = (ATOM)LOWORD(lParam);
ATOM topic = (ATOM)HIWORD(lParam);
DdeEnumServices *es;
TCHAR sz[255];
Tcl_DString dString;
#ifdef _WIN64
es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
#endif
if ((es->service == (ATOM)0 || es->service == service)
&& (es->topic == (ATOM)0 || es->topic == topic)) {
Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);
|
| ︙ | ︙ | |||
1142 1143 1144 1145 1146 1147 1148 |
static BOOL CALLBACK
DdeEnumWindowsCallback(
HWND hwndTarget,
LPARAM lParam)
{
DWORD_PTR dwResult = 0;
| | | | 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 |
static BOOL CALLBACK
DdeEnumWindowsCallback(
HWND hwndTarget,
LPARAM lParam)
{
DWORD_PTR dwResult = 0;
DdeEnumServices *es = (DdeEnumServices *) lParam;
SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
&dwResult);
return TRUE;
}
static int
DdeGetServicesList(
Tcl_Interp *interp,
const TCHAR *serviceName,
const TCHAR *topicName)
{
DdeEnumServices es;
es.interp = interp;
es.result = TCL_OK;
es.service = (serviceName == NULL)
? (ATOM)0 : GlobalAddAtom(serviceName);
es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName);
|
| ︙ | ︙ | |||
1296 1297 1298 1299 1300 1301 1302 |
*/
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
return TCL_ERROR;
}
| | | | | | 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 |
*/
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], ddeCommands,
sizeof(char *), "command", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum DdeSubcommands) index) {
case DDE_SERVERNAME:
for (i = 2; i < objc; i++) {
if (Tcl_GetIndexFromObjStruct(interp, objv[i], ddeSrvOptions,
sizeof(char *), "option", 0, &argIndex) != TCL_OK) {
/*
* If it is the last argument, it might be a server name
* instead of a bad argument.
*/
if (i != objc-1) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
1353 1354 1355 1356 1357 1358 1359 |
case DDE_EXECUTE:
if (objc == 5) {
firstArg = 2;
break;
} else if (objc >= 6 && objc <= 7) {
firstArg = objc - 3;
for (i = 2; i < firstArg; i++) {
| | | | | | | | 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 |
case DDE_EXECUTE:
if (objc == 5) {
firstArg = 2;
break;
} else if (objc >= 6 && objc <= 7) {
firstArg = objc - 3;
for (i = 2; i < firstArg; i++) {
if (Tcl_GetIndexFromObjStruct(interp, objv[i], ddeExecOptions,
sizeof(char *), "option", 0, &argIndex) != TCL_OK) {
goto wrongDdeExecuteArgs;
}
if (argIndex == DDE_EXEC_ASYNC) {
flags |= DDE_FLAG_ASYNC;
} else {
flags |= DDE_FLAG_BINARY;
}
}
break;
}
/* otherwise... */
wrongDdeExecuteArgs:
Tcl_WrongNumArgs(interp, 2, objv,
"?-async? ?-binary? serviceName topicName value");
return TCL_ERROR;
case DDE_POKE:
if (objc == 6) {
firstArg = 2;
break;
} else if ((objc == 7) && (Tcl_GetIndexFromObjStruct(NULL, objv[2],
ddeReqOptions, sizeof(char *), "option", 0, &argIndex) == TCL_OK)) {
flags |= DDE_FLAG_BINARY;
firstArg = 3;
break;
}
/*
* Otherwise...
*/
Tcl_WrongNumArgs(interp, 2, objv,
"?-binary? serviceName topicName item value");
return TCL_ERROR;
case DDE_REQUEST:
if (objc == 5) {
firstArg = 2;
break;
} else if ((objc == 6) && (Tcl_GetIndexFromObjStruct(NULL, objv[2],
ddeReqOptions, sizeof(char *), "option", 0, &argIndex) == TCL_OK)) {
flags |= DDE_FLAG_BINARY;
firstArg = 3;
break;
}
/*
* Otherwise ...
|
| ︙ | ︙ | |||
1420 1421 1422 1423 1424 1425 1426 |
case DDE_EVAL:
if (objc < 4) {
wrongDdeEvalArgs:
Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args");
return TCL_ERROR;
} else {
firstArg = 2;
| | | | 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 |
case DDE_EVAL:
if (objc < 4) {
wrongDdeEvalArgs:
Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args");
return TCL_ERROR;
} else {
firstArg = 2;
if (Tcl_GetIndexFromObjStruct(NULL, objv[2], ddeEvalOptions,
sizeof(char *), "option", 0, &argIndex) == TCL_OK) {
if (objc < 5) {
goto wrongDdeEvalArgs;
}
flags |= DDE_FLAG_ASYNC;
firstArg++;
}
break;
|
| ︙ | ︙ | |||
1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 |
if (result == TCL_OK) {
Tcl_IncrRefCount(objPtr);
result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(objPtr);
}
if (interp != sendInterp) {
if (result == TCL_ERROR) {
/*
* An error occurred, so transfer error information from
* the destination interpreter back to our interpreter.
*/
Tcl_ResetResult(interp);
| > | > > > | > | > | 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 |
if (result == TCL_OK) {
Tcl_IncrRefCount(objPtr);
result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(objPtr);
}
if (interp != sendInterp) {
if (result == TCL_ERROR) {
Tcl_Obj *varName;
/*
* An error occurred, so transfer error information from
* the destination interpreter back to our interpreter.
*/
Tcl_ResetResult(interp);
varName = Tcl_NewStringObj("errorInfo", -1);
Tcl_IncrRefCount(varName);
objPtr = Tcl_ObjGetVar2(sendInterp, varName, NULL,
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(varName);
if (objPtr) {
Tcl_AppendObjToErrorInfo(interp, objPtr);
}
varName = Tcl_NewStringObj("errorCode", -1);
Tcl_IncrRefCount(varName);
objPtr = Tcl_ObjGetVar2(sendInterp, varName, NULL,
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(varName);
if (objPtr) {
Tcl_SetObjErrorCode(interp, objPtr);
}
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
}
Tcl_Release(riPtr);
|
| ︙ | ︙ |
Changes to win/tclWinFCmd.c.
| ︙ | ︙ | |||
1546 1547 1548 1549 1550 1551 1552 |
*/
attr = 0;
}
}
}
| | | 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 |
*/
attr = 0;
}
}
}
*attributePtrPtr = Tcl_NewLongObj(attr!=0);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ConvertFileNameFormat --
|
| ︙ | ︙ |
Changes to win/tclWinInt.h.
| ︙ | ︙ | |||
27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
void *ebp;
void *esp;
int status;
} TCLEXCEPTION_REGISTRATION;
#endif
/*
* Some versions of Borland C have a define for the OSVERSIONINFO for
* Win32s and for NT, but not for Windows 95.
* Define VER_PLATFORM_WIN32_CE for those without newer headers.
*/
#ifndef VER_PLATFORM_WIN32_WINDOWS
| > > > > > > > > > > > > > > | 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 |
struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
void *ebp;
void *esp;
int status;
} TCLEXCEPTION_REGISTRATION;
#endif
/*
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
* quotation marks), JOIN joins two arguments.
*/
#ifndef STRINGIFY
# define STRINGIFY(x) STRINGIFY1(x)
# define STRINGIFY1(x) #x
#endif
#ifndef JOIN
# define JOIN(a,b) JOIN1(a,b)
# define JOIN1(a,b) a##b
#endif
/*
* Some versions of Borland C have a define for the OSVERSIONINFO for
* Win32s and for NT, but not for Windows 95.
* Define VER_PLATFORM_WIN32_CE for those without newer headers.
*/
#ifndef VER_PLATFORM_WIN32_WINDOWS
|
| ︙ | ︙ |
Changes to win/tclWinPort.h.
| ︙ | ︙ | |||
477 478 479 480 481 482 483 | /* * MSVC 8.0 started to mark many standard C library functions depreciated * including the *printf family and others. Tell it to shut up. * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ #if defined(_MSC_VER) && (_MSC_VER >= 1400) | < < | 477 478 479 480 481 482 483 484 485 486 487 488 489 490 | /* * MSVC 8.0 started to mark many standard C library functions depreciated * including the *printf family and others. Tell it to shut up. * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ #if defined(_MSC_VER) && (_MSC_VER >= 1400) # pragma warning(disable:4996) #endif /* *--------------------------------------------------------------------------- * The following macros and declarations represent the interface between * generic and windows-specific parts of Tcl. Some of the macros may |
| ︙ | ︙ |
Changes to win/tclWinSock.c.
| ︙ | ︙ | |||
3199 3200 3201 3202 3203 3204 3205 |
for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
if (fds->fd == socket) {
return 1;
}
}
return 0;
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 |
for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
if (fds->fd == socket) {
return 1;
}
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* TcpThreadActionProc --
*
* Insert or remove any thread local refs to this channel.
|
| ︙ | ︙ |
Changes to win/tclWinTest.c.
| ︙ | ︙ | |||
272 273 274 275 276 277 278 |
t2.HighPart = sysTime.dwHighDateTime;
t2.QuadPart -= t1.QuadPart;
QueryPerformanceCounter(&p2);
result = Tcl_NewObj();
Tcl_ListObjAppendElement(interp, result,
| | | | | | 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 |
t2.HighPart = sysTime.dwHighDateTime;
t2.QuadPart -= t1.QuadPart;
QueryPerformanceCounter(&p2);
result = Tcl_NewObj();
Tcl_ListObjAppendElement(interp, result,
Tcl_NewLongObj((int) (t2.QuadPart / 10000000)));
Tcl_ListObjAppendElement(interp, result,
Tcl_NewLongObj((int) ((t2.QuadPart / 10) % 1000000)));
Tcl_ListObjAppendElement(interp, result, Tcl_NewLongObj(tclTime.sec));
Tcl_ListObjAppendElement(interp, result, Tcl_NewLongObj(tclTime.usec));
Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart));
Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart));
Tcl_SetObjResult(interp, result);
return TCL_OK;
|
| ︙ | ︙ | |||
363 364 365 366 367 368 369 |
};
int cmd;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>");
return TCL_ERROR;
}
| | | | 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 |
};
int cmd;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], cmds,
sizeof(char *), "command", 0, &cmd) != TCL_OK) {
return TCL_ERROR;
}
/*
* Make sure the GPF dialog doesn't popup.
*/
|
| ︙ | ︙ |
Changes to win/tclWinThrd.c.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 | * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" | < < | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" /* Workaround for mingw versions which don't provide this in float.h */ #ifndef _MCW_EM # define _MCW_EM 0x0008001F /* Error masks */ # define _MCW_RC 0x00000300 /* Rounding */ # define _MCW_PC 0x00030000 /* Precision */ _CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask); #endif |
| ︙ | ︙ |
Changes to win/tclWinTime.c.
| ︙ | ︙ | |||
8 9 10 11 12 13 14 | * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" | < < < < < < < < < < < < < < < < < < < < < < < | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
/*
* Number of samples over which to estimate the performance counter.
*/
#define SAMPLES 64
/*
* Data for managing high-resolution timers.
*/
typedef struct {
CRITICAL_SECTION cs; /* Mutex guarding this structure. */
int initialized; /* Flag == 1 if this structure is
|
| ︙ | ︙ | |||
109 110 111 112 113 114 115 |
0
};
/*
* Declarations for functions defined later in this file.
*/
| < | 86 87 88 89 90 91 92 93 94 95 96 97 98 99 |
0
};
/*
* Declarations for functions defined later in this file.
*/
static void StopCalibration(ClientData clientData);
static DWORD WINAPI CalibrationThread(LPVOID arg);
static void UpdateTimeEachSecond(void);
static void ResetCounterSamples(Tcl_WideUInt fileTime,
Tcl_WideInt perfCounter, Tcl_WideInt perfFreq);
static Tcl_WideInt AccumulateSample(Tcl_WideInt perfCounter,
Tcl_WideUInt fileTime);
|
| ︙ | ︙ | |||
485 486 487 488 489 490 491 |
CloseHandle(timeInfo.exitEvent);
CloseHandle(timeInfo.calibrationThread);
}
/*
*----------------------------------------------------------------------
*
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 461 462 463 464 465 466 467 468 469 470 471 472 473 474 |
CloseHandle(timeInfo.exitEvent);
CloseHandle(timeInfo.calibrationThread);
}
/*
*----------------------------------------------------------------------
*
* CalibrationThread --
*
* Thread that manages calibration of the hi-resolution time derived from
* the performance counter, to keep it synchronized with the system
* clock.
*
* Parameters:
|
| ︙ | ︙ | |||
1029 1030 1031 1032 1033 1034 1035 |
if (++timeInfo.sampleNo >= SAMPLES) {
timeInfo.sampleNo = 0;
}
return estFreq;
}
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 784 785 786 787 788 789 790 791 792 793 794 795 796 797 |
if (++timeInfo.sampleNo >= SAMPLES) {
timeInfo.sampleNo = 0;
}
return estFreq;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetTimeProc --
*
* TIP #233 (Virtualized Time): Registers two handlers for the
|
| ︙ | ︙ |
Changes to win/tclsh.rc.
1 2 3 4 5 | // // Version Resource Script // #include <winver.h> | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | // // Version Resource Script // #include <winver.h> #include "tclWinInt.h" // // build-up the name suffix that defines the type of build this is. // #if TCL_THREADS #define SUFFIX_THREADS "t" #else |
| ︙ | ︙ |