Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Merge 8.7 |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | cplusplus |
Files: | files | file ages | folders |
SHA3-256: |
c59e305ca63d0b27801bbbe2fb439ffd |
User & Date: | jan.nijtmans 2020-02-13 22:06:10.397 |
Context
2020-02-26
| ||
10:58 | Merge 8.7 Closed-Leaf check-in: cfcbd55aba user: jan.nijtmans tags: cplusplus | |
2020-02-13
| ||
22:06 | Merge 8.7 check-in: c59e305ca6 user: jan.nijtmans tags: cplusplus | |
2020-02-12
| ||
13:18 | Merge 8.6 check-in: d3d2b49204 user: jan.nijtmans tags: core-8-branch | |
2020-01-07
| ||
15:20 | Merge 8.7 check-in: b219c8f278 user: jan.nijtmans tags: cplusplus | |
Changes
Changes to .travis.yml.
1 2 3 4 5 6 7 8 | sudo: false language: c matrix: include: # Testing on Linux with various compilers - name: "Linux/GCC/Shared" os: linux | | | | | < < < < < < < | | | | | | | < < < < < < < < < < < < | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | sudo: false language: c matrix: include: # Testing on Linux with various compilers - name: "Linux/GCC/Shared" os: linux dist: bionic compiler: gcc env: - BUILD_DIR=unix - name: "Linux/GCC/Shared: UTF_MAX=4" os: linux dist: bionic compiler: gcc env: - BUILD_DIR=unix - CFGOPT=CFLAGS=-DTCL_UTF_MAX=4 - name: "Linux/GCC/Shared: NO_DEPRECATED" os: linux dist: bionic compiler: gcc env: - BUILD_DIR=unix - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" - name: "Linux/GCC/Static" os: linux dist: bionic compiler: gcc env: - CFGOPT="--disable-shared" - BUILD_DIR=unix - name: "Linux/GCC/Debug" os: linux dist: bionic compiler: gcc env: - BUILD_DIR=unix - CFGOPT="--enable-symbols" # C++ build. - name: "Linux/G++/Shared" os: linux dist: bionic compiler: g++ env: - BUILD_DIR=unix - CFGOPT="CC=g++ CFLAGS=-Dregister=dont+use+register" # Older versions of GCC... - name: "Linux/GCC 7/Shared" os: linux dist: bionic compiler: gcc-7 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-7 env: - BUILD_DIR=unix - name: "Linux/GCC 6/Shared" os: linux dist: bionic compiler: gcc-6 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-6 env: - BUILD_DIR=unix - name: "Linux/GCC 5/Shared" os: linux dist: bionic compiler: gcc-5 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-5 env: - BUILD_DIR=unix # Clang - name: "Linux/Clang/Shared" os: linux dist: bionic compiler: clang env: - BUILD_DIR=unix - name: "Linux/Clang/Shared:NO_DEPRECATED" os: linux dist: xenial compiler: clang env: - BUILD_DIR=unix - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" - name: "Linux/Clang/Static" os: linux dist: bionic compiler: clang env: - CFGOPT="--disable-shared" - BUILD_DIR=unix - name: "Linux/Clang/Debug" os: linux dist: bionic compiler: clang env: - BUILD_DIR=unix - CFGOPT="--enable-symbols" # Testing on Mac, various styles - name: "macOS/Xcode 11.3/Shared/Unix-like" os: osx |
︙ | ︙ | |||
146 147 148 149 150 151 152 153 154 155 156 157 158 159 | - make all # The styles=develop avoids some weird problems on OSX - make test styles=develop addons: homebrew: packages: - libtommath - name: "macOS/Xcode 10/Shared" os: osx osx_image: xcode10.3 env: - BUILD_DIR=macosx install: [] script: *mactest | > > > > > > > | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | - make all # The styles=develop avoids some weird problems on OSX - make test styles=develop addons: homebrew: packages: - libtommath - name: "macOS/Xcode 11/Shared" os: osx osx_image: xcode11 env: - BUILD_DIR=macosx install: [] script: *mactest - name: "macOS/Xcode 10/Shared" os: osx osx_image: xcode10.3 env: - BUILD_DIR=macosx install: [] script: *mactest |
︙ | ︙ | |||
183 184 185 186 187 188 189 | homebrew: packages: - libtommath # Test with mingw-w64 cross-compile # Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows/GCC/Shared/no test" os: linux | | | | 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 | homebrew: packages: - libtommath # Test with mingw-w64 cross-compile # Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows/GCC/Shared/no test" os: linux dist: bionic compiler: x86_64-w64-mingw32-gcc addons: apt: packages: - gcc-mingw-w64-base - binutils-mingw-w64-x86-64 - gcc-mingw-w64-x86-64 - gcc-mingw-w64 env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" script: &crosstest - make all tcltest # Include a high visibility marker that tests are skipped outright - > echo "`tput setaf 3`SKIPPED TEST: CROSS COMPILING`tput sgr0`" # Test with mingw-w64 (32 bit) cross-compile # Doesn't run tests because wine is only an imperfect Windows emulation - name: "Linux-cross-Windows-32/GCC/Shared/no test" os: linux dist: bionic compiler: i686-w64-mingw32-gcc addons: apt: packages: - gcc-mingw-w64-base - binutils-mingw-w64-i686 - gcc-mingw-w64-i686 |
︙ | ︙ | |||
230 231 232 233 234 235 236 | - BUILD_DIR=win - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build" before_install: &vcpreinst - PATH="$PATH:$VCDIR" - cd ${BUILD_DIR} install: [] script: | | | | | | | | | | | | | | | | | | | | | | | | | < < < < < < < | 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 | - BUILD_DIR=win - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build" before_install: &vcpreinst - PATH="$PATH:$VCDIR" - cd ${BUILD_DIR} install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc test - name: "Windows/MSVC/Shared: UTF_MAX=4" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc test - name: "Windows/MSVC/Shared: NO_DEPRECATED" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=nodep' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=nodep' '-f' makefile.vc test - name: "Windows/MSVC/Static" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test - name: "Windows/MSVC/Debug" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test # Test on Windows with MSVC native (32-bit) - name: "Windows/MSVC-x86/Shared" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc test - name: "Windows/MSVC-x86/Shared: UTF_MAX=4" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc test - name: "Windows/MSVC-x86/Shared: NO_DEPRECATED" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=nodep' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=nodep' '-f' makefile.vc test - name: "Windows/MSVC-x86/Static" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test - name: "Windows/MSVC-x86/Debug" os: windows compiler: cl env: *vcenv before_install: *vcpreinst install: [] script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test # Test on Windows with GCC native - name: "Windows/GCC/Shared" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit" before_install: &makepreinst - choco install -y make zip - cd ${BUILD_DIR} - name: "Windows/GCC/Shared: UTF_MAX=4" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=4" before_install: *makepreinst - name: "Windows/GCC/Shared: NO_DEPRECATED" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1" |
︙ | ︙ | |||
375 376 377 378 379 380 381 | # Test on Windows with GCC native (32-bit) - name: "Windows/GCC-x86/Shared" os: windows compiler: gcc env: - BUILD_DIR=win before_install: *makepreinst | | | < < < < < < < | 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 | # Test on Windows with GCC native (32-bit) - name: "Windows/GCC-x86/Shared" os: windows compiler: gcc env: - BUILD_DIR=win before_install: *makepreinst - name: "Windows/GCC-x86/Shared: UTF_MAX=4" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="CFLAGS=-DTCL_UTF_MAX=4" before_install: *makepreinst - name: "Windows/GCC-x86/Shared: NO_DEPRECATED" os: windows compiler: gcc env: - BUILD_DIR=win - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" |
︙ | ︙ |
Changes to doc/AddErrInfo.3.
︙ | ︙ | |||
243 244 245 246 247 248 249 250 251 252 253 254 255 256 | The procedure \fBTcl_SetErrorCode\fR is also used to set the \fB\-errorcode\fR return option. However, it takes one or more strings to record instead of a value. Otherwise, it is similar to \fBTcl_SetObjErrorCode\fR in behavior. .PP \fBTcl_SetErrorCodeVA\fR is the same as \fBTcl_SetErrorCode\fR except that instead of taking a variable number of arguments it takes an argument list. .PP The procedure \fBTcl_GetErrorLine\fR is used to read the integer value of the \fB\-errorline\fR return option without the overhead of a full call to \fBTcl_GetReturnOptions\fR. Likewise, \fBTcl_SetErrorLine\fR sets the \fB\-errorline\fR return option value. .PP \fBTcl_PosixError\fR | > > > | 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 | The procedure \fBTcl_SetErrorCode\fR is also used to set the \fB\-errorcode\fR return option. However, it takes one or more strings to record instead of a value. Otherwise, it is similar to \fBTcl_SetObjErrorCode\fR in behavior. .PP \fBTcl_SetErrorCodeVA\fR is the same as \fBTcl_SetErrorCode\fR except that instead of taking a variable number of arguments it takes an argument list. Interfaces using argument lists have been found to be nonportable in practice. This function is deprecated and will be removed in Tcl 9.0. .PP The procedure \fBTcl_GetErrorLine\fR is used to read the integer value of the \fB\-errorline\fR return option without the overhead of a full call to \fBTcl_GetReturnOptions\fR. Likewise, \fBTcl_SetErrorLine\fR sets the \fB\-errorline\fR return option value. .PP \fBTcl_PosixError\fR |
︙ | ︙ |
Changes to doc/CrtChannel.3.
︙ | ︙ | |||
644 645 646 647 648 649 650 | If the option value is successfully modified to the new value, the function returns \fBTCL_OK\fR. It should call \fBTcl_BadChannelOption\fR which itself returns \fBTCL_ERROR\fR if the \fIoptionName\fR is unrecognized. If \fInewValue\fR specifies a value for the option that is not supported or if a system call error occurs, | | | | 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 | If the option value is successfully modified to the new value, the function returns \fBTCL_OK\fR. It should call \fBTcl_BadChannelOption\fR which itself returns \fBTCL_ERROR\fR if the \fIoptionName\fR is unrecognized. If \fInewValue\fR specifies a value for the option that is not supported or if a system call error occurs, the function should leave an error message in the result of \fIinterp\fR if \fIinterp\fR is not NULL. The function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX error code. .PP This value can be retrieved with \fBTcl_ChannelSetOptionProc\fR, which returns a pointer to the function. .SS GETOPTIONPROC .PP |
︙ | ︙ |
Changes to doc/CrtSlave.3.
︙ | ︙ | |||
115 116 117 118 119 120 121 | .PP These procedures are intended for access to the multiple interpreter facility from inside C programs. They enable managing multiple interpreters in a hierarchical relationship, and the management of aliases, commands that when invoked in one interpreter execute a command in another interpreter. The return value for those procedures that return an \fBint\fR is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned | | | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | .PP These procedures are intended for access to the multiple interpreter facility from inside C programs. They enable managing multiple interpreters in a hierarchical relationship, and the management of aliases, commands that when invoked in one interpreter execute a command in another interpreter. The return value for those procedures that return an \fBint\fR is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned then the interpreter's result contains an error message. .PP \fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR. It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which allows \fIinterp\fR to manipulate the new slave. If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl code has access to all the Tcl commands. If it is \fB1\fR, the command creates a |
︙ | ︙ | |||
154 155 156 157 158 159 160 | \fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR. If no such slave interpreter exists, \fBNULL\fR is returned. .PP \fBTcl_GetMaster\fR returns a pointer to the master interpreter of \fIinterp\fR. If \fIinterp\fR has no master (it is a top-level interpreter) then \fBNULL\fR is returned. .PP | | | | | | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 | \fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR. If no such slave interpreter exists, \fBNULL\fR is returned. .PP \fBTcl_GetMaster\fR returns a pointer to the master interpreter of \fIinterp\fR. If \fIinterp\fR has no master (it is a top-level interpreter) then \fBNULL\fR is returned. .PP \fBTcl_GetInterpPath\fR stores in the result of \fIaskingInterp\fR the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR; \fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation of the relative path succeeds, \fBTCL_OK\fR is returned, else \fBTCL_ERROR\fR is returned and an error message is stored as the result of \fIaskingInterp\fR. .PP \fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in \fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR to be invoked in \fItargetInterp\fR. The arguments specified by the strings contained in \fIargv\fR are always prepended to any arguments supplied in the invocation of \fIslaveCmd\fR and passed to \fItargetCmd\fR. This operation returns \fBTCL_OK\fR if it succeeds, or \fBTCL_ERROR\fR if |
︙ | ︙ | |||
194 195 196 197 198 199 200 | strings. .PP \fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from the set of hidden commands to the set of exposed commands, putting it under the name \fIcmdName\fR. \fIHiddenCmdName\fR must be the name of an existing hidden | | | | | | | | | | | | | | 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 | strings. .PP \fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from the set of hidden commands to the set of exposed commands, putting it under the name \fIcmdName\fR. \fIHiddenCmdName\fR must be the name of an existing hidden command, or the operation will return \fBTCL_ERROR\fR and leave an error message as the result of \fIinterp\fR. If an exposed command named \fIcmdName\fR already exists, the operation returns \fBTCL_ERROR\fR and leaves an error message as the result of \fIinterp\fR. If the operation succeeds, it returns \fBTCL_OK\fR. After executing this command, attempts to use \fIcmdName\fR in any script evaluation mechanism will again succeed. .PP \fBTcl_HideCommand\fR moves the command named \fIcmdName\fR from the set of exposed commands to the set of hidden commands, under the name \fIhiddenCmdName\fR. \fICmdName\fR must be the name of an existing exposed command, or the operation will return \fBTCL_ERROR\fR and leave an error message as the result of \fIinterp\fR. Currently both \fIcmdName\fR and \fIhiddenCmdName\fR must not contain namespace qualifiers, or the operation will return \fBTCL_ERROR\fR and leave an error message as the result of \fIinterp\fR. The \fICmdName\fR will be looked up in the global namespace, and not relative to the current namespace, even if the current namespace is not the global one. If a hidden command whose name is \fIhiddenCmdName\fR already exists, the operation also returns \fBTCL_ERROR\fR and an error message is left as the result of \fIinterp\fR. If the operation succeeds, it returns \fBTCL_OK\fR. After executing this command, attempts to use \fIcmdName\fR in any script evaluation mechanism will fail. .PP For a description of the Tcl interface to multiple interpreters, see \fIinterp(n)\fR. .SH "SEE ALSO" interp .SH KEYWORDS alias, command, exposed commands, hidden commands, interpreter, invoke, master, slave |
Changes to doc/Eval.3.
︙ | ︙ | |||
152 153 154 155 156 157 158 | It returns the result of the command and also modifies the interpreter result in the same way as \fBTcl_Eval\fR. The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end of arguments. \fBTcl_VarEval\fR is now deprecated. .PP \fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that instead of taking a variable number of arguments it takes an argument | > | | 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | It returns the result of the command and also modifies the interpreter result in the same way as \fBTcl_Eval\fR. The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end of arguments. \fBTcl_VarEval\fR is now deprecated. .PP \fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that instead of taking a variable number of arguments it takes an argument list. Interfaces using argument lists have been found to be nonportable in practice. This function is deprecated and will be removed in Tcl 9.0. .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/Panic.3.
︙ | ︙ | |||
49 50 51 52 53 54 55 | same formatting rules are also used by the built-in Tcl command \fBformat\fR. .PP In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted error message to the standard error file of the process, and then calls \fBabort\fR to terminate the process. \fBTcl_Panic\fR does not return. On Windows, when a debugger is running, the formatted error | | | | 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | same formatting rules are also used by the built-in Tcl command \fBformat\fR. .PP In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted error message to the standard error file of the process, and then calls \fBabort\fR to terminate the process. \fBTcl_Panic\fR does not return. On Windows, when a debugger is running, the formatted error message is sent to the debugger instead. If the windows executable does not have a stderr channel (e.g. \fBwish.exe\fR), then a system dialog box is used to display the panic message. .PP If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR and you want to implicitly use the stderr channel of your application's C runtime (instead of the stderr channel of the C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR with \fBTcl_ConsolePanic\fR as its argument. On platforms which only have one C runtime (almost all platforms except Windows) \fBTcl_ConsolePanic\fR is equivalent to NULL. .PP \fBTcl_SetPanicProc\fR may be used to modify the behavior of \fBTcl_Panic\fR. The \fIpanicProc\fR argument should match the |
︙ | ︙ | |||
82 83 84 85 86 87 88 89 90 91 92 93 94 95 | call the Tcl library, since the original call to \fBTcl_Panic\fR indicates the Tcl library is not in a state of reliable operation. .PP The typical use of \fBTcl_SetPanicProc\fR arranges for the error message to be displayed or reported in a manner more suitable for the application or the platform. .PP Although the primary callers of \fBTcl_Panic\fR are the procedures of the Tcl library, \fBTcl_Panic\fR is a public function and may be called by any extension or application that wishes to abort the process and have a panic message displayed the same way that panic messages from Tcl will be displayed. .PP \fBTcl_PanicVA\fR is the same as \fBTcl_Panic\fR except that instead of | > > > | > < < < | 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | call the Tcl library, since the original call to \fBTcl_Panic\fR indicates the Tcl library is not in a state of reliable operation. .PP The typical use of \fBTcl_SetPanicProc\fR arranges for the error message to be displayed or reported in a manner more suitable for the application or the platform. .PP \fBTcl_SetPanicProc\fR can not be used in stub-enabled extensions. Its symbol entry in the stub table is deprecated and it will be removed in Tcl 9.0. .PP Although the primary callers of \fBTcl_Panic\fR are the procedures of the Tcl library, \fBTcl_Panic\fR is a public function and may be called by any extension or application that wishes to abort the process and have a panic message displayed the same way that panic messages from Tcl will be displayed. .PP \fBTcl_PanicVA\fR is the same as \fBTcl_Panic\fR except that instead of taking a variable number of arguments it takes an argument list. Interfaces using argument lists have been found to be nonportable in practice. This function is deprecated and will be removed in Tcl 9.0. .SH "SEE ALSO" abort(3), printf(3), exec(n), format(n) .SH KEYWORDS abort, fatal, error |
Changes to doc/SetResult.3.
︙ | ︙ | |||
141 142 143 144 145 146 147 148 149 150 151 152 153 154 | \fIinterp\fR so as to handle backward-compatibility with old-style extensions. Any number of \fIresult\fR arguments may be passed in a single call; the last argument in the list must be a NULL pointer. .PP \fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that instead of taking a variable number of arguments it takes an argument list. .PP \fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR to \fItargetInterp\fR. The two interpreters must have been created in the same thread. If \fIsourceInterp\fR and \fItargetInterp\fR are the same, nothing is done. Otherwise, \fBTcl_TransferResult\fR moves the result from \fIsourceInterp\fR to \fItargetInterp\fR, and resets the result in \fIsourceInterp\fR. It also moves the return options dictionary as | > > | 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 | \fIinterp\fR so as to handle backward-compatibility with old-style extensions. Any number of \fIresult\fR arguments may be passed in a single call; the last argument in the list must be a NULL pointer. .PP \fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that instead of taking a variable number of arguments it takes an argument list. Interfaces using argument lists have been found to be nonportable in practice. This function is deprecated and will be removed in Tcl 9.0. .PP \fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR to \fItargetInterp\fR. The two interpreters must have been created in the same thread. If \fIsourceInterp\fR and \fItargetInterp\fR are the same, nothing is done. Otherwise, \fBTcl_TransferResult\fR moves the result from \fIsourceInterp\fR to \fItargetInterp\fR, and resets the result in \fIsourceInterp\fR. It also moves the return options dictionary as |
︙ | ︙ |
Changes to doc/StaticPkg.3.
︙ | ︙ | |||
61 62 63 64 65 66 67 | is to be loaded. The initialization procedure must return \fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed successfully; in the event of an error it should set the interpreter's result to point to an error message. The result or error from the initialization procedure will be returned as the result of the \fBload\fR command that caused the initialization procedure to be invoked. .PP | | | 61 62 63 64 65 66 67 68 69 70 71 72 73 | is to be loaded. The initialization procedure must return \fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed successfully; in the event of an error it should set the interpreter's result to point to an error message. The result or error from the initialization procedure will be returned as the result of the \fBload\fR command that caused the initialization procedure to be invoked. .PP \fBTcl_StaticPackage\fR can not be used in stub-enabled extensions. Its symbol entry in the stub table is deprecated and it will be removed in Tcl 9.0. .SH KEYWORDS initialization procedure, package, static linking .SH "SEE ALSO" load(n), package(n), Tcl_PkgRequire(3) |
Changes to doc/StringObj.3.
︙ | ︙ | |||
245 246 247 248 249 250 251 | each value must be a null-terminated string (i.e. none of the values may contain internal null characters). Any number of \fIstring\fR arguments may be provided, but the last argument must be a NULL pointer to indicate the end of the list. .PP \fBTcl_AppendStringsToObjVA\fR is the same as \fBTcl_AppendStringsToObj\fR except that instead of taking a variable number of arguments it takes an | | > > | 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 | each value must be a null-terminated string (i.e. none of the values may contain internal null characters). Any number of \fIstring\fR arguments may be provided, but the last argument must be a NULL pointer to indicate the end of the list. .PP \fBTcl_AppendStringsToObjVA\fR is the same as \fBTcl_AppendStringsToObj\fR except that instead of taking a variable number of arguments it takes an argument list. Interfaces using argument lists have been found to be nonportable in practice. This function is deprecated and will be removed in Tcl 9.0. .PP \fBTcl_AppendLimitedToObj\fR is similar to \fBTcl_AppendToObj\fR except that it imposes a limit on how many bytes are appended. This can be handy when the string to be appended might be very large, but the value being constructed should not be allowed to grow without bound. A common usage is when constructing an error message, where the end result should be kept short enough to be read. |
︙ | ︙ |
Changes to doc/Tcl_Main.3.
︙ | ︙ | |||
186 187 188 189 190 191 192 | is encountered on the standard input channel, then \fBTcl_Main\fR itself will evaluate the \fBexit\fR command after the main loop procedure (if any) returns. In non-interactive mode, after \fBTcl_Main\fR evaluates the startup script, and the main loop procedure (if any) returns, \fBTcl_Main\fR will also evaluate the \fBexit\fR command. .PP | | | 186 187 188 189 190 191 192 193 194 195 196 197 198 | is encountered on the standard input channel, then \fBTcl_Main\fR itself will evaluate the \fBexit\fR command after the main loop procedure (if any) returns. In non-interactive mode, after \fBTcl_Main\fR evaluates the startup script, and the main loop procedure (if any) returns, \fBTcl_Main\fR will also evaluate the \fBexit\fR command. .PP \fBTcl_Main\fR can not be used in stub-enabled extensions. .SH "SEE ALSO" tclsh(1), Tcl_GetStdChannel(3), Tcl_StandardChannels(3), Tcl_AppInit(3), exit(n), encoding(n) .SH KEYWORDS application-specific initialization, command-line arguments, main program |
Changes to doc/TraceVar.3.
1 2 3 4 5 6 7 | '\" '\" Copyright (c) 1989-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. '\" | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | '\" '\" Copyright (c) 1989-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_TraceVar 3 8.7 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_TraceVar, Tcl_TraceVar2, Tcl_UntraceVar, Tcl_UntraceVar2, Tcl_VarTraceInfo, Tcl_VarTraceInfo2 \- monitor accesses to a variable .SH SYNOPSIS .nf \fB#include <tcl.h>\fR |
︙ | ︙ | |||
91 92 93 94 95 96 97 | \fBTCL_TRACE_WRITES\fR Invoke \fIproc\fR whenever an attempt is made to modify the variable. .TP \fBTCL_TRACE_UNSETS\fR Invoke \fIproc\fR whenever the variable is unset. A variable may be unset either explicitly by an \fBunset\fR command, or implicitly when a procedure returns (its local variables are | | | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | \fBTCL_TRACE_WRITES\fR Invoke \fIproc\fR whenever an attempt is made to modify the variable. .TP \fBTCL_TRACE_UNSETS\fR Invoke \fIproc\fR whenever the variable is unset. A variable may be unset either explicitly by an \fBunset\fR command, or implicitly when a procedure returns (its local variables are automatically unset) or when the interpreter or namespace is deleted (all variables are automatically unset). .TP \fBTCL_TRACE_ARRAY\fR Invoke \fIproc\fR whenever the array command is invoked. This gives the trace procedure a chance to update the array before array names or array get is called. Note that this is called before an array set, but that will trigger write traces. |
︙ | ︙ | |||
156 157 158 159 160 161 162 | procedure call: the trace procedure will need to pass this flag back to variable-related procedures like \fBTcl_GetVar\fR if it attempts to access the variable. The bit \fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is about to be destroyed; this information may be useful to \fIproc\fR so that it can clean up its own internal data structures (see the section \fBTCL_TRACE_DESTROYED\fR below for more details). | < < < < | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 | procedure call: the trace procedure will need to pass this flag back to variable-related procedures like \fBTcl_GetVar\fR if it attempts to access the variable. The bit \fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is about to be destroyed; this information may be useful to \fIproc\fR so that it can clean up its own internal data structures (see the section \fBTCL_TRACE_DESTROYED\fR below for more details). The trace procedure's return value should normally be NULL; see \fBERROR RETURNS\fR below for information on other possibilities. .PP \fBTcl_UntraceVar\fR may be used to remove a trace. If the variable specified by \fIinterp\fR, \fIvarName\fR, and \fIflags\fR has a trace set with \fIflags\fR, \fIproc\fR, and \fIclientData\fR, then the corresponding trace is removed. |
︙ | ︙ | |||
326 327 328 329 330 331 332 333 334 335 336 337 338 339 | .PP The return value from \fIproc\fR is only used during read and write tracing. During unset traces, the return value is ignored and all relevant trace procedures will always be invoked. .SH "RESTRICTIONS" .PP A trace procedure can be called at any time, even when there are partially formed results stored in the interpreter. If the trace procedure does anything that could damage this result (such as calling \fBTcl_Eval\fR) then it must use the \fBTcl_SaveInterpState\fR and related routines to save and restore the original state of the interpreter before it returns. .SH "UNDEFINED VARIABLES" | > > > > > > > > > | 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 | .PP The return value from \fIproc\fR is only used during read and write tracing. During unset traces, the return value is ignored and all relevant trace procedures will always be invoked. .SH "RESTRICTIONS" .PP Because operations on variables may take place as part of the deletion of the interp that contains them, \fIproc\fR must be careful about checking what the \fIinterp\fR parameter can be used to do. The routine \fBTcl_InterpDeleted\fR is an important tool for this. When \fBTcl_InterpDeleted\fR returns 1, \fIproc\fR will not be able to invoke any scripts in \fIinterp\fR. You may encounter old code using a deprecated flag value \fBTCL_INTERP_DESTROYED\fR to signal this condition, but any supported code should be converted to stop using it. .PP A trace procedure can be called at any time, even when there are partially formed results stored in the interpreter. If the trace procedure does anything that could damage this result (such as calling \fBTcl_Eval\fR) then it must use the \fBTcl_SaveInterpState\fR and related routines to save and restore the original state of the interpreter before it returns. .SH "UNDEFINED VARIABLES" |
︙ | ︙ | |||
350 351 352 353 354 355 356 | In an unset callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit is set in \fIflags\fR if the trace is being removed as part of the deletion. Traces on a variable are always removed whenever the variable is deleted; the only time \fBTCL_TRACE_DESTROYED\fR is not set is for a whole-array trace invoked when only a single element of an array is unset. | < < < < < < < < < < < < < < < < | 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 | In an unset callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit is set in \fIflags\fR if the trace is being removed as part of the deletion. Traces on a variable are always removed whenever the variable is deleted; the only time \fBTCL_TRACE_DESTROYED\fR is not set is for a whole-array trace invoked when only a single element of an array is unset. .SH BUGS .PP Array traces are not yet integrated with the Tcl \fBinfo exists\fR command, nor is there Tcl-level access to array traces. .SH "SEE ALSO" trace(n) .SH KEYWORDS clientData, trace, variable |
Changes to doc/Utf.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 Utf 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 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 Utf 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp typedef ... \fBTcl_UniChar\fR; .sp int |
︙ | ︙ | |||
116 117 118 119 120 121 122 123 124 125 126 127 128 129 | A null-terminated Unicode string. .AP "const Tcl_UniChar" *uniPattern in A null-terminated Unicode string. .AP "const unsigned short" *uStr in A null-terminated UTF-16 string. .AP "const wchar_t" *wStr in A null-terminated wchar_t string. .AP int length in 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. .AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. | > > > > > > | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | A null-terminated Unicode string. .AP "const Tcl_UniChar" *uniPattern in A null-terminated Unicode string. .AP "const unsigned short" *uStr in A null-terminated UTF-16 string. .AP "const wchar_t" *wStr in A null-terminated wchar_t string. .AP "const unsigned short" *utf16s in A null-terminated utf-16 string. .AP "const unsigned short" *utf16t in A null-terminated utf-16 string. .AP "const unsigned short" *utf16Pattern in A null-terminated utf-16 string. .AP int length in 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. .AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. |
︙ | ︙ | |||
144 145 146 147 148 149 150 | case-insensitive (1). .BE .SH DESCRIPTION .PP These routines convert between UTF-8 strings and Unicode/Utf-16 characters. A UTF-8 character is a Unicode character represented as a varying-length | | | | | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 | case-insensitive (1). .BE .SH DESCRIPTION .PP These routines convert between UTF-8 strings and Unicode/Utf-16 characters. A UTF-8 character is a Unicode character represented as a varying-length sequence of up to \fB4\fR bytes. A multibyte UTF-8 sequence consists of a lead byte followed by some number of trail bytes. .PP \fBTCL_UTF_MAX\fR is the maximum number of bytes that \fBTcl_UtfToUniChar\fR can consume in a single call. .PP \fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string in starting at \fIbuf\fR. The return value is the number of bytes stored in \fIbuf\fR. If ch is a high surrogate (range U+D800 - U+DBFF), then the return value will be 1 and a single byte in the range 0xF0 - 0xF4 will be stored. If you still want to produce UTF-8 output for it (even though knowing it's an illegal code-point on its own), just call |
︙ | ︙ |
Changes to doc/lappend.n.
︙ | ︙ | |||
45 46 47 48 49 50 51 | 1 % \fBlappend\fR var 2 1 2 % \fBlappend\fR var 3 4 5 1 2 3 4 5 .CE .SH "SEE ALSO" | | > | | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | 1 % \fBlappend\fR var 2 1 2 % \fBlappend\fR var 3 4 5 1 2 3 4 5 .CE .SH "SEE ALSO" list(n), lassign(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS append, element, list, variable .\" Local variables: .\" mode: nroff .\" fill-column: 78 .\" End: |
Changes to doc/lassign.n.
︙ | ︙ | |||
48 49 50 51 52 53 54 | .QW shift command in many shell languages like this: .PP .CS set ::argv [\fBlassign\fR $::argv argumentToReadOff] .CE .SH "SEE ALSO" | > > | | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 | .QW shift command in many shell languages like this: .PP .CS set ::argv [\fBlassign\fR $::argv argumentToReadOff] .CE .SH "SEE ALSO" list(n), lappend(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS assign, element, list, multiple, set, variable '\"Local Variables: '\"mode: nroff '\"End: |
Changes to doc/lindex.n.
︙ | ︙ | |||
111 112 113 114 115 116 117 | \fBlindex\fR {a b c d e f} $idx+2 \fI\(-> d\fR set idx 3 \fBlindex\fR {a b c d e f} $idx+2 \fI\(-> f\fR .CE .SH "SEE ALSO" | | > | | 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | \fBlindex\fR {a b c d e f} $idx+2 \fI\(-> d\fR set idx 3 \fBlindex\fR {a b c d e f} $idx+2 \fI\(-> f\fR .CE .SH "SEE ALSO" list(n), lappend(n), lassign(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n), string(n) .SH KEYWORDS element, index, list '\"Local Variables: '\"mode: nroff '\"End: |
Changes to doc/linsert.n.
︙ | ︙ | |||
41 42 43 44 45 46 47 | set oldList {the fox jumps over the dog} set midList [\fBlinsert\fR $oldList 1 quick] set newList [\fBlinsert\fR $midList end-1 lazy] # The old lists still exist though... set newerList [\fBlinsert\fR [\fBlinsert\fR $oldList end-1 quick] 1 lazy] .CE .SH "SEE ALSO" | | > | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | set oldList {the fox jumps over the dog} set midList [\fBlinsert\fR $oldList 1 quick] set newList [\fBlinsert\fR $midList end-1 lazy] # The old lists still exist though... set newerList [\fBlinsert\fR [\fBlinsert\fR $oldList end-1 quick] 1 lazy] .CE .SH "SEE ALSO" list(n), lappend(n), lassign(n), lindex(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n), string(n) .SH KEYWORDS element, insert, list '\" Local Variables: '\" mode: nroff '\" End: |
Changes to doc/list.n.
︙ | ︙ | |||
42 43 44 45 46 47 48 | .PP while \fBconcat\fR with the same arguments will return .PP .CS \fBa b c d e f {g h}\fR .CE .SH "SEE ALSO" | | | | | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | .PP while \fBconcat\fR with the same arguments will return .PP .CS \fBa b c d e f {g h}\fR .CE .SH "SEE ALSO" lappend(n), lassign(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS element, list, quoting '\"Local Variables: '\"mode: nroff '\"End: |
Changes to doc/llength.n.
︙ | ︙ | |||
45 46 47 48 49 50 51 | An empty list is not necessarily an empty string: .PP .CS % set var { }; puts "[string length $var],[\fBllength\fR $var]" 1,0 .CE .SH "SEE ALSO" | | > | | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | An empty list is not necessarily an empty string: .PP .CS % set var { }; puts "[string length $var],[\fBllength\fR $var]" 1,0 .CE .SH "SEE ALSO" list(n), lappend(n), lassign(n), lindex(n), linsert(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS element, list, length '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/lmap.n.
︙ | ︙ | |||
73 74 75 76 77 78 79 | proc isGood {counter} {expr {$n > 3}} set prefix [\fBlmap\fR x $values {expr { [isGood $x] ? $x : [break] }}] # The value of prefix is "8 7 6 5 4" .CE .SH "SEE ALSO" | | > > > | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 | proc isGood {counter} {expr {$n > 3}} set prefix [\fBlmap\fR x $values {expr { [isGood $x] ? $x : [break] }}] # The value of prefix is "8 7 6 5 4" .CE .SH "SEE ALSO" break(n), continue(n), for(n), foreach(n), while(n), list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS foreach, iteration, list, loop, map '\" Local Variables: '\" mode: nroff '\" End: |
Changes to doc/lpop.n.
︙ | ︙ | |||
82 83 84 85 86 87 88 | The indicated value becomes the new value of \fIx\fR. .PP .CS \fBlpop\fR x 1 1 0 \fI\(-> {{a b} {c d}} {{e f} h}\fR .CE .SH "SEE ALSO" | | | > | 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | The indicated value becomes the new value of \fIx\fR. .PP .CS \fBlpop\fR x 1 1 0 \fI\(-> {{a b} {c d}} {{e f} h}\fR .CE .SH "SEE ALSO" list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), lmap(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n), string(n) .SH KEYWORDS element, index, list, remove, pop, stack, queue '\"Local Variables: '\"mode: nroff '\"End: |
Changes to doc/lrange.n.
︙ | ︙ | |||
67 68 69 70 71 72 73 | some {elements to} select % lindex $var 1 elements to % \fBlrange\fR $var 1 1 {elements to} .CE .SH "SEE ALSO" | | | > | 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | some {elements to} select % lindex $var 1 elements to % \fBlrange\fR $var 1 1 {elements to} .CE .SH "SEE ALSO" list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n), string(n) .SH KEYWORDS element, list, range, sublist '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/lremove.n.
︙ | ︙ | |||
42 43 44 45 46 47 48 | Removing the same element indicated in two different ways: .PP .CS % \fBlremove\fR {a b c d e} 2 end-2 a b d e .CE .SH "SEE ALSO" | > > | | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | Removing the same element indicated in two different ways: .PP .CS % \fBlremove\fR {a b c d e} 2 end-2 a b d e .CE .SH "SEE ALSO" list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS element, list, remove .\" Local variables: .\" mode: nroff .\" fill-column: 78 .\" End: |
Changes to doc/lrepeat.n.
︙ | ︙ | |||
28 29 30 31 32 33 34 | \fI\(-> {0 0 0} {0 0 0} {0 0 0}\fR \fBlrepeat\fR 3 a b c \fI\(-> a b c a b c a b c\fR \fBlrepeat\fR 3 [\fBlrepeat\fR 2 a] b c \fI\(-> {a a} b c {a a} b c {a a} b c\fR .CE .SH "SEE ALSO" | | > > | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | \fI\(-> {0 0 0} {0 0 0} {0 0 0}\fR \fBlrepeat\fR 3 a b c \fI\(-> a b c a b c a b c\fR \fBlrepeat\fR 3 [\fBlrepeat\fR 2 a] b c \fI\(-> {a a} b c {a a} b c {a a} b c\fR .CE .SH "SEE ALSO" list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS element, index, list '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/lreplace.n.
︙ | ︙ | |||
91 92 93 94 95 96 97 | % set var {a b c d e} a b c d e % set var [\fBlreplace\fR $var 12345 end+2 f g h i] a b c d e f g h i .CE .VE TIP505 .SH "SEE ALSO" | | | > | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | % set var {a b c d e} a b c d e % set var [\fBlreplace\fR $var 12345 end+2 f g h i] a b c d e f g h i .CE .VE TIP505 .SH "SEE ALSO" list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreverse(n), lsearch(n), lset(n), lsort(n), string(n) .SH KEYWORDS element, list, replace .\" Local variables: .\" mode: nroff .\" fill-column: 78 .\" End: |
Changes to doc/lreverse.n.
︙ | ︙ | |||
21 22 23 24 25 26 27 | .CS \fBlreverse\fR {a a b c} \fI\(-> c b a a\fR \fBlreverse\fR {a b {c d} e f} \fI\(-> f e {c d} b a\fR .CE .SH "SEE ALSO" | | | > | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | .CS \fBlreverse\fR {a a b c} \fI\(-> c b a a\fR \fBlreverse\fR {a b {c d} e f} \fI\(-> f e {c d} b a\fR .CE .SH "SEE ALSO" list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS element, list, reverse '\" Local Variables: '\" mode: nroff '\" End: |
Changes to doc/lsearch.n.
︙ | ︙ | |||
223 224 225 226 227 228 229 | The same thing for a flattened list: .PP .CS \fBlsearch\fR -stride 2 -index 1 -all -inline {a abc b bcd c cde} *bc* \fI\(-> {a abc b bcd}\fR .CE .SH "SEE ALSO" | > | > | | 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 | The same thing for a flattened list: .PP .CS \fBlsearch\fR -stride 2 -index 1 -all -inline {a abc b bcd c cde} *bc* \fI\(-> {a abc b bcd}\fR .CE .SH "SEE ALSO" foreach(n), list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lset(n), lsort(n), string(n) .SH KEYWORDS binary search, linear search, list, match, pattern, regular expression, search, string '\" Local Variables: '\" mode: nroff '\" End: |
Changes to doc/lset.n.
︙ | ︙ | |||
132 133 134 135 136 137 138 | .CS \fBlset\fR x 1 1 0 j \fI\(-> {{a b} {c d}} {{e f} {j h}}\fR \fBlset\fR x {1 1 0} j \fI\(-> {{a b} {c d}} {{e f} {j h}}\fR .CE .SH "SEE ALSO" | | | > | 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | .CS \fBlset\fR x 1 1 0 j \fI\(-> {{a b} {c d}} {{e f} {j h}}\fR \fBlset\fR x {1 1 0} j \fI\(-> {{a b} {c d}} {{e f} {j h}}\fR .CE .SH "SEE ALSO" list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lsort(n) string(n) .SH KEYWORDS element, index, list, replace, set '\"Local Variables: '\"mode: nroff '\"End: |
Changes to doc/lsort.n.
︙ | ︙ | |||
260 261 262 263 264 265 266 | return [string compare [lindex $a 1] [lindex $b 1]] } \fI%\fR \fBlsort\fR -command compare \e {{3 apple} {0x2 carrot} {1 dingo} {2 banana}} {1 dingo} {2 banana} {0x2 carrot} {3 apple} .CE .SH "SEE ALSO" | | | > | 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 | return [string compare [lindex $a 1] [lindex $b 1]] } \fI%\fR \fBlsort\fR -command compare \e {{3 apple} {0x2 carrot} {1 dingo} {2 banana}} {1 dingo} {2 banana} {0x2 carrot} {3 apple} .CE .SH "SEE ALSO" list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n) .SH KEYWORDS element, list, order, sort '\" Local Variables: '\" mode: nroff '\" End: |
Changes to doc/zipfs.3.
︙ | ︙ | |||
79 80 81 82 83 84 85 | application dynamic library, or as a zip archive named \fBlibtcl_\fImajor\fB_\fIminor\fB_\fIpatchlevel\fB.zip\fR either in the present working directory or in the standard Tcl install location. (For example, the Tcl 8.7.2 release would be searched for in a file \fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only. .PP On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since | | | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 | application dynamic library, or as a zip archive named \fBlibtcl_\fImajor\fB_\fIminor\fB_\fIpatchlevel\fB.zip\fR either in the present working directory or in the standard Tcl install location. (For example, the Tcl 8.7.2 release would be searched for in a file \fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only. .PP On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since it uses WCHAR instead of char. As a result, it requires your application to be compiled with the UNICODE preprocessor symbol defined (e.g., via the \fB-DUNICODE\fR compiler flag). .PP The result of \fBTclZipfs_AppHook\fR is a Tcl result code (e.g., \fBTCL_OK\fR when the function is successful). The function \fImay\fR modify the variables pointed to by \fIargcPtr\fR and \fIargvPtr\fR to remove arguments; the current implementation does not do so, but callers \fIshould not\fR assume |
︙ | ︙ |
Changes to generic/regcustom.h.
︙ | ︙ | |||
84 85 86 87 88 89 90 | typedef Tcl_UniChar chr; /* The type itself. */ typedef int pchr; /* What it promotes to. */ typedef unsigned uchr; /* Unsigned type that will hold a chr. */ typedef int celt; /* Type to hold chr, or NOCELT */ #define NOCELT (-1) /* Celt value which is not valid chr */ #define CHR(c) (UCHAR(c)) /* Turn char literal into chr literal */ #define DIGITVAL(c) ((c)-'0') /* Turn chr digit into its value */ | | | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | typedef Tcl_UniChar chr; /* The type itself. */ typedef int pchr; /* What it promotes to. */ typedef unsigned uchr; /* Unsigned type that will hold a chr. */ typedef int celt; /* Type to hold chr, or NOCELT */ #define NOCELT (-1) /* Celt value which is not valid chr */ #define CHR(c) (UCHAR(c)) /* Turn char literal into chr literal */ #define DIGITVAL(c) ((c)-'0') /* Turn chr digit into its value */ #if TCL_UTF_MAX > 3 #define CHRBITS 32 /* Bits in a chr; must not use sizeof */ #define CHR_MIN 0x00000000 /* Smallest and largest chr; the value */ #define CHR_MAX 0x10ffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */ #else #define CHRBITS 16 /* Bits in a chr; must not use sizeof */ #define CHR_MIN 0x0000 /* Smallest and largest chr; the value */ #define CHR_MAX 0xffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */ |
︙ | ︙ |
Changes to generic/tcl.decls.
︙ | ︙ | |||
519 520 521 522 523 524 525 | declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) } declare 146 { int Tcl_Flush(Tcl_Channel chan) } | | | 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 | declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) } declare 146 { int Tcl_Flush(Tcl_Channel chan) } declare 147 {deprecated {see TIP #559. Use Tcl_ResetResult}} { 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) } |
︙ | ︙ | |||
1240 1241 1242 1243 1244 1245 1246 | } declare 350 { int Tcl_UniCharIsUpper(int ch) } declare 351 { int Tcl_UniCharIsWordChar(int ch) } | | | | 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 | } declare 350 { int Tcl_UniCharIsUpper(int ch) } declare 351 { int Tcl_UniCharIsWordChar(int ch) } declare 352 {deprecated {Use Tcl_GetCharLength}} { int Tcl_UniCharLen(const Tcl_UniChar *uniStr) } declare 353 {deprecated {Use Tcl_UtfNcmp}} { int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars) } declare 354 { char *Tcl_Char16ToUtfDString(const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr) } |
︙ | ︙ | |||
1352 1353 1354 1355 1356 1357 1358 | } declare 382 {deprecated {No longer in use, changed to macro}} { Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr) } declare 383 { Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last) } | | | 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 | } declare 382 {deprecated {No longer in use, changed to macro}} { Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr) } declare 383 { Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last) } declare 384 {deprecated {Use Tcl_AppendStringsToObj}} { void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length) } declare 385 { int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj) } |
︙ | ︙ | |||
1478 1479 1480 1481 1482 1483 1484 | } declare 417 { void Tcl_ClearChannelHandlers(Tcl_Channel channel) } declare 418 { int Tcl_IsChannelExisting(const char *channelName) } | | | | 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 | } declare 417 { void Tcl_ClearChannelHandlers(Tcl_Channel channel) } declare 418 { int Tcl_IsChannelExisting(const char *channelName) } declare 419 {deprecated {Use Tcl_UtfNcasecmp}} { int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars) } declare 420 {deprecated {Use Tcl_StringCaseMatch}} { 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 { |
︙ | ︙ | |||
2005 2006 2007 2008 2009 2010 2011 | declare 554 { Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) } # TIP#237 (arbitrary-precision integers) kbk declare 555 { | | | | | | | 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 | declare 554 { Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) } # TIP#237 (arbitrary-precision integers) kbk declare 555 { Tcl_Obj *Tcl_NewBignumObj(void *value) } declare 556 { Tcl_Obj *Tcl_DbNewBignumObj(void *value, const char *file, int line) } declare 557 { void Tcl_SetBignumObj(Tcl_Obj *obj, void *value) } declare 558 { int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value) } declare 559 { int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value) } # TIP #208 ('chan' command) jeffh declare 560 { int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length) } declare 561 { |
︙ | ︙ | |||
2046 2047 2048 2049 2050 2051 2052 | declare 565 { void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg) } # TIP #237 (additional conversion functions for bignum support) kbk/dgp declare 566 { int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval, | | | 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 | declare 565 { void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg) } # TIP #237 (additional conversion functions for bignum support) kbk/dgp declare 566 { int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval, void *toInit) } # TIP#181 (namespace unknown command) dgp for Neil Madden declare 567 { Tcl_Obj *Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr) } |
︙ | ︙ |
Changes to generic/tcl.h.
︙ | ︙ | |||
1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 | #define TCL_NAMESPACE_ONLY 2 #define TCL_APPEND_VALUE 4 #define TCL_LIST_ELEMENT 8 #define TCL_TRACE_READS 0x10 #define TCL_TRACE_WRITES 0x20 #define TCL_TRACE_UNSETS 0x40 #define TCL_TRACE_DESTROYED 0x80 #define TCL_INTERP_DESTROYED 0x100 #define TCL_LEAVE_ERR_MSG 0x200 #define TCL_TRACE_ARRAY 0x800 #ifndef TCL_REMOVE_OBSOLETE_TRACES /* Required to support old variable/vdelete/vinfo traces. */ #define TCL_TRACE_OLD_STYLE 0x1000 #endif /* Indicate the semantics of the result of a trace. */ | > > > > | 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 | #define TCL_NAMESPACE_ONLY 2 #define TCL_APPEND_VALUE 4 #define TCL_LIST_ELEMENT 8 #define TCL_TRACE_READS 0x10 #define TCL_TRACE_WRITES 0x20 #define TCL_TRACE_UNSETS 0x40 #define TCL_TRACE_DESTROYED 0x80 #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 #define TCL_INTERP_DESTROYED 0x100 #endif #define TCL_LEAVE_ERR_MSG 0x200 #define TCL_TRACE_ARRAY 0x800 #ifndef TCL_REMOVE_OBSOLETE_TRACES /* Required to support old variable/vdelete/vinfo traces. */ #define TCL_TRACE_OLD_STYLE 0x1000 #endif /* Indicate the semantics of the result of a trace. */ |
︙ | ︙ | |||
2102 2103 2104 2105 2106 2107 2108 | #define TCL_CONVERT_MULTIBYTE (-1) #define TCL_CONVERT_SYNTAX (-2) #define TCL_CONVERT_UNKNOWN (-3) #define TCL_CONVERT_NOSPACE (-4) /* * The maximum number of bytes that are necessary to represent a single | | | | | < | | | | < < < < | 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 | #define TCL_CONVERT_MULTIBYTE (-1) #define TCL_CONVERT_SYNTAX (-2) #define TCL_CONVERT_UNKNOWN (-3) #define TCL_CONVERT_NOSPACE (-4) /* * The maximum number of bytes that are necessary to represent a single * Unicode character in UTF-8. The valid values are 3 and 4 * (or perhaps 1 if we want to support a non-unicode enabled core). If 3, * then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If > 3, * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode * is the default and recommended mode. */ #ifndef TCL_UTF_MAX #define TCL_UTF_MAX 3 #endif /* * This represents a Unicode character. Any changes to this should also be * reflected in regcustom.h. */ #if TCL_UTF_MAX > 3 /* * int isn't 100% accurate as it should be a strict 4-byte value * (perhaps wchar_t). ILP64/SILP64 systems may have troubles. The * size of this value must be reflected correctly in regcustom.h. */ typedef int Tcl_UniChar; #else typedef unsigned short Tcl_UniChar; #endif /* |
︙ | ︙ | |||
2164 2165 2166 2167 2168 2169 2170 2171 2172 | * Structure containing information about a limit handler to be called when a * command- or time-limit is exceeded by an interpreter. */ typedef void (Tcl_LimitHandlerProc) (ClientData clientData, Tcl_Interp *interp); typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData); /* *---------------------------------------------------------------------------- | > > > > | > > > > > | 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 | * Structure containing information about a limit handler to be called when a * command- or time-limit is exceeded by an interpreter. */ typedef void (Tcl_LimitHandlerProc) (ClientData clientData, Tcl_Interp *interp); typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData); #if 0 /* *---------------------------------------------------------------------------- * We would like to provide an anonymous structure "mp_int" here, which is * compatible with libtommath's "mp_int", but without duplicating anything * from <tommath.h> or including <tommath.h> here. But the libtommath project * didn't honor our request. See: <https://github.com/libtom/libtommath/pull/473> * * That's why this part is commented out, and we are using (void *) in * various API's in stead of the more correct (mp_int *). */ #ifndef MP_INT_DECLARED #define MP_INT_DECLARED typedef struct mp_int mp_int; #endif #endif /* *---------------------------------------------------------------------------- * Definitions needed for Tcl_ParseArgvObj routines. * Based on tkArgv.c. * Modifications from the original are copyright (c) Sam Bromley 2006 |
︙ | ︙ | |||
2307 2308 2309 2310 2311 2312 2313 | typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, int result); /* *---------------------------------------------------------------------------- * The following constant is used to test for older versions of Tcl in the | | | | 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 | typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, int result); /* *---------------------------------------------------------------------------- * The following constant is used to test for older versions of Tcl in the * stubs tables. */ #define TCL_STUB_MAGIC ((int) 0xFCA3BACF) /* * 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. */ |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
7683 7684 7685 7686 7687 7688 7689 7690 | break; } if (exact) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) sqrt(d))); } else { mp_int root; | > | > | > > > > | 7683 7684 7685 7686 7687 7688 7689 7690 7691 7692 7693 7694 7695 7696 7697 7698 7699 7700 7701 7702 7703 7704 7705 7706 | break; } if (exact) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) sqrt(d))); } else { mp_int root; mp_err err; err = mp_init(&root); if (err == MP_OKAY) { err = mp_sqrt(&big, &root); } mp_clear(&big); if (err != MP_OKAY) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root)); } return TCL_OK; negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( "square root of negative argument", -1)); |
︙ | ︙ | |||
7733 7734 7735 7736 7737 7738 7739 7740 | #endif if (code != TCL_OK) { return TCL_ERROR; } if ((d >= 0.0) && TclIsInfinite(d) && (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK)) { mp_int root; | > | > | > > > > > | 7739 7740 7741 7742 7743 7744 7745 7746 7747 7748 7749 7750 7751 7752 7753 7754 7755 7756 7757 7758 7759 7760 7761 7762 7763 | #endif if (code != TCL_OK) { return TCL_ERROR; } if ((d >= 0.0) && TclIsInfinite(d) && (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK)) { mp_int root; mp_err err; err = mp_init(&root); if (err == MP_OKAY) { err = mp_sqrt(&big, &root); } mp_clear(&big); if (err != MP_OKAY) { mp_clear(&root); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclBignumToDouble(&root))); mp_clear(&root); } else { Tcl_SetObjResult(interp, Tcl_NewDoubleObj(sqrt(d))); } return TCL_OK; } |
︙ | ︙ | |||
7903 7904 7905 7906 7907 7908 7909 | return TCL_OK; } bytes++; numBytes--; } } goto unChanged; } else if (l == WIDE_MIN) { | | > > | 7916 7917 7918 7919 7920 7921 7922 7923 7924 7925 7926 7927 7928 7929 7930 7931 7932 | return TCL_OK; } bytes++; numBytes--; } } goto unChanged; } else if (l == WIDE_MIN) { if (mp_init_i64(&big, l) != MP_OKAY) { return TCL_ERROR; } goto tooLarge; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l)); return TCL_OK; } if (type == TCL_NUMBER_DOUBLE) { |
︙ | ︙ | |||
7934 7935 7936 7937 7938 7939 7940 | return TCL_OK; } if (type == TCL_NUMBER_BIG) { if (mp_isneg((const mp_int *) ptr)) { Tcl_GetBignumFromObj(NULL, objv[1], &big); tooLarge: | | > > | 7949 7950 7951 7952 7953 7954 7955 7956 7957 7958 7959 7960 7961 7962 7963 7964 7965 | return TCL_OK; } if (type == TCL_NUMBER_BIG) { if (mp_isneg((const mp_int *) ptr)) { Tcl_GetBignumFromObj(NULL, objv[1], &big); tooLarge: if (mp_neg(&big, &big) != MP_OKAY) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); } else { unChanged: Tcl_SetObjResult(interp, objv[1]); } return TCL_OK; } |
︙ | ︙ | |||
8279 8280 8281 8282 8283 8284 8285 8286 8287 8288 8289 8290 8291 | if (fractPart <= -0.5) { min++; } else if (fractPart >= 0.5) { max--; } if ((intPart >= (double)max) || (intPart <= (double)min)) { mp_int big; if (Tcl_InitBignumFromDouble(interp, intPart, &big) != TCL_OK) { /* Infinity */ return TCL_ERROR; } if (fractPart <= -0.5) { | > | | > > > | 8296 8297 8298 8299 8300 8301 8302 8303 8304 8305 8306 8307 8308 8309 8310 8311 8312 8313 8314 8315 8316 8317 8318 8319 8320 8321 8322 | if (fractPart <= -0.5) { min++; } else if (fractPart >= 0.5) { max--; } if ((intPart >= (double)max) || (intPart <= (double)min)) { mp_int big; mp_err err = MP_OKAY; if (Tcl_InitBignumFromDouble(interp, intPart, &big) != TCL_OK) { /* Infinity */ return TCL_ERROR; } if (fractPart <= -0.5) { err = mp_sub_d(&big, 1, &big); } else if (fractPart >= 0.5) { err = mp_add_d(&big, 1, &big); } if (err != MP_OKAY) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; } else { Tcl_WideInt result = (Tcl_WideInt)intPart; if (fractPart <= -0.5) { |
︙ | ︙ |
Changes to generic/tclBinary.c.
︙ | ︙ | |||
1363 1364 1365 1366 1367 1368 1369 | badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badField: { Tcl_UniChar ch = 0; | | | 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 | badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badField: { Tcl_UniChar ch = 0; char buf[5] = ""; TclUtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); return TCL_ERROR; } |
︙ | ︙ | |||
1733 1734 1735 1736 1737 1738 1739 | badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badField: { Tcl_UniChar ch = 0; | | | 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 | badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badField: { Tcl_UniChar ch = 0; char buf[5] = ""; TclUtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { int i, j, index, indices, length, nocase = 0, indexc; int sortMode = SORTMODE_ASCII; int group, groupSize, groupOffset, idx, allocatedIndexVector = 0; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; SortElement *elementArray = NULL, *elementPtr; SortInfo sortInfo; /* Information about this sort that needs to * be passed to the comparison function. */ # define NUM_LISTS 30 SortElement *subList[NUM_LISTS+1]; /* This array holds pointers to temporary * lists built during the merge sort. Element * i of the array holds a list of length * 2**i. */ static const char *const switches[] = { | > > | 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { int i, j, index, indices, length, nocase = 0, indexc; int sortMode = SORTMODE_ASCII; int group, groupSize, groupOffset, idx, allocatedIndexVector = 0; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; size_t elmArrSize; SortElement *elementArray = NULL, *elementPtr; SortInfo sortInfo; /* Information about this sort that needs to * be passed to the comparison function. */ # define MAXCALLOC 1024000 # define NUM_LISTS 30 SortElement *subList[NUM_LISTS+1]; /* This array holds pointers to temporary * lists built during the merge sort. Element * i of the array holds a list of length * 2**i. */ static const char *const switches[] = { |
︙ | ︙ | |||
4354 4355 4356 4357 4358 4359 4360 | } /* * The following loop creates a SortElement for each list element and * begins sorting it into the sublists as it appears. */ | > > | > > > > > > > > > > | 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 | } /* * The following loop creates a SortElement for each list element and * begins sorting it into the sublists as it appears. */ elmArrSize = length * sizeof(SortElement); if (elmArrSize <= MAXCALLOC) { elementArray = (SortElement *)ckalloc(elmArrSize); } else { elementArray = (SortElement *)malloc(elmArrSize); } if (!elementArray) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no enough memory to proccess sort of %d items", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } for (i=0; i < length; i++) { idx = groupSize * i + groupOffset; if (indexc) { /* * If this is an indexed sort, retrieve the corresponding element */ |
︙ | ︙ | |||
4487 4488 4489 4490 4491 4492 4493 | TclDecrRefCount(listObj); sortInfo.compareCmdPtr = NULL; } if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); } if (elementArray) { | > > > | > | 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 | TclDecrRefCount(listObj); sortInfo.compareCmdPtr = NULL; } if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); } if (elementArray) { if (elmArrSize <= MAXCALLOC) { ckfree((char *)elementArray); } else { free((char *)elementArray); } } return sortInfo.resultCode; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
1224 1225 1226 1227 1228 1229 1230 | Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS); for ( ; stringPtr < end; stringPtr += len) { int fullchar; len = TclUtfToUniChar(stringPtr, &ch); fullchar = ch; | | | 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 | Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS); for ( ; stringPtr < end; stringPtr += len) { int fullchar; len = TclUtfToUniChar(stringPtr, &ch); fullchar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(stringPtr + len, &ch); fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif /* |
︙ | ︙ | |||
1919 1920 1921 1922 1923 1924 1925 | goto str_is_done; } end = string1 + length1; for (; string1 < end; string1 += length2, failat++) { int fullchar; length2 = TclUtfToUniChar(string1, &ch); fullchar = ch; | | | 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 | goto str_is_done; } end = string1 + length1; for (; string1 < end; string1 += length2, failat++) { int fullchar; length2 = TclUtfToUniChar(string1, &ch); fullchar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (length2 < 3)) { length2 += TclUtfToUniChar(string1 + length2, &ch); fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif if (!chcomp(fullchar)) { result = 0; |
︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
︙ | ︙ | |||
697 698 699 700 701 702 703 704 705 706 707 708 709 710 | OP( POP); PUSH( "1"); } FIXJUMP1( over); OP( LNOT); return TCL_OK; } case STR_IS_DOUBLE: { int satisfied, isEmpty; if (allowEmpty) { OP( DUP); PUSH( ""); | > | 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 | OP( POP); PUSH( "1"); } FIXJUMP1( over); OP( LNOT); return TCL_OK; } break; case STR_IS_DOUBLE: { int satisfied, isEmpty; if (allowEmpty) { OP( DUP); PUSH( ""); |
︙ | ︙ |
Changes to generic/tclDecls.h.
︙ | ︙ | |||
474 475 476 477 478 479 480 | EXTERN void Tcl_FindExecutable(const char *argv0); /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 146 */ EXTERN int Tcl_Flush(Tcl_Channel chan); /* 147 */ | > | | 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 | EXTERN void Tcl_FindExecutable(const char *argv0); /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 146 */ EXTERN int Tcl_Flush(Tcl_Channel chan); /* 147 */ TCL_DEPRECATED("see TIP #559. Use Tcl_ResetResult") void Tcl_FreeResult(Tcl_Interp *interp); /* 148 */ EXTERN int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 149 */ |
︙ | ︙ | |||
1059 1060 1061 1062 1063 1064 1065 | /* 349 */ EXTERN int Tcl_UniCharIsSpace(int ch); /* 350 */ EXTERN int Tcl_UniCharIsUpper(int ch); /* 351 */ EXTERN int Tcl_UniCharIsWordChar(int ch); /* 352 */ | > | > | | 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 | /* 349 */ EXTERN int Tcl_UniCharIsSpace(int ch); /* 350 */ EXTERN int Tcl_UniCharIsUpper(int ch); /* 351 */ EXTERN int Tcl_UniCharIsWordChar(int ch); /* 352 */ TCL_DEPRECATED("Use Tcl_GetCharLength") int Tcl_UniCharLen(const Tcl_UniChar *uniStr); /* 353 */ TCL_DEPRECATED("Use Tcl_UtfNcmp") int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 354 */ EXTERN char * Tcl_Char16ToUtfDString(const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr); /* 355 */ EXTERN unsigned short * Tcl_UtfToChar16DString(const char *src, int length, |
︙ | ︙ | |||
1152 1153 1154 1155 1156 1157 1158 | EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, int index); /* 382 */ TCL_DEPRECATED("No longer in use, changed to macro") Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr); /* 383 */ EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last); /* 384 */ | > | | 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 | EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, int index); /* 382 */ TCL_DEPRECATED("No longer in use, changed to macro") Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr); /* 383 */ EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last); /* 384 */ TCL_DEPRECATED("Use Tcl_AppendStringsToObj") void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 385 */ EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 386 */ EXTERN void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr); /* 387 */ |
︙ | ︙ | |||
1246 1247 1248 1249 1250 1251 1252 | /* 416 */ EXTERN void Tcl_SpliceChannel(Tcl_Channel channel); /* 417 */ EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel); /* 418 */ EXTERN int Tcl_IsChannelExisting(const char *channelName); /* 419 */ | > | > | | 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 | /* 416 */ EXTERN void Tcl_SpliceChannel(Tcl_Channel channel); /* 417 */ EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel); /* 418 */ EXTERN int Tcl_IsChannelExisting(const char *channelName); /* 419 */ TCL_DEPRECATED("Use Tcl_UtfNcasecmp") int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 420 */ TCL_DEPRECATED("Use Tcl_StringCaseMatch") int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 421 */ EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key); /* 422 */ EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, const void *key, int *newPtr); |
︙ | ︙ | |||
1640 1641 1642 1643 1644 1645 1646 | EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 554 */ EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr); /* 555 */ | | | | | | | | 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 | EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 554 */ EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr); /* 555 */ EXTERN Tcl_Obj * Tcl_NewBignumObj(void *value); /* 556 */ EXTERN Tcl_Obj * Tcl_DbNewBignumObj(void *value, const char *file, int line); /* 557 */ EXTERN void Tcl_SetBignumObj(Tcl_Obj *obj, void *value); /* 558 */ EXTERN int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 559 */ EXTERN int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 560 */ EXTERN int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length); /* 561 */ EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr); /* 562 */ EXTERN void Tcl_SetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj *msg); /* 563 */ EXTERN void Tcl_GetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj **msg); /* 564 */ EXTERN void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg); /* 565 */ EXTERN void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg); /* 566 */ EXTERN int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval, void *toInit); /* 567 */ EXTERN Tcl_Obj * Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 568 */ EXTERN int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 569 */ |
︙ | ︙ | |||
2083 2084 2085 2086 2087 2088 2089 | 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 */ TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_FindExecutable) (const char *argv0); /* 144 */ Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ | | | 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 | 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 */ TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_FindExecutable) (const char *argv0); /* 144 */ Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ TCL_DEPRECATED_API("see TIP #559. Use Tcl_ResetResult") 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 */ |
︙ | ︙ | |||
2296 2297 2298 2299 2300 2301 2302 | 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 */ | | | | 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 | 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 */ TCL_DEPRECATED_API("Use Tcl_GetCharLength") int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ TCL_DEPRECATED_API("Use Tcl_UtfNcmp") int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */ char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ unsigned short * (*tcl_UtfToChar16DString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */ 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 */ |
︙ | ︙ | |||
2328 2329 2330 2331 2332 2333 2334 | void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */ Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */ void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */ int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */ TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */ Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */ | | | 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 | void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */ Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */ void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */ int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */ TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */ Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */ TCL_DEPRECATED_API("Use Tcl_AppendStringsToObj") void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */ int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */ void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */ Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */ int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */ int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */ int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */ void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */ |
︙ | ︙ | |||
2363 2364 2365 2366 2367 2368 2369 | 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 */ | | | | 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 | 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 */ TCL_DEPRECATED_API("Use Tcl_UtfNcasecmp") int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */ TCL_DEPRECATED_API("Use Tcl_StringCaseMatch") int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ 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 */ |
︙ | ︙ | |||
2499 2500 2501 2502 2503 2504 2505 | int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 548 */ int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */ int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */ int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */ void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 552 */ void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 553 */ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */ | | | | | | | | 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 | int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 548 */ int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */ int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */ int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */ void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 552 */ void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 553 */ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */ Tcl_Obj * (*tcl_NewBignumObj) (void *value); /* 555 */ Tcl_Obj * (*tcl_DbNewBignumObj) (void *value, const char *file, int line); /* 556 */ void (*tcl_SetBignumObj) (Tcl_Obj *obj, void *value); /* 557 */ int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 558 */ int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 559 */ int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */ Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (const Tcl_ChannelType *chanTypePtr); /* 561 */ void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg); /* 562 */ void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg); /* 563 */ void (*tcl_SetChannelError) (Tcl_Channel chan, Tcl_Obj *msg); /* 564 */ void (*tcl_GetChannelError) (Tcl_Channel chan, Tcl_Obj **msg); /* 565 */ int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, void *toInit); /* 566 */ Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 567 */ int (*tcl_SetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 568 */ int (*tcl_GetEncodingFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 569 */ Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */ int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */ const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */ int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 573 */ |
︙ | ︙ | |||
4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 | #undef Tcl_AddErrorInfo #define Tcl_AddErrorInfo(interp, message) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1)) #undef Tcl_AddObjErrorInfo #define Tcl_AddObjErrorInfo(interp, message, length) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length)) #ifdef TCL_NO_DEPRECATED #undef Tcl_GetStringResult #define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp)) #undef Tcl_Eval #define Tcl_Eval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, -1, 0) #undef Tcl_GlobalEval #define Tcl_GlobalEval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL) | > > > > > > > > > > > > > > > | 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 | #undef Tcl_AddErrorInfo #define Tcl_AddErrorInfo(interp, message) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1)) #undef Tcl_AddObjErrorInfo #define Tcl_AddObjErrorInfo(interp, message, length) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length)) #ifdef TCL_NO_DEPRECATED #undef Tcl_FreeResult #undef Tcl_AppendResultVA #undef Tcl_AppendStringsToObjVA #undef Tcl_SetErrorCodeVA #undef Tcl_VarEvalVA #undef Tcl_PanicVA #undef Tcl_GetStringResult #undef Tcl_GetDefaultEncodingDir #undef Tcl_SetDefaultEncodingDir #undef Tcl_UniCharLen #undef Tcl_UniCharNcmp #undef Tcl_EvalTokens #undef Tcl_UniCharNcasecmp #undef Tcl_UniCharCaseMatch #undef Tcl_GetMathFuncInfo #undef Tcl_ListMathFuncs #define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp)) #undef Tcl_Eval #define Tcl_Eval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, -1, 0) #undef Tcl_GlobalEval #define Tcl_GlobalEval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL) |
︙ | ︙ | |||
4105 4106 4107 4108 4109 4110 4111 | #undef Tcl_GetUnicode #define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL) #undef Tcl_BackgroundError #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) #undef Tcl_StringMatch #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) | | | 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 | #undef Tcl_GetUnicode #define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL) #undef Tcl_BackgroundError #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) #undef Tcl_StringMatch #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) #if TCL_UTF_MAX <= 3 # undef Tcl_UniCharToUtfDString # define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString # undef Tcl_UtfToUniCharDString # define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString # undef Tcl_UtfToUniChar # define Tcl_UtfToUniChar Tcl_UtfToChar16 #endif |
︙ | ︙ |
Changes to generic/tclDisassemble.c.
︙ | ︙ | |||
897 898 899 900 901 902 903 | i += 2; continue; case '\v': Tcl_AppendToObj(appendObj, "\\v", -1); i += 2; continue; default: | | | 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 | i += 2; continue; case '\v': Tcl_AppendToObj(appendObj, "\\v", -1); i += 2; continue; default: #if TCL_UTF_MAX > 3 if (ch > 0xffff) { Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch); i += 10; } else #else /* If len == 0, this means we have a char > 0xffff, resulting in * TclUtfToUniChar producing a surrogate pair. We want to output |
︙ | ︙ |
Changes to generic/tclEncoding.c.
︙ | ︙ | |||
2617 2618 2619 2620 2621 2622 2623 | /* * Need to handle this in a way that won't cause misalignment by * casting dst to a Tcl_UniChar. [Bug 1122671] */ if (clientData) { | | | | 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 | /* * Need to handle this in a way that won't cause misalignment by * casting dst to a Tcl_UniChar. [Bug 1122671] */ if (clientData) { #if TCL_UTF_MAX > 3 if (*chPtr <= 0xFFFF) { *dst++ = (*chPtr & 0xFF); *dst++ = (*chPtr >> 8); } else { *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF); *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8; *dst++ = (*chPtr & 0xFF); *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC; } #else *dst++ = (*chPtr & 0xFF); *dst++ = (*chPtr >> 8); #endif } else { #if TCL_UTF_MAX > 3 if (*chPtr <= 0xFFFF) { *dst++ = (*chPtr >> 8); *dst++ = (*chPtr & 0xFF); } else { *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC; *dst++ = (*chPtr & 0xFF); *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8; |
︙ | ︙ | |||
2699 2700 2701 2702 2703 2704 2705 | * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; int result, numChars; | | | 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 | * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; int result, numChars; #if TCL_UTF_MAX <= 3 int len; #endif Tcl_UniChar ch = 0; (void)statePtr; srcStart = src; srcEnd = src + srcLen; |
︙ | ︙ | |||
2730 2731 2732 2733 2734 2735 2736 | result = TCL_CONVERT_MULTIBYTE; break; } if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } | | | 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 | result = TCL_CONVERT_MULTIBYTE; break; } if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } #if TCL_UTF_MAX <= 3 src += (len = TclUtfToUniChar(src, &ch)); if ((ch >= 0xD800) && (len < 3)) { src += TclUtfToUniChar(src, &ch); ch = 0xFFFD; } #else src += TclUtfToUniChar(src, &ch); |
︙ | ︙ | |||
2956 2957 2958 2959 2960 2961 2962 | */ result = TCL_CONVERT_MULTIBYTE; break; } len = TclUtfToUniChar(src, &ch); | | | 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 | */ result = TCL_CONVERT_MULTIBYTE; break; } len = TclUtfToUniChar(src, &ch); #if TCL_UTF_MAX > 3 /* * This prevents a crash condition. More evaluation is required for * full support of int Tcl_UniChar. [Bug 1004065] */ if (ch & 0xffff0000) { word = 0; |
︙ | ︙ | |||
3169 3170 3171 3172 3173 3174 3175 | len = TclUtfToUniChar(src, &ch); /* * Check for illegal characters. */ if (ch > 0xff | | | | 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 | len = TclUtfToUniChar(src, &ch); /* * Check for illegal characters. */ if (ch > 0xff #if TCL_UTF_MAX <= 3 || ((ch >= 0xD800) && (len < 3)) #endif ) { if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_UNKNOWN; break; } #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) len = 4; #endif /* * Plunge on, using '?' as a fallback character. */ ch = (Tcl_UniChar) '?'; |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
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 | #ifndef TCL_COMPILE_DEBUG #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do { \ pc += (pcAdjustment); \ switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ case INST_JUMP_TRUE1: \ 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) { \ TclNewIntObj(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) { \ TclNewIntObj(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) { \ TclNewIntObj(objResultPtr, -1); \ | > > > > > > > > > > | 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 | #ifndef TCL_COMPILE_DEBUG #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do { \ pc += (pcAdjustment); \ switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ break; \ case INST_JUMP_TRUE1: \ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ break; \ case INST_JUMP_FALSE4: \ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ break; \ case INST_JUMP_TRUE4: \ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_F(0, (cleanup), 1); \ break; \ } \ } 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); \ break; \ case INST_JUMP_TRUE1: \ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ break; \ case INST_JUMP_FALSE4: \ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ break; \ case INST_JUMP_TRUE4: \ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_V(0, (cleanup), 1); \ break; \ } \ } while (0) #else /* TCL_COMPILE_DEBUG */ #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do{ \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ |
︙ | ︙ | |||
648 649 650 651 652 653 654 655 656 657 658 659 660 661 | /* * Markers for ExecuteExtendedBinaryMathOp. */ #define DIVIDED_BY_ZERO ((Tcl_Obj *) -1) #define EXPONENT_OF_ZERO ((Tcl_Obj *) -2) #define GENERAL_ARITHMETIC_ERROR ((Tcl_Obj *) -3) /* * Declarations for local procedures to this file: */ #ifdef TCL_COMPILE_STATS static int EvalStatsCmd(ClientData clientData, | > | 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 | /* * Markers for ExecuteExtendedBinaryMathOp. */ #define DIVIDED_BY_ZERO ((Tcl_Obj *) -1) #define EXPONENT_OF_ZERO ((Tcl_Obj *) -2) #define GENERAL_ARITHMETIC_ERROR ((Tcl_Obj *) -3) #define OUT_OF_MEMORY ((Tcl_Obj *) -4) /* * Declarations for local procedures to this file: */ #ifdef TCL_COMPILE_STATS static int EvalStatsCmd(ClientData clientData, |
︙ | ︙ | |||
1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 | Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr) { ClientData ptr1, ptr2; int type1, type2; mp_int value, incr; if (Tcl_IsShared(valuePtr)) { Tcl_Panic("%s called with shared object", "TclIncrObj"); } if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) { /* | > | 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 | Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr) { ClientData ptr1, ptr2; int type1, type2; mp_int value, incr; mp_err err; if (Tcl_IsShared(valuePtr)) { Tcl_Panic("%s called with shared object", "TclIncrObj"); } if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) { /* |
︙ | ︙ | |||
1851 1852 1853 1854 1855 1856 1857 | TclSetIntObj(valuePtr, sum); return TCL_OK; } } Tcl_TakeBignumFromObj(interp, valuePtr, &value); Tcl_GetBignumFromObj(interp, incrPtr, &incr); | | > > > | 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 | TclSetIntObj(valuePtr, sum); return TCL_OK; } } Tcl_TakeBignumFromObj(interp, valuePtr, &value); Tcl_GetBignumFromObj(interp, incrPtr, &incr); err = mp_add(&value, &incr, &value); mp_clear(&incr); if (err != MP_OKAY) { return TCL_ERROR; } Tcl_SetBignumObj(valuePtr, &value); return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 | (void) POP_OBJECT(); goto abnormalReturn; case INST_PUSH4: objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]; TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr); NEXT_INST_F(5, 0, 1); case INST_POP: TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); NEXT_INST_F(1, 0, 0); case INST_DUP: objResultPtr = OBJ_AT_TOS; TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_OVER: opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = OBJ_AT_DEPTH(opnd); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_F(5, 0, 1); case INST_REVERSE: { Tcl_Obj **a, **b; opnd = TclGetUInt4AtPtr(pc+1); a = tosPtr-(opnd-1); b = tosPtr; | > > > > | 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 | (void) POP_OBJECT(); goto abnormalReturn; case INST_PUSH4: objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]; TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr); NEXT_INST_F(5, 0, 1); break; case INST_POP: TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); NEXT_INST_F(1, 0, 0); break; case INST_DUP: objResultPtr = OBJ_AT_TOS; TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_OVER: opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = OBJ_AT_DEPTH(opnd); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_F(5, 0, 1); break; case INST_REVERSE: { Tcl_Obj **a, **b; opnd = TclGetUInt4AtPtr(pc+1); a = tosPtr-(opnd-1); b = tosPtr; |
︙ | ︙ | |||
2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 | if (objResultPtr == NULL) { TRACE_ERROR(interp); goto gotError; } TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(2, opnd, 1); case INST_CONCAT_STK: /* * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj, * and then decrement their ref counts. */ opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); case INST_EXPAND_START: /* * Push an element to the auxObjList. This records the current * stack depth - i.e., the point in the stack where the expanded * command starts. * | > > | 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 | if (objResultPtr == NULL) { TRACE_ERROR(interp); goto gotError; } TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(2, opnd, 1); break; case INST_CONCAT_STK: /* * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj, * and then decrement their ref counts. */ opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); break; case INST_EXPAND_START: /* * Push an element to the auxObjList. This records the current * stack depth - i.e., the point in the stack where the expanded * command starts. * |
︙ | ︙ | |||
2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 | TclNewObj(objPtr); objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH); objPtr->length = 0; PUSH_TAUX_OBJ(objPtr); TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH)); NEXT_INST_F(1, 0, 0); case INST_EXPAND_DROP: /* * Drops an element of the auxObjList, popping stack elements to * restore the stack to the state before the point where the aux * element was created. */ | > | 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 | TclNewObj(objPtr); objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH); objPtr->length = 0; PUSH_TAUX_OBJ(objPtr); TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH)); NEXT_INST_F(1, 0, 0); break; case INST_EXPAND_DROP: /* * Drops an element of the auxObjList, popping stack elements to * restore the stack to the state before the point where the aux * element was created. */ |
︙ | ︙ | |||
2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 | /* * Nothing was expanded, return {}. */ TclNewObj(objResultPtr); NEXT_INST_F(1, 0, 1); case INST_INVOKE_STK4: objc = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; goto doInvocation; case INST_INVOKE_STK1: | > | 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 | /* * Nothing was expanded, return {}. */ TclNewObj(objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_INVOKE_STK4: objc = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; goto doInvocation; case INST_INVOKE_STK1: |
︙ | ︙ | |||
4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 | */ case INST_JUMP1: opnd = TclGetInt1AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); case INST_JUMP4: opnd = TclGetInt4AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); | > | 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 | */ case INST_JUMP1: opnd = TclGetInt1AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); break; case INST_JUMP4: opnd = TclGetInt4AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); |
︙ | ︙ | |||
4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 | NEXT_INST_F(1, 0, 1); } break; case INST_INFO_LEVEL_NUM: TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_INFO_LEVEL_ARGS: { int level; CallFrame *framePtr = iPtr->varFramePtr; CallFrame *rootFramePtr = iPtr->rootFramePtr; TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) { | > | 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 | NEXT_INST_F(1, 0, 1); } break; case INST_INFO_LEVEL_NUM: TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_INFO_LEVEL_ARGS: { int level; CallFrame *framePtr = iPtr->varFramePtr; CallFrame *rootFramePtr = iPtr->rootFramePtr; TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) { |
︙ | ︙ | |||
5659 5660 5661 5662 5663 5664 5665 | /* * Peep-hole optimisation: if you're about to jump, do jump from here. * Adjustment is 2 due to the nocase byte. */ JUMP_PEEPHOLE_F(match, 2, 2); } | < | 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 | /* * Peep-hole optimisation: if you're about to jump, do jump from here. * Adjustment is 2 due to the nocase byte. */ JUMP_PEEPHOLE_F(match, 2, 2); } /* * End of string-related instructions. * ----------------------------------------------------------------- * Start of numeric operator instructions. */ |
︙ | ︙ | |||
6089 6090 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 | objResultPtr = Tcl_NewWideIntObj(wResult); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } TclSetIntObj(valuePtr, wResult); TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); case INST_DIV: if (w2 == 0) { TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr), O2S(value2Ptr))); goto divideByZero; } else if ((w1 == WIDE_MIN) && (w2 == -1)) { | > | 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 | objResultPtr = Tcl_NewWideIntObj(wResult); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } TclSetIntObj(valuePtr, wResult); TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); break; case INST_DIV: if (w2 == 0) { TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr), O2S(value2Ptr))); goto divideByZero; } else if ((w1 == WIDE_MIN) && (w2 == -1)) { |
︙ | ︙ | |||
6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 | goto divideByZero; } else if (objResultPtr == EXPONENT_OF_ZERO) { TRACE_APPEND(("EXPONENT OF ZERO\n")); goto exponOfZero; } else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) { TRACE_ERROR(interp); goto gotError; } else if (objResultPtr == NULL) { TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); } else { TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } | > > > | 6171 6172 6173 6174 6175 6176 6177 6178 6179 6180 6181 6182 6183 6184 6185 6186 6187 | goto divideByZero; } else if (objResultPtr == EXPONENT_OF_ZERO) { TRACE_APPEND(("EXPONENT OF ZERO\n")); goto exponOfZero; } else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) { TRACE_ERROR(interp); goto gotError; } else if (objResultPtr == OUT_OF_MEMORY) { TRACE_APPEND(("OUT OF MEMORY\n")); goto outOfMemory; } else if (objResultPtr == NULL) { TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); } else { TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } |
︙ | ︙ | |||
6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 6239 6240 6241 | goto gotError; } switch (type1) { case TCL_NUMBER_NAN: /* -NaN => NaN */ TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); case TCL_NUMBER_INT: w1 = *((const Tcl_WideInt *) ptr1); if (w1 != WIDE_MIN) { if (Tcl_IsShared(valuePtr)) { TclNewIntObj(objResultPtr, -w1); TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); | > | 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 | goto gotError; } switch (type1) { case TCL_NUMBER_NAN: /* -NaN => NaN */ TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); break; case TCL_NUMBER_INT: w1 = *((const Tcl_WideInt *) ptr1); if (w1 != WIDE_MIN) { if (Tcl_IsShared(valuePtr)) { TclNewIntObj(objResultPtr, -w1); TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); |
︙ | ︙ | |||
6353 6354 6355 6356 6357 6358 6359 6360 6361 6362 6363 6364 6365 6366 | objResultPtr = TCONST(1); } else { int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK); objResultPtr = TCONST(result); } TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_BREAK: /* DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); */ | > | 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 6395 6396 | objResultPtr = TCONST(1); } else { int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK); objResultPtr = TCONST(result); } TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_BREAK: /* DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); */ |
︙ | ︙ | |||
6748 6749 6750 6751 6752 6753 6754 6755 6756 6757 6758 6759 6760 6761 6762 6763 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 6790 6791 6792 6793 6794 6795 | */ *(++catchTop) = CURR_DEPTH; TRACE(("%u => catchTop=%d, stackTop=%d\n", TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1), (int) CURR_DEPTH)); NEXT_INST_F(5, 0, 0); case INST_END_CATCH: catchTop--; DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); result = TCL_OK; TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1))); NEXT_INST_F(1, 0, 0); case INST_PUSH_RESULT: objResultPtr = Tcl_GetObjResult(interp); TRACE_WITH_OBJ(("=> "), objResultPtr); /* * See the comments at INST_INVOKE_STK */ TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); iPtr->objResultPtr = objPtr; NEXT_INST_F(1, 0, -1); case INST_PUSH_RETURN_CODE: TclNewIntObj(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(); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_RETURN_CODE_BRANCH: { int code; if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &code) != TCL_OK) { Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS not a return code!"); } | > > > > > | 6778 6779 6780 6781 6782 6783 6784 6785 6786 6787 6788 6789 6790 6791 6792 6793 6794 6795 6796 6797 6798 6799 6800 6801 6802 6803 6804 6805 6806 6807 6808 6809 6810 6811 6812 6813 6814 6815 6816 6817 6818 6819 6820 6821 6822 6823 6824 6825 6826 6827 6828 6829 6830 | */ *(++catchTop) = CURR_DEPTH; TRACE(("%u => catchTop=%d, stackTop=%d\n", TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1), (int) CURR_DEPTH)); NEXT_INST_F(5, 0, 0); break; case INST_END_CATCH: catchTop--; DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); result = TCL_OK; TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1))); NEXT_INST_F(1, 0, 0); break; case INST_PUSH_RESULT: objResultPtr = Tcl_GetObjResult(interp); TRACE_WITH_OBJ(("=> "), objResultPtr); /* * See the comments at INST_INVOKE_STK */ TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); iPtr->objResultPtr = objPtr; NEXT_INST_F(1, 0, -1); break; case INST_PUSH_RETURN_CODE: TclNewIntObj(objResultPtr, result); TRACE(("=> %u\n", result)); NEXT_INST_F(1, 0, 1); break; case INST_PUSH_RETURN_OPTIONS: DECACHE_STACK_INFO(); objResultPtr = Tcl_GetReturnOptions(interp, result); CACHE_STACK_INFO(); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); break; case INST_RETURN_CODE_BRANCH: { int code; if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &code) != TCL_OK) { Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS not a return code!"); } |
︙ | ︙ | |||
6821 6822 6823 6824 6825 6826 6827 6828 6829 6830 6831 6832 6833 6834 | if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) { TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n", O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); case INST_DICT_EXISTS: { int found; opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = OBJ_AT_DEPTH(opnd); | > | 6856 6857 6858 6859 6860 6861 6862 6863 6864 6865 6866 6867 6868 6869 6870 | if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) { TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n", O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); break; case INST_DICT_EXISTS: { int found; opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = OBJ_AT_DEPTH(opnd); |
︙ | ︙ | |||
7590 7591 7592 7593 7594 7595 7596 7597 7598 7599 7600 7601 7602 7603 | divideByZero: Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL); CACHE_STACK_INFO(); goto gotError; /* * Exponentiation of zero by negative number in an expression. Control * only reaches this point by "goto exponOfZero". */ exponOfZero: Tcl_SetObjResult(interp, Tcl_NewStringObj( | > > > > > > > | 7626 7627 7628 7629 7630 7631 7632 7633 7634 7635 7636 7637 7638 7639 7640 7641 7642 7643 7644 7645 7646 | divideByZero: Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL); CACHE_STACK_INFO(); goto gotError; outOfMemory: Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "OUTOFMEMORY", "out of memory", NULL); CACHE_STACK_INFO(); goto gotError; /* * Exponentiation of zero by negative number in an expression. Control * only reaches this point by "goto exponOfZero". */ exponOfZero: Tcl_SetObjResult(interp, Tcl_NewStringObj( |
︙ | ︙ | |||
8029 8030 8031 8032 8033 8034 8035 8036 8037 8038 8039 8040 8041 8042 | ClientData ptr1, ptr2; double d1, d2, dResult; Tcl_WideInt w1, w2, wResult; mp_int big1, big2, bigResult, bigRemainder; Tcl_Obj *objResultPtr; int invalid, zero; long shift; (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1); (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2); switch (opcode) { case INST_MOD: /* TODO: Attempts to re-use unshared operands on stack */ | > | 8072 8073 8074 8075 8076 8077 8078 8079 8080 8081 8082 8083 8084 8085 8086 | ClientData ptr1, ptr2; double d1, d2, dResult; Tcl_WideInt w1, w2, wResult; mp_int big1, big2, bigResult, bigRemainder; Tcl_Obj *objResultPtr; int invalid, zero; long shift; mp_err err; (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1); (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2); switch (opcode) { case INST_MOD: /* TODO: Attempts to re-use unshared operands on stack */ |
︙ | ︙ | |||
8090 8091 8092 8093 8094 8095 8096 | /* TODO: internals intrusion */ if ((w1 > ((Tcl_WideInt) 0)) ^ !mp_isneg(&big2)) { /* * Arguments are opposite sign; remainder is sum. */ | | > | | > > > > | | | > | | | > | > | > > > | 8134 8135 8136 8137 8138 8139 8140 8141 8142 8143 8144 8145 8146 8147 8148 8149 8150 8151 8152 8153 8154 8155 8156 8157 8158 8159 8160 8161 8162 8163 8164 8165 8166 8167 8168 8169 8170 8171 8172 8173 8174 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 8185 8186 8187 8188 | /* TODO: internals intrusion */ if ((w1 > ((Tcl_WideInt) 0)) ^ !mp_isneg(&big2)) { /* * Arguments are opposite sign; remainder is sum. */ err = mp_init_i64(&big1, w1); if (err == MP_OKAY) { err = mp_add(&big2, &big1, &big2); mp_clear(&big1); } if (err != MP_OKAY) { return OUT_OF_MEMORY; } BIG_RESULT(&big2); } /* * Arguments are same sign; remainder is first operand. */ mp_clear(&big2); return NULL; } Tcl_GetBignumFromObj(NULL, valuePtr, &big1); Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); err = mp_init_multi(&bigResult, &bigRemainder, NULL); if (err == MP_OKAY) { err = mp_div(&big1, &big2, &bigResult, &bigRemainder); } if ((err == MP_OKAY) && !mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) { /* * Convert to Tcl's integer division rules. */ if ((mp_sub_d(&bigResult, 1, &bigResult) != MP_OKAY) || (mp_add(&bigRemainder, &big2, &bigRemainder) != MP_OKAY)) { return OUT_OF_MEMORY; } } err = mp_copy(&bigRemainder, &bigResult); mp_clear(&bigRemainder); mp_clear(&big1); mp_clear(&big2); if (err != MP_OKAY) { return OUT_OF_MEMORY; } BIG_RESULT(&bigResult); case INST_LSHIFT: case INST_RSHIFT: { /* * Reject negative shift argument. */ |
︙ | ︙ | |||
8245 8246 8247 8248 8249 8250 8251 | } WIDE_RESULT(w1 >> shift); } } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); | | > | | | | > > > > | > | | | | | | | | | | > > > > | 8300 8301 8302 8303 8304 8305 8306 8307 8308 8309 8310 8311 8312 8313 8314 8315 8316 8317 8318 8319 8320 8321 8322 8323 8324 8325 8326 8327 8328 8329 8330 8331 8332 8333 8334 8335 8336 8337 8338 8339 8340 8341 8342 8343 8344 8345 8346 8347 8348 8349 8350 8351 8352 8353 8354 | } WIDE_RESULT(w1 >> shift); } } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); err = mp_init(&bigResult); if (err == MP_OKAY) { if (opcode == INST_LSHIFT) { err = mp_mul_2d(&big1, shift, &bigResult); } else { err = mp_signed_rsh(&big1, shift, &bigResult); } } if (err != MP_OKAY) { return OUT_OF_MEMORY; } mp_clear(&big1); BIG_RESULT(&bigResult); } case INST_BITOR: case INST_BITXOR: case INST_BITAND: if ((type1 != TCL_NUMBER_INT) || (type2 != TCL_NUMBER_INT)) { Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); err = mp_init(&bigResult); if (err == MP_OKAY) { switch (opcode) { case INST_BITAND: err = mp_and(&big1, &big2, &bigResult); break; case INST_BITOR: err = mp_or(&big1, &big2, &bigResult); break; case INST_BITXOR: err = mp_xor(&big1, &big2, &bigResult); break; } } if (err != MP_OKAY) { return OUT_OF_MEMORY; } mp_clear(&big1); mp_clear(&big2); BIG_RESULT(&bigResult); } |
︙ | ︙ | |||
8338 8339 8340 8341 8342 8343 8344 | } negativeExponent = (w2 < 0); oddExponent = (int) (w2 & (Tcl_WideInt)1); } else { Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); negativeExponent = mp_isneg(&big2); | | | | 8403 8404 8405 8406 8407 8408 8409 8410 8411 8412 8413 8414 8415 8416 8417 8418 | } negativeExponent = (w2 < 0); oddExponent = (int) (w2 & (Tcl_WideInt)1); } else { Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); negativeExponent = mp_isneg(&big2); err = mp_mod_2d(&big2, 1, &big2); oddExponent = (err == MP_OKAY) && !mp_iszero(&big2); mp_clear(&big2); } if (type1 == TCL_NUMBER_INT) { w1 = *((const Tcl_WideInt *)ptr1); if (negativeExponent) { |
︙ | ︙ | |||
8496 8497 8498 8499 8500 8501 8502 | || (value2Ptr->typePtr != &tclIntType) || (Tcl_WideUInt)w2 >= (1<<28)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); | | > | > > > > | 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 8576 8577 8578 8579 8580 8581 | || (value2Ptr->typePtr != &tclIntType) || (Tcl_WideUInt)w2 >= (1<<28)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); err = mp_init(&bigResult); if (err == MP_OKAY) { err = mp_expt_u32(&big1, (unsigned int)w2, &bigResult); } if (err != MP_OKAY) { return OUT_OF_MEMORY; } mp_clear(&big1); BIG_RESULT(&bigResult); } case INST_ADD: case INST_SUB: case INST_MULT: |
︙ | ︙ | |||
8644 8645 8646 8647 8648 8649 8650 | WIDE_RESULT(wResult); } overflowBasic: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); | | > | | | | | | | | | | | | | > | > | | | | | | | > | | > | | > > | > | > > > > | > > > | > > > | 8714 8715 8716 8717 8718 8719 8720 8721 8722 8723 8724 8725 8726 8727 8728 8729 8730 8731 8732 8733 8734 8735 8736 8737 8738 8739 8740 8741 8742 8743 8744 8745 8746 8747 8748 8749 8750 8751 8752 8753 8754 8755 8756 8757 8758 8759 8760 8761 8762 8763 8764 8765 8766 8767 8768 8769 8770 8771 8772 8773 8774 8775 8776 8777 8778 8779 8780 8781 8782 8783 8784 8785 8786 8787 8788 8789 8790 8791 8792 8793 8794 8795 8796 8797 8798 8799 8800 8801 8802 8803 8804 8805 8806 8807 8808 8809 8810 8811 8812 8813 8814 8815 8816 8817 8818 8819 8820 8821 8822 8823 8824 8825 8826 | WIDE_RESULT(wResult); } overflowBasic: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); err = mp_init(&bigResult); if (err == MP_OKAY) { switch (opcode) { case INST_ADD: err = mp_add(&big1, &big2, &bigResult); break; case INST_SUB: err = mp_sub(&big1, &big2, &bigResult); break; case INST_MULT: err = mp_mul(&big1, &big2, &bigResult); break; case INST_DIV: if (mp_iszero(&big2)) { mp_clear(&big1); mp_clear(&big2); mp_clear(&bigResult); return DIVIDED_BY_ZERO; } err = mp_init(&bigRemainder); if (err == MP_OKAY) { err = mp_div(&big1, &big2, &bigResult, &bigRemainder); } /* TODO: internals intrusion */ if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) { /* * Convert to Tcl's integer division rules. */ err = mp_sub_d(&bigResult, 1, &bigResult); if (err == MP_OKAY) { err = mp_add(&bigRemainder, &big2, &bigRemainder); } } mp_clear(&bigRemainder); break; } } mp_clear(&big1); mp_clear(&big2); BIG_RESULT(&bigResult); } Tcl_Panic("unexpected opcode"); return NULL; } static Tcl_Obj * ExecuteExtendedUnaryMathOp( int opcode, /* What operation to perform. */ Tcl_Obj *valuePtr) /* The operand on the stack. */ { ClientData ptr; int type; Tcl_WideInt w; mp_int big; Tcl_Obj *objResultPtr; mp_err err = MP_OKAY; (void) GetNumberFromObj(NULL, valuePtr, &ptr, &type); switch (opcode) { case INST_BITNOT: if (type == TCL_NUMBER_INT) { w = *((const Tcl_WideInt *) ptr); WIDE_RESULT(~w); } Tcl_TakeBignumFromObj(NULL, valuePtr, &big); /* ~a = - a - 1 */ err = mp_neg(&big, &big); if (err == MP_OKAY) { err = mp_sub_d(&big, 1, &big); } if (err != MP_OKAY) { return OUT_OF_MEMORY; } BIG_RESULT(&big); case INST_UMINUS: switch (type) { case TCL_NUMBER_DOUBLE: DOUBLE_RESULT(-(*((const double *) ptr))); case TCL_NUMBER_INT: w = *((const Tcl_WideInt *) ptr); if (w != WIDE_MIN) { WIDE_RESULT(-w); } err = mp_init_i64(&big, w); if (err != MP_OKAY) { return OUT_OF_MEMORY; } break; default: Tcl_TakeBignumFromObj(NULL, valuePtr, &big); } err = mp_neg(&big, &big); if (err != MP_OKAY) { return OUT_OF_MEMORY; } BIG_RESULT(&big); } Tcl_Panic("unexpected opcode"); return NULL; } #undef WIDE_RESULT |
︙ | ︙ | |||
8820 8821 8822 8823 8824 8825 8826 8827 8828 8829 8830 8831 8832 8833 | compare = MP_GT; } else { compare = MP_LT; } mp_clear(&big2); return compare; } case TCL_NUMBER_DOUBLE: d1 = *((const double *)ptr1); switch (type2) { case TCL_NUMBER_DOUBLE: d2 = *((const double *)ptr2); doubleCompare: | > | 8908 8909 8910 8911 8912 8913 8914 8915 8916 8917 8918 8919 8920 8921 8922 | compare = MP_GT; } else { compare = MP_LT; } mp_clear(&big2); return compare; } break; case TCL_NUMBER_DOUBLE: d1 = *((const double *)ptr1); switch (type2) { case TCL_NUMBER_DOUBLE: d2 = *((const double *)ptr2); doubleCompare: |
︙ | ︙ | |||
8866 8867 8868 8869 8870 8871 8872 8873 8874 8875 8876 8877 8878 8879 | d2 = TclBignumToDouble(&big2); mp_clear(&big2); goto doubleCompare; } Tcl_InitBignumFromDouble(NULL, d1, &big1); goto bigCompare; } case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { case TCL_NUMBER_INT: compare = mp_cmp_d(&big1, 0); mp_clear(&big1); | > | 8955 8956 8957 8958 8959 8960 8961 8962 8963 8964 8965 8966 8967 8968 8969 | d2 = TclBignumToDouble(&big2); mp_clear(&big2); goto doubleCompare; } Tcl_InitBignumFromDouble(NULL, d1, &big1); goto bigCompare; } break; case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { case TCL_NUMBER_INT: compare = mp_cmp_d(&big1, 0); mp_clear(&big1); |
︙ | ︙ | |||
8902 8903 8904 8905 8906 8907 8908 8909 8910 | Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); bigCompare: compare = mp_cmp(&big1, &big2); mp_clear(&big1); mp_clear(&big2); return compare; } default: Tcl_Panic("unexpected number type"); | > < > | 8992 8993 8994 8995 8996 8997 8998 8999 9000 9001 9002 9003 9004 9005 9006 9007 9008 9009 9010 | Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); bigCompare: compare = mp_cmp(&big1, &big2); mp_clear(&big1); mp_clear(&big2); return compare; } break; default: Tcl_Panic("unexpected number type"); } return TCL_ERROR; } #ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * * PrintByteCodeInfo -- |
︙ | ︙ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
200 201 202 203 204 205 206 | static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr, int calledFromAsyncFlush); static int TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr); static Tcl_Encoding GetBinaryEncoding(); static void FreeBinaryEncoding(ClientData clientData); static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp); static int GetInput(Channel *chanPtr); | < < | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 | static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr, int calledFromAsyncFlush); static int TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr); static Tcl_Encoding GetBinaryEncoding(); static void FreeBinaryEncoding(ClientData clientData); static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp); static int GetInput(Channel *chanPtr); static void PeekAhead(Channel *chanPtr, char **dstEndPtr, GetsState *gsPtr); static int ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr, int charsLeft); static int ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr, int charsLeft, int *factorPtr); static void RecycleBuffer(ChannelState *statePtr, |
︙ | ︙ | |||
488 489 490 491 492 493 494 | int *errnoPtr) { /* * Note that we prefer the wideSeekProc if that field is available in the * type and non-NULL. */ | < | | | | 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 | int *errnoPtr) { /* * Note that we prefer the wideSeekProc if that field is available in the * type and non-NULL. */ if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) { return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData, offset, mode, errnoPtr); } if (offset<LONG_MIN || offset>LONG_MAX) { *errnoPtr = EOVERFLOW; return -1; } return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData, offset, mode, errnoPtr); } static inline void ChanThreadAction( Channel *chanPtr, int action) |
︙ | ︙ | |||
4212 4213 4214 4215 4216 4217 4218 | static void WillWrite( Channel *chanPtr) { int inputBuffered; | | | 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 | static void WillWrite( Channel *chanPtr) { int inputBuffered; if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ int ignore; DiscardInputQueued(chanPtr->state, 0); ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore); } } |
︙ | ︙ | |||
4234 4235 4236 4237 4238 4239 4240 | * Prevent read attempts on a closed channel. */ DiscardInputQueued(chanPtr->state, 0); Tcl_SetErrno(EINVAL); return -1; } | | | 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 | * Prevent read attempts on a closed channel. */ DiscardInputQueued(chanPtr->state, 0); Tcl_SetErrno(EINVAL); return -1; } if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { /* * CAVEAT - The assumption here is that FlushChannel() will push out * the bytes of any writes that are in progress. Since this is a * seekable channel, we assume it is not one that can block and force * bg flushing. Channels we know that can do that - sockets, pipes - * are not seekable. If the assumption is wrong, more drastic measures |
︙ | ︙ | |||
4716 4717 4718 4719 4720 4721 4722 | int rawRead; char tmp[TCL_UTF_MAX]; bufPtr = gs.bufPtr; Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead, statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, &gs.state, tmp, | | | 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 | int rawRead; char tmp[TCL_UTF_MAX]; bufPtr = gs.bufPtr; Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead, statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, &gs.state, tmp, sizeof(tmp), &rawRead, NULL, NULL); bufPtr->nextRemoved += rawRead; gs.rawRead -= rawRead; gs.bytesWrote--; gs.charsWrote--; memmove(dst, dst + 1, (size_t) (dstEnd - dst)); dstEnd--; } |
︙ | ︙ | |||
6280 6281 6282 6283 6284 6285 6286 | assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0 || 0 == (statePtr->inputEncodingFlags & TCL_ENCODING_END)); Tcl_ExternalToUtf(NULL, encoding, src, srcLen, (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE), | | | 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 | assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0 || 0 == (statePtr->inputEncodingFlags & TCL_ENCODING_END)); Tcl_ExternalToUtf(NULL, encoding, src, srcLen, (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE), &statePtr->inputEncodingState, buffer, sizeof(buffer), &read, &decoded, &count); if (count == 2) { if (buffer[1] == '\n') { /* \r\n translate to \n */ dst[0] = '\n'; bufPtr->nextRemoved += read; |
︙ | ︙ | |||
6995 6996 6997 6998 6999 7000 7001 | chanPtr = statePtr->topChanPtr; /* * Disallow seek on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ | | | 6992 6993 6994 6995 6996 6997 6998 6999 7000 7001 7002 7003 7004 7005 7006 | chanPtr = statePtr->topChanPtr; /* * Disallow seek on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) { Tcl_SetErrno(EINVAL); return -1; } /* * Compute how much input and output is buffered. If both input and output * is buffered, cannot compute the current position. |
︙ | ︙ | |||
7159 7160 7161 7162 7163 7164 7165 | chanPtr = statePtr->topChanPtr; /* * Disallow tell on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ | | | 7156 7157 7158 7159 7160 7161 7162 7163 7164 7165 7166 7167 7168 7169 7170 | chanPtr = statePtr->topChanPtr; /* * Disallow tell on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) { Tcl_SetErrno(EINVAL); return -1; } /* * Compute how much input and output is buffered. If both input and output * is buffered, cannot compute the current position. |
︙ | ︙ | |||
10498 10499 10500 10501 10502 10503 10504 | */ Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | < | < < < < < | < < < < < < < < < < < < < < < < < < < < < < < | < < < < < | 10495 10496 10497 10498 10499 10500 10501 10502 10503 10504 10505 10506 10507 10508 10509 10510 10511 10512 10513 10514 10515 10516 10517 | */ Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if ((chanTypePtr->version < TCL_CHANNEL_VERSION_2) || (chanTypePtr->version > TCL_CHANNEL_VERSION_5)) { /* * In <v2 channel versions, the version field is occupied by the * Tcl_DriverBlockModeProc */ return TCL_CHANNEL_VERSION_1; } return chanTypePtr->version; } /* *---------------------------------------------------------------------- * * Tcl_ChannelBlockModeProc -- * |
︙ | ︙ | |||
10563 10564 10565 10566 10567 10568 10569 | *---------------------------------------------------------------------- */ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | < < < | | | > | | > | 10526 10527 10528 10529 10530 10531 10532 10533 10534 10535 10536 10537 10538 10539 10540 10541 10542 10543 10544 10545 10546 10547 | *---------------------------------------------------------------------- */ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { /* * The v1 structure had the blockModeProc in a different place. */ return (Tcl_DriverBlockModeProc *) chanTypePtr->version; } return chanTypePtr->blockModeProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelCloseProc -- * |
︙ | ︙ | |||
10811 10812 10813 10814 10815 10816 10817 | */ Tcl_DriverFlushProc * Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | | | | 10773 10774 10775 10776 10777 10778 10779 10780 10781 10782 10783 10784 10785 10786 10787 10788 10789 10790 | */ Tcl_DriverFlushProc * Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { return NULL; } return chanTypePtr->flushProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelHandlerProc -- * |
︙ | ︙ | |||
10838 10839 10840 10841 10842 10843 10844 | */ Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | | | | 10800 10801 10802 10803 10804 10805 10806 10807 10808 10809 10810 10811 10812 10813 10814 10815 10816 10817 | */ Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { return NULL; } return chanTypePtr->handlerProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelWideSeekProc -- * |
︙ | ︙ | |||
10865 10866 10867 10868 10869 10870 10871 | */ Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | | | | 10827 10828 10829 10830 10831 10832 10833 10834 10835 10836 10837 10838 10839 10840 10841 10842 10843 10844 | */ Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_3) { return NULL; } return chanTypePtr->wideSeekProc; } /* *---------------------------------------------------------------------- * * Tcl_ChannelThreadActionProc -- * |
︙ | ︙ | |||
10893 10894 10895 10896 10897 10898 10899 | */ Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | | | | 10855 10856 10857 10858 10859 10860 10861 10862 10863 10864 10865 10866 10867 10868 10869 10870 10871 10872 | */ Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_4) { return NULL; } return chanTypePtr->threadActionProc; } /* *---------------------------------------------------------------------- * * Tcl_SetChannelErrorInterp -- * |
︙ | ︙ | |||
11208 11209 11210 11211 11212 11213 11214 | */ Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { | | | | | 11170 11171 11172 11173 11174 11175 11176 11177 11178 11179 11180 11181 11182 11183 11184 11185 11186 11187 | */ Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_5) { return NULL; } return chanTypePtr->truncateProc; } /* *---------------------------------------------------------------------- * * DupChannelIntRep -- * |
︙ | ︙ |
Changes to generic/tclIOCmd.c.
︙ | ︙ | |||
715 716 717 718 719 720 721 | " or already closed", dirOptions[index])); return TCL_ERROR; } /* * Special handling is needed if and only if the channel mode supports * more than the direction to close. Because if the close the last | | | 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 | " or already closed", dirOptions[index])); return TCL_ERROR; } /* * Special handling is needed if and only if the channel mode supports * more than the direction to close. Because if the close the last * direction supported we can and will go through the regular * process. */ if ((Tcl_GetChannelMode(chan) & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) != dir) { return Tcl_CloseEx(interp, chan, dir); } |
︙ | ︙ |
Changes to generic/tclIORTrans.c.
︙ | ︙ | |||
23 24 25 26 27 28 29 | #ifndef EINVAL #define EINVAL 9 #endif #ifndef EOK #define EOK 0 #endif | < < < < | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | #ifndef EINVAL #define EINVAL 9 #endif #ifndef EOK #define EOK 0 #endif /* * Signatures of all functions used in the C layer of the reflection. */ static int ReflectClose(ClientData clientData, Tcl_Interp *interp); static int ReflectInput(ClientData clientData, char *buf, |
︙ | ︙ | |||
1384 1385 1386 1387 1388 1389 1390 | /* * Now seek to the new position in the channel as requested by the * caller. Note that we prefer the wideSeekProc if that is available and * non-NULL... */ | < | | | | 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 | /* * Now seek to the new position in the channel as requested by the * caller. Note that we prefer the wideSeekProc if that is available and * non-NULL... */ if (Tcl_ChannelWideSeekProc(parent->typePtr) != NULL) { curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset, seekMode, errorCodePtr); } else if (offset < LONG_MIN || offset > LONG_MAX) { *errorCodePtr = EOVERFLOW; curPos = -1; } else { curPos = Tcl_ChannelSeekProc(parent->typePtr)( parent->instanceData, offset, seekMode, errorCodePtr); } if (curPos == -1) { Tcl_SetErrno(*errorCodePtr); } |
︙ | ︙ | |||
3390 3391 3392 3393 3394 3395 3396 | return 0; } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_RestoreInterpState(rtPtr->interp, sr); return 1; } | < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 | return 0; } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_RestoreInterpState(rtPtr->interp, sr); return 1; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclIOUtil.c.
︙ | ︙ | |||
166 167 168 169 170 171 172 | TclpObjRemoveDirectory, TclpObjDeleteFile, TclpObjCopyFile, TclpObjRenameFile, TclpObjCopyDirectory, TclpObjLstat, /* Needs casts since we're using version_2. */ | | | 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 | TclpObjRemoveDirectory, TclpObjDeleteFile, TclpObjCopyFile, TclpObjRenameFile, TclpObjCopyDirectory, TclpObjLstat, /* Needs casts since we're using version_2. */ (Tcl_FSLoadFileProc *)(void *) TclpDlopen, (Tcl_FSGetCwdProc *) TclpGetNativeCwd, TclpObjChdir }; /* * An initial record in the linked list for the native filesystem. Remains at * the tail of the list and is never freed. Currently the native filesystem is |
︙ | ︙ | |||
3177 3178 3179 3180 3181 3182 3183 | if (fsPtr == NULL) { Tcl_SetErrno(ENOENT); return TCL_ERROR; } if (fsPtr->loadFileProc != NULL) { | | | 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 | if (fsPtr == NULL) { Tcl_SetErrno(ENOENT); return TCL_ERROR; } if (fsPtr->loadFileProc != NULL) { int retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc)) (interp, pathPtr, handlePtr, &unloadProcPtr, flags); if (retVal == TCL_OK) { if (*handlePtr == NULL) { return TCL_ERROR; } if (interp) { |
︙ | ︙ |
Changes to generic/tclInt.decls.
︙ | ︙ | |||
376 377 378 379 380 381 382 | const char *procName) } declare 93 { void TclProcDeleteProc(ClientData clientData) } # Removed in 8.5: #declare 94 { | | | 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 | const char *procName) } declare 93 { void TclProcDeleteProc(ClientData clientData) } # Removed in 8.5: #declare 94 { # int TclProcInterpProc(void *clientData, Tcl_Interp *interp, # int argc, const char **argv) #} # Replaced by Tcl_FSStat in 8.4: #declare 95 { # int TclpStat(const char *path, Tcl_StatBuf *buf) #} declare 96 { |
︙ | ︙ | |||
549 550 551 552 553 554 555 | #} 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, | | | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 | #} 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, void **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) |
︙ | ︙ | |||
604 605 606 607 608 609 610 | } declare 153 { Tcl_Obj *TclGetLibraryPath(void) } # moved to tclTest.c (static) in 8.3.2/8.4a2 #declare 154 { | | | | 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 | } declare 153 { Tcl_Obj *TclGetLibraryPath(void) } # moved to tclTest.c (static) in 8.3.2/8.4a2 #declare 154 { # int TclTestChannelCmd(void *clientData, # Tcl_Interp *interp, int argc, char **argv) #} #declare 155 { # int TclTestChannelEventCmd(void *clientData, # Tcl_Interp *interp, int argc, char **argv) #} declare 156 { void TclRegError(Tcl_Interp *interp, const char *msg, int status) } |
︙ | ︙ | |||
1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 | } # TIP 431: temporary directory creation function declare 258 { Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj) } ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. interface tclIntPlat | > > > > | 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 | } # TIP 431: temporary directory creation function declare 258 { Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj) } declare 259 { void TclUnusedStubEntry(void) } ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. interface tclIntPlat |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2910 2911 2912 2913 2914 2915 2916 | MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int cmd, int pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, CmdFrame **cfPtrPtr, int *wordPtr); | | | | 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 | MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int cmd, int pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, CmdFrame **cfPtrPtr, int *wordPtr); MODULE_SCOPE double TclBignumToDouble(const void *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, int strLen, const unsigned char *pattern, int ptnLen, int flags); MODULE_SCOPE double TclCeil(const void *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *name, int index); MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, const char *value); MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr); |
︙ | ︙ | |||
2997 2998 2999 3000 3001 3002 3003 | MODULE_SCOPE void TclFinalizePreserve(void); MODULE_SCOPE void TclFinalizeSynchronization(void); MODULE_SCOPE void TclInitThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(int quick); MODULE_SCOPE void TclFinalizeThreadObjects(void); | | | 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 | MODULE_SCOPE void TclFinalizePreserve(void); MODULE_SCOPE void TclFinalizeSynchronization(void); MODULE_SCOPE void TclInitThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(int quick); MODULE_SCOPE void TclFinalizeThreadObjects(void); MODULE_SCOPE double TclFloor(const void *a); MODULE_SCOPE void TclFormatNaN(double value, char *buffer); MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, const char *attributeName, int *indexPtr); MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, |
︙ | ︙ | |||
3054 3055 3056 3057 3058 3059 3060 | MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclInitAlloc(void); | < < | 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 | MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclInitAlloc(void); MODULE_SCOPE void TclInitDbCkalloc(void); MODULE_SCOPE void TclInitDoubleConversion(void); MODULE_SCOPE void TclInitEmbeddedConfigurationInformation( Tcl_Interp *interp); MODULE_SCOPE void TclInitEncodingSubsystem(void); MODULE_SCOPE void TclInitIOSubsystem(void); MODULE_SCOPE void TclInitLimitSupport(Tcl_Interp *interp); |
︙ | ︙ | |||
3190 3191 3192 3193 3194 3195 3196 | 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, | | | 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 | 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, void *bignumValue); MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr); MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding); |
︙ | ︙ | |||
4626 4627 4628 4629 4630 4631 4632 | * string handling. The macro's expression result is 1 for the 1-byte case or * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ | | | 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 | * string handling. The macro's expression result is 1 for the 1-byte case or * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ #if TCL_UTF_MAX > 3 #define TclUtfToUniChar(str, chPtr) \ ((((unsigned char) *(str)) < 0x80) ? \ ((*(chPtr) = (unsigned char) *(str)), 1) \ : Tcl_UtfToUniChar(str, chPtr)) #else #define TclUtfToUniChar(str, chPtr) \ ((((unsigned char) *(str)) < 0x80) ? \ |
︙ | ︙ |
Changes to generic/tclIntDecls.h.
︙ | ︙ | |||
654 655 656 657 658 659 660 661 662 663 664 665 666 667 | EXTERN void TclStaticPackage(Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 258 */ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); typedef struct TclIntStubs { int magic; void *hooks; void (*reserved0)(void); void (*reserved1)(void); | > > | 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 | EXTERN void TclStaticPackage(Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 258 */ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 259 */ EXTERN void TclUnusedStubEntry(void); typedef struct TclIntStubs { int magic; void *hooks; void (*reserved0)(void); void (*reserved1)(void); |
︙ | ︙ | |||
918 919 920 921 922 923 924 925 926 927 928 929 930 931 | Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */ int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */ int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */ void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; #ifdef __cplusplus } #endif | > | 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 | Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */ int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */ int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */ void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */ void (*tclUnusedStubEntry) (void); /* 259 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 | (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticPackage \ (tclIntStubsPtr->tclStaticPackage) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT | > > | 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 | (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticPackage \ (tclIntStubsPtr->tclStaticPackage) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ #define TclUnusedStubEntry \ (tclIntStubsPtr->tclUnusedStubEntry) /* 259 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT |
︙ | ︙ |
Changes to generic/tclLink.c.
︙ | ︙ | |||
160 161 162 163 164 165 166 | Tcl_Obj *objPtr; Link *linkPtr; Namespace *dummy; const char *name; int code; linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, | | | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | Tcl_Obj *objPtr; Link *linkPtr; Namespace *dummy; const char *name; int code; linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, TCL_GLOBAL_ONLY, LinkTraceProc, NULL); if (linkPtr != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "variable '%s' is already linked", varName)); return TCL_ERROR; } linkPtr = (Link *)ckalloc(sizeof(Link)); |
︙ | ︙ |
Changes to generic/tclLoad.c.
︙ | ︙ | |||
882 883 884 885 886 887 888 | if (ipPtr->pkgPtr == defaultPtr) { ipFirstPtr = ipFirstPtr->nextPtr; } else { InterpPackage *ipPrevPtr; for (ipPrevPtr = ipPtr; ipPtr != NULL; ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) { | | | 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 | if (ipPtr->pkgPtr == defaultPtr) { ipFirstPtr = ipFirstPtr->nextPtr; } else { InterpPackage *ipPrevPtr; for (ipPrevPtr = ipPtr; ipPtr != NULL; ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) { if (ipPtr->pkgPtr == defaultPtr) { ipPrevPtr->nextPtr = ipPtr->nextPtr; break; } } } Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
178 179 180 181 182 183 184 | #define PACK_BIGNUM(bignum, objPtr) \ if ((bignum).used > 0x7fff) { \ mp_int *temp = (mp_int *) ckalloc(sizeof(mp_int)); \ *temp = bignum; \ (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ | < < | < | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | #define PACK_BIGNUM(bignum, objPtr) \ if ((bignum).used > 0x7fff) { \ mp_int *temp = (mp_int *) ckalloc(sizeof(mp_int)); \ *temp = bignum; \ (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ } else if (((bignum).alloc <= 0x7fff) || (mp_shrink(&(bignum))) == MP_OKAY) { \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \ | ((bignum).alloc << 15) | ((bignum).used)); \ } /* * Prototypes for functions defined later in this file: |
︙ | ︙ | |||
3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 | TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; } if (objPtr->typePtr == &tclBignumType) { mp_int big; Tcl_WideUInt value = 0, scratch; size_t numBytes; unsigned char *bytes = (unsigned char *) &scratch; Tcl_GetBignumFromObj(NULL, objPtr, &big); | > | > | > > > > | 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 | TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; } if (objPtr->typePtr == &tclBignumType) { mp_int big; mp_err err; Tcl_WideUInt value = 0, scratch; size_t numBytes; unsigned char *bytes = (unsigned char *) &scratch; Tcl_GetBignumFromObj(NULL, objPtr, &big); err = mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big); if (err == MP_OKAY) { err = mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes); } if (err != MP_OKAY) { return TCL_ERROR; } while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } *wideIntPtr = !big.sign ? (Tcl_WideInt)value : -(Tcl_WideInt)value; mp_clear(&big); return TCL_OK; } |
︙ | ︙ | |||
3508 3509 3510 3511 3512 3513 3514 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewBignumObj Tcl_Obj * Tcl_NewBignumObj( | | | | 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewBignumObj Tcl_Obj * Tcl_NewBignumObj( void *bignumValue) { return Tcl_DbNewBignumObj(bignumValue, "unknown", 0); } #else Tcl_Obj * Tcl_NewBignumObj( void *bignumValue) { Tcl_Obj *objPtr; TclNewObj(objPtr); Tcl_SetBignumObj(objPtr, bignumValue); return objPtr; } |
︙ | ︙ | |||
3546 3547 3548 3549 3550 3551 3552 | * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewBignumObj( | | | | 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 | * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewBignumObj( void *bignumValue, const char *file, int line) { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); Tcl_SetBignumObj(objPtr, bignumValue); return objPtr; } #else Tcl_Obj * Tcl_DbNewBignumObj( void *bignumValue, const char *file, int line) { (void)file; (void)line; return Tcl_NewBignumObj(bignumValue); |
︙ | ︙ | |||
3604 3605 3606 3607 3608 3609 3610 | { do { if (objPtr->typePtr == &tclBignumType) { if (copy || Tcl_IsShared(objPtr)) { mp_int temp; TclUnpackBignum(objPtr, temp); | | > > | | > > | 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 | { do { if (objPtr->typePtr == &tclBignumType) { if (copy || Tcl_IsShared(objPtr)) { mp_int temp; TclUnpackBignum(objPtr, temp); if (mp_init_copy(bignumValue, &temp) != MP_OKAY) { return TCL_ERROR; } } else { TclUnpackBignum(objPtr, *bignumValue); /* Optimized TclFreeIntRep */ objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = NULL; /* * TODO: If objPtr has a string rep, this leaves * it undisturbed. Not clear that's proper. Pure * bignum values are converted to empty string. */ if (objPtr->bytes == NULL) { TclInitStringRep(objPtr, NULL, 0); } } return TCL_OK; } if (objPtr->typePtr == &tclIntType) { if (mp_init_i64(bignumValue, objPtr->internalRep.wideValue) != MP_OKAY) { return TCL_ERROR; } return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", TclGetString(objPtr))); |
︙ | ︙ | |||
3670 3671 3672 3673 3674 3675 3676 | *---------------------------------------------------------------------- */ int Tcl_GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ | | | | 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 | *---------------------------------------------------------------------- */ int Tcl_GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ void *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 1, (mp_int *)bignumValue); } /* *---------------------------------------------------------------------- * * Tcl_TakeBignumFromObj -- * |
︙ | ︙ | |||
3705 3706 3707 3708 3709 3710 3711 | *---------------------------------------------------------------------- */ int Tcl_TakeBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ | | | | 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 | *---------------------------------------------------------------------- */ int Tcl_TakeBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ void *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 0, (mp_int *)bignumValue); } /* *---------------------------------------------------------------------- * * Tcl_SetBignumObj -- * |
︙ | ︙ | |||
3730 3731 3732 3733 3734 3735 3736 | * *---------------------------------------------------------------------- */ void Tcl_SetBignumObj( Tcl_Obj *objPtr, /* Object to set */ | | > | 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 | * *---------------------------------------------------------------------- */ void Tcl_SetBignumObj( Tcl_Obj *objPtr, /* Object to set */ void *big) /* Value to store */ { Tcl_WideUInt value = 0; size_t numBytes; Tcl_WideUInt scratch; unsigned char *bytes = (unsigned char *) &scratch; mp_int *bignumValue = (mp_int *) big; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj"); } if (mp_to_ubin(bignumValue, bytes, sizeof(Tcl_WideUInt), &numBytes) != MP_OKAY) { goto tooLargeForWide; } |
︙ | ︙ | |||
3783 3784 3785 3786 3787 3788 3789 | * *---------------------------------------------------------------------- */ void TclSetBignumIntRep( Tcl_Obj *objPtr, | | > | 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 | * *---------------------------------------------------------------------- */ void TclSetBignumIntRep( Tcl_Obj *objPtr, void *big) { mp_int *bignumValue = (mp_int *)big; objPtr->typePtr = &tclBignumType; PACK_BIGNUM(*bignumValue, objPtr); /* * Clear the mp_int value. * * Don't call mp_clear() because it would free the digit array we just |
︙ | ︙ |
Changes to generic/tclParse.c.
︙ | ︙ | |||
932 933 934 935 936 937 938 | * special, we shouldn't break up a correct utf-8 character. [Bug * #217987] test subst-3.2 */ if (Tcl_UtfCharComplete(p, numBytes - 1)) { count = TclUtfToUniChar(p, &unichar) + 1; /* +1 for '\' */ } else { | | | 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 | * special, we shouldn't break up a correct utf-8 character. [Bug * #217987] test subst-3.2 */ if (Tcl_UtfCharComplete(p, numBytes - 1)) { count = TclUtfToUniChar(p, &unichar) + 1; /* +1 for '\' */ } else { char utfBytes[4]; memcpy(utfBytes, p, numBytes - 1); utfBytes[numBytes - 1] = '\0'; count = TclUtfToUniChar(utfBytes, &unichar) + 1; } result = unichar; break; |
︙ | ︙ |
Changes to generic/tclResult.c.
︙ | ︙ | |||
849 850 851 852 853 854 855 | } else if (iPtr->result != iPtr->appendResult) { strcpy(iPtr->appendResult, iPtr->result); } Tcl_FreeResult((Tcl_Interp *) iPtr); iPtr->result = iPtr->appendResult; } | < | 849 850 851 852 853 854 855 856 857 858 859 860 861 862 | } else if (iPtr->result != iPtr->appendResult) { strcpy(iPtr->appendResult, iPtr->result); } Tcl_FreeResult((Tcl_Interp *) iPtr); iPtr->result = iPtr->appendResult; } /* *---------------------------------------------------------------------- * * Tcl_FreeResult -- * * This function frees up the memory associated with an interpreter's |
︙ | ︙ | |||
879 880 881 882 883 884 885 | void Tcl_FreeResult( Tcl_Interp *interp)/* Interpreter for which to free result. */ { Interp *iPtr = (Interp *) interp; | < < > | | 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 | void Tcl_FreeResult( Tcl_Interp *interp)/* Interpreter for which to free result. */ { Interp *iPtr = (Interp *) interp; if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { iPtr->freeProc(iPtr->result); } iPtr->freeProc = 0; } ResetObjResult(iPtr); } #endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * * Tcl_ResetResult -- * * This function resets both the interpreter's string and object results. * |
︙ | ︙ |
Changes to generic/tclScan.c.
︙ | ︙ | |||
263 264 265 266 267 268 269 | Tcl_UniChar ch = 0; int objIndex, xpgSize, nspace = numVars; int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int)); Tcl_Obj *errorMsg; /* Place to build an error messages. Note that * these are messy operations because we do * not want to use the formatting engine; * we're inside there! */ | | | 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 | Tcl_UniChar ch = 0; int objIndex, xpgSize, nspace = numVars; int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int)); Tcl_Obj *errorMsg; /* Place to build an error messages. Note that * these are messy operations because we do * not want to use the formatting engine; * we're inside there! */ char buf[5] = ""; /* * Initialize an array that records the number of times a variable is * assigned to by the format string. We use this to detect if a variable * is multiply assigned or left unassigned. */ |
︙ | ︙ | |||
876 877 878 879 880 881 882 | case 'c': /* * Scan a single Unicode character. */ offset = TclUtfToUniChar(string, &sch); i = (int)sch; | | | 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 | case 'c': /* * Scan a single Unicode character. */ offset = TclUtfToUniChar(string, &sch); i = (int)sch; #if TCL_UTF_MAX <= 3 if ((sch >= 0xD800) && (offset < 3)) { offset += TclUtfToUniChar(string+offset, &sch); i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF); } #endif string += offset; if (!(flags & SCAN_SUPPRESS)) { |
︙ | ︙ |
Changes to generic/tclStrToD.c.
︙ | ︙ | |||
11 12 13 14 15 16 17 18 19 | * * 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 "tclTomMath.h" #include <math.h> | > < < < < | < < < | < | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | * * 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 "tclTomMath.h" #include <float.h> #include <math.h> #ifdef _WIN32 #define copysign _copysign #endif /* * 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. */ |
︙ | ︙ | |||
306 307 308 309 310 311 312 | Tcl_WideUInt significand, int nSigDigs, long exponent); #ifdef IEEE_FLOATING_POINT static double MakeNaN(int signum, Tcl_WideUInt tag); #endif static double RefineApproximation(double approx, mp_int *exactSignificand, int exponent); | | | 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 | Tcl_WideUInt significand, int nSigDigs, long exponent); #ifdef IEEE_FLOATING_POINT static double MakeNaN(int signum, Tcl_WideUInt tag); #endif static double RefineApproximation(double approx, mp_int *exactSignificand, int exponent); static mp_err MulPow5(mp_int *, unsigned, mp_int *) MP_WUR; static int NormalizeRightward(Tcl_WideUInt *); static int RequiredPrecision(Tcl_WideUInt); static void DoubleToExpAndSig(double, Tcl_WideUInt *, int *, int *); static void TakeAbsoluteValue(Double *, int *); static char * FormatInfAndNaN(Double *, int *, char **); static char * FormatZero(int *, char **); |
︙ | ︙ | |||
537 538 539 540 541 542 543 544 545 546 547 548 549 550 | 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 */ int explicitOctal = 0; #define ALL_BITS ((Tcl_WideUInt)-1) #define MOST_BITS (ALL_BITS >> 1) /* * Initialize bytes to start of the object's string rep if the caller * didn't pass anything else. | > | 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 | 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 */ int explicitOctal = 0; mp_err err = MP_OKAY; #define ALL_BITS ((Tcl_WideUInt)-1) #define MOST_BITS (ALL_BITS >> 1) /* * Initialize bytes to start of the object's string rep if the caller * didn't pass anything else. |
︙ | ︙ | |||
719 720 721 722 723 724 725 | if ((octalSignificandWide != 0) && (((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt)) || (octalSignificandWide > ((Tcl_WideUInt)-1 >> shift)))) { octalSignificandOverflow = 1; | | > | | > > | | > > > > | 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 | if ((octalSignificandWide != 0) && (((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt)) || (octalSignificandWide > ((Tcl_WideUInt)-1 >> shift)))) { octalSignificandOverflow = 1; err = mp_init_u64(&octalSignificandBig, octalSignificandWide); } } if (!octalSignificandOverflow) { octalSignificandWide = (octalSignificandWide << shift) + (c - '0'); } else { if (err == MP_OKAY) { err = mp_mul_2d(&octalSignificandBig, shift, &octalSignificandBig); } if (err == MP_OKAY) { err = mp_add_d(&octalSignificandBig, (mp_digit)(c - '0'), &octalSignificandBig); } } if (err != MP_OKAY) { return TCL_ERROR; } } if (numSigDigs != 0) { numSigDigs += numTrailZeros+1; } else { numSigDigs = 1; } |
︙ | ︙ | |||
836 837 838 839 840 841 842 | * large shifts first. */ if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > ((Tcl_WideUInt)-1 >> shift))) { significandOverflow = 1; | | | | > | | > > > > | 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 | * large shifts first. */ if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > ((Tcl_WideUInt)-1 >> shift))) { significandOverflow = 1; err = mp_init_u64(&significandBig, significandWide); } } if (!significandOverflow) { significandWide = (significandWide << shift) + d; } else if (err == MP_OKAY) { err = mp_mul_2d(&significandBig, shift, &significandBig); if (err == MP_OKAY) { err = mp_add_d(&significandBig, (mp_digit) d, &significandBig); } } } if (err != MP_OKAY) { return TCL_ERROR; } numTrailZeros = 0; state = HEXADECIMAL; break; case BINARY: acceptState = state; |
︙ | ︙ | |||
878 879 880 881 882 883 884 | * large shifts first. */ if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > ((Tcl_WideUInt)-1 >> shift))) { significandOverflow = 1; | | | | > | | > > > > | 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 | * large shifts first. */ if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > ((Tcl_WideUInt)-1 >> shift))) { significandOverflow = 1; err = mp_init_u64(&significandBig, significandWide); } } if (!significandOverflow) { significandWide = (significandWide << shift) + 1; } else if (err == MP_OKAY) { err = mp_mul_2d(&significandBig, shift, &significandBig); if (err == MP_OKAY) { err = mp_add_d(&significandBig, (mp_digit) 1, &significandBig); } } } if (err != MP_OKAY) { return TCL_ERROR; } numTrailZeros = 0; state = BINARY; break; case ZERO_D: if (c == '0') { |
︙ | ︙ | |||
1223 1224 1225 1226 1227 1228 1229 | acceptState, bytes); case BINARY: shift = numTrailZeros; if (!significandOverflow && significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > (MOST_BITS + signum) >> shift)) { significandOverflow = 1; | | | | > > > | | | > > > | | | | | | | > > > | | | | | | > > > | 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 | acceptState, bytes); case BINARY: shift = numTrailZeros; if (!significandOverflow && significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > (MOST_BITS + signum) >> shift)) { significandOverflow = 1; err = mp_init_u64(&significandBig, significandWide); } if (shift) { if (!significandOverflow) { significandWide <<= shift; } else if (err == MP_OKAY) { err = mp_mul_2d(&significandBig, shift, &significandBig); } } if (err != MP_OKAY) { return TCL_ERROR; } goto returnInteger; case HEXADECIMAL: /* * Returning a hex integer. Final scaling step. */ shift = 4 * numTrailZeros; if (!significandOverflow && significandWide !=0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > (MOST_BITS + signum) >> shift)) { significandOverflow = 1; err = mp_init_u64(&significandBig, significandWide); } if (shift) { if (!significandOverflow) { significandWide <<= shift; } else if (err == MP_OKAY) { err = mp_mul_2d(&significandBig, shift, &significandBig); } } if (err != MP_OKAY) { return TCL_ERROR; } goto returnInteger; case OCTAL: /* * Returning an octal integer. Final scaling step. */ shift = 3 * numTrailZeros; if (!octalSignificandOverflow && octalSignificandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || octalSignificandWide > (MOST_BITS + signum) >> shift)) { octalSignificandOverflow = 1; err = mp_init_u64(&octalSignificandBig, octalSignificandWide); } if (shift) { if (!octalSignificandOverflow) { octalSignificandWide <<= shift; } else if (err == MP_OKAY) { err = mp_mul_2d(&octalSignificandBig, shift, &octalSignificandBig); } } if (!octalSignificandOverflow) { if ((err == MP_OKAY) && (octalSignificandWide > (MOST_BITS + signum))) { err = mp_init_u64(&octalSignificandBig, octalSignificandWide); octalSignificandOverflow = 1; } else { objPtr->typePtr = &tclIntType; if (signum) { objPtr->internalRep.wideValue = - (Tcl_WideInt) octalSignificandWide; } else { objPtr->internalRep.wideValue = (Tcl_WideInt) octalSignificandWide; } } } if ((err == MP_OKAY) && octalSignificandOverflow) { if (signum) { err = mp_neg(&octalSignificandBig, &octalSignificandBig); } TclSetBignumIntRep(objPtr, &octalSignificandBig); } if (err != MP_OKAY) { return TCL_ERROR; } break; case ZERO: case DECIMAL: significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1, &significandWide, &significandBig, significandOverflow); if ((err == MP_OKAY) && !significandOverflow && (significandWide > MOST_BITS+signum)) { significandOverflow = 1; err = mp_init_u64(&significandBig, significandWide); } returnInteger: if (!significandOverflow) { if ((err == MP_OKAY) && (significandWide > MOST_BITS+signum)) { err = mp_init_u64(&significandBig, significandWide); significandOverflow = 1; } else { objPtr->typePtr = &tclIntType; if (signum) { objPtr->internalRep.wideValue = - (Tcl_WideInt) significandWide; } else { objPtr->internalRep.wideValue = (Tcl_WideInt) significandWide; } } } if ((err == MP_OKAY) && significandOverflow) { if (signum) { err = mp_neg(&significandBig, &significandBig); } TclSetBignumIntRep(objPtr, &significandBig); } if (err != MP_OKAY) { return TCL_ERROR; } break; case FRACTION: case EXPONENT: /* |
︙ | ︙ | |||
1401 1402 1403 1404 1405 1406 1407 | } objPtr->typePtr = &tclDoubleType; break; #ifdef IEEE_FLOATING_POINT case sNAN: case sNANFINISH: | | | 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 | } objPtr->typePtr = &tclDoubleType; break; #ifdef IEEE_FLOATING_POINT case sNAN: case sNANFINISH: objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide); objPtr->typePtr = &tclDoubleType; break; #endif case INITIAL: /* This case only to silence compiler warning. */ Tcl_Panic("TclParseNumber: state INITIAL can't happen here"); } |
︙ | ︙ | |||
1495 1496 1497 1498 1499 1500 1501 | } else if (numZeros >= maxpow10_wide || w > ((Tcl_WideUInt)-1-digit)/pow10_wide[numZeros+1]) { /* * Wide multiplication will overflow. Expand the number to a * bignum and fall through into the bignum case. */ | | > > | | | > > | | | | | > | | > > | 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 | } else if (numZeros >= maxpow10_wide || w > ((Tcl_WideUInt)-1-digit)/pow10_wide[numZeros+1]) { /* * Wide multiplication will overflow. Expand the number to a * bignum and fall through into the bignum case. */ if (mp_init_u64(bignumRepPtr, w) != MP_OKAY) { return 0; } } else { /* * Wide multiplication. */ *wideRepPtr = w * pow10_wide[numZeros+1] + digit; return 0; } } /* * Bignum multiplication. */ if (numZeros < log10_DIGIT_MAX) { /* * Up to about 8 zeros - single digit multiplication. */ if ((mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[numZeros+1], bignumRepPtr) != MP_OKAY) || (mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr) != MP_OKAY)) return 0; } else { mp_err err; /* * More than single digit multiplication. Multiply by the appropriate * small powers of 5, and then shift. Large strings of zeroes are * eaten 256 at a time; this is less efficient than it could be, but * seems implausible. We presume that MP_DIGIT_BIT is at least 27. The * first multiplication, by up to 10**7, is done with a one-DIGIT * multiply (this presumes that MP_DIGIT_BIT >= 24). */ n = numZeros + 1; err = mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[n&0x7], bignumRepPtr); for (i = 3; (err == MP_OKAY) && (i <= 7); ++i) { if (n & (1 << i)) { err = mp_mul(bignumRepPtr, pow5+i, bignumRepPtr); } } while ((err == MP_OKAY) && (n >= 256)) { err = mp_mul(bignumRepPtr, pow5+8, bignumRepPtr); n -= 256; } if ((err != MP_OKAY) || (mp_mul_2d(bignumRepPtr, (int)(numZeros+1)&~0x7, bignumRepPtr) != MP_OKAY) || (mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr) != MP_OKAY)) { return 0; } } return 1; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1641 1642 1643 1644 1645 1646 1647 | } /* * All the easy cases have failed. Promote ths significand to bignum and * call MakeHighPrecisionDouble to do it the hard way. */ | | > > | 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 | } /* * All the easy cases have failed. Promote ths significand to bignum and * call MakeHighPrecisionDouble to do it the hard way. */ if (mp_init_u64(&significandBig, significand) != MP_OKAY) { return 0.0; } retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs, exponent); mp_clear(&significandBig); /* * Come here to return the computed value. */ |
︙ | ︙ | |||
1690 1691 1692 1693 1694 1695 1696 | MakeHighPrecisionDouble( int signum, /* 1=negative, 0=nonnegative */ mp_int *significand, /* Exact significand of the number */ int numSigDigs, /* Number of significant digits */ long exponent) /* Power of 10 by which to multiply */ { double retval; | | | 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 | MakeHighPrecisionDouble( int signum, /* 1=negative, 0=nonnegative */ mp_int *significand, /* Exact significand of the number */ int numSigDigs, /* Number of significant digits */ long exponent) /* Power of 10 by which to multiply */ { double retval; int machexp = 0; /* Machine exponent of a power of 10. */ /* * With gcc on x86, the floating point rounding mode is double-extended. * This causes the result of double-precision calculations to be rounded * twice: once to the precision of double-extended and then again to the * precision of double. Double-rounding introduces gratuitous errors of 1 * ulp, so we need to change rounding mode to 53-bits. |
︙ | ︙ | |||
1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 | int rteExponent; /* Exponent of the round-to-even result */ int shift; /* Shift count for converting numerator * and denominator of corrector to floating * point */ Tcl_WideInt rteSigWide; /* Wide integer version of the significand * for testing evenness */ int i; /* * The first approximation is always low. If we find that it's HUGE_VAL, * we're done. */ if (approxResult == HUGE_VAL) { | > | 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 | int rteExponent; /* Exponent of the round-to-even result */ int shift; /* Shift count for converting numerator * and denominator of corrector to floating * point */ Tcl_WideInt rteSigWide; /* Wide integer version of the significand * for testing evenness */ int i; mp_err err = MP_OKAY; /* * The first approximation is always low. If we find that it's HUGE_VAL, * we're done. */ if (approxResult == HUGE_VAL) { |
︙ | ︙ | |||
1903 1904 1905 1906 1907 1908 1909 | * Compute twoMv as 2*M*v, where v is the approximate value. * This is done by bit-whacking to calculate 2**(M2+1)*significand, * and then multiplying by 5**M5. */ msb = binExponent + M2; /* 1008 */ nDigits = msb / MP_DIGIT_BIT + 1; | | > > | | > | > > > | | > | > > | > | | > > > > | | | > > > > > | 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 | * Compute twoMv as 2*M*v, where v is the approximate value. * This is done by bit-whacking to calculate 2**(M2+1)*significand, * and then multiplying by 5**M5. */ msb = binExponent + M2; /* 1008 */ nDigits = msb / MP_DIGIT_BIT + 1; if (mp_init_size(&twoMv, nDigits) != MP_OKAY) { return approxResult; } i = (msb % MP_DIGIT_BIT + 1); twoMv.used = nDigits; significand *= SafeLdExp(1.0, i); while (--nDigits >= 0) { twoMv.dp[nDigits] = (mp_digit) significand; significand -= (mp_digit) significand; significand = SafeLdExp(significand, MP_DIGIT_BIT); } for (i = 0; i <= 8; ++i) { if (M5 & (1 << i) && (mp_mul(&twoMv, pow5+i, &twoMv) != MP_OKAY)) { mp_clear(&twoMv); return approxResult; } } /* * Compute twoMd as 2*M*d, where d is the exact value. * This is done by multiplying by 5**(M5+exponent) and then multiplying * by 2**(M5+exponent+1), which is, of couse, a left shift. */ if (mp_init_copy(&twoMd, exactSignificand) != MP_OKAY) { mp_clear(&twoMv); return approxResult; } for (i = 0; (i <= 8); ++i) { if ((M5 + exponent) & (1 << i)) { err = mp_mul(&twoMd, pow5+i, &twoMd); } } if (err == MP_OKAY) { err = mp_mul_2d(&twoMd, M2+exponent+1, &twoMd); } /* * Now let twoMd = twoMd - twoMv, the difference between the exact and * approximate values. */ if (err == MP_OKAY) { err = mp_sub(&twoMd, &twoMv, &twoMd); } /* * The result, 2Mv-2Md, needs to be divided by 2M to yield a correction * term. Because 2M may well overflow a double, we need to scale the * denominator by a factor of 2**binExponent-mantBits. Place that factor * times 1/2 ULP into twoMd. */ scale = binExponent - mantBits - 1; mp_set_u64(&twoMv, 1); for (i = 0; (i <= 8) && (err == MP_OKAY); ++i) { if (M5 & (1 << i)) { err = mp_mul(&twoMv, pow5+i, &twoMv); } } multiplier = M2 + scale + 1; if (err != MP_OKAY) { mp_clear(&twoMd); mp_clear(&twoMv); return approxResult; } else if (multiplier > 0) { err = mp_mul_2d(&twoMv, multiplier, &twoMv); } else if (multiplier < 0) { err = mp_div_2d(&twoMv, -multiplier, &twoMv, NULL); } if (err != MP_OKAY) { mp_clear(&twoMd); mp_clear(&twoMv); return approxResult; } /* * Will the eventual correction term be less than, equal to, or * greater than 1/2 ULP? */ |
︙ | ︙ | |||
2006 2007 2008 2009 2010 2011 2012 | /* * Reduce the numerator and denominator of the corrector term so that * they will fit in the floating point precision. */ shift = mp_count_bits(&twoMv) - FP_PRECISION - 1; if (shift > 0) { | | > | > > > > > > | 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 | /* * Reduce the numerator and denominator of the corrector term so that * they will fit in the floating point precision. */ shift = mp_count_bits(&twoMv) - FP_PRECISION - 1; if (shift > 0) { err = mp_div_2d(&twoMv, shift, &twoMv, NULL); if (err == MP_OKAY) { err = mp_div_2d(&twoMd, shift, &twoMd, NULL); } } if (err != MP_OKAY) { mp_clear(&twoMd); mp_clear(&twoMv); return approxResult; } /* * Convert the numerator and denominator of the corrector term accurately * to floating point numbers. */ |
︙ | ︙ | |||
2046 2047 2048 2049 2050 2051 2052 | * * Side effects: * Stores base*5**n in result. * *---------------------------------------------------------------------- */ | | > | | | | | > | 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 2144 2145 2146 | * * Side effects: * Stores base*5**n in result. * *---------------------------------------------------------------------- */ static inline mp_err MulPow5( mp_int *base, /* Number to multiply. */ unsigned n, /* Power of 5 to multiply by. */ mp_int *result) /* Place to store the result. */ { mp_int *p = base; int n13 = n / 13; int r = n % 13; mp_err err = MP_OKAY; if (r != 0) { err = mp_mul_d(p, dpow5[r], result); p = result; } r = 0; while ((err == MP_OKAY) && (n13 != 0)) { if (n13 & 1) { err = mp_mul(p, pow5_13+r, result); p = result; } n13 >>= 1; ++r; } if ((err == MP_OKAY) && (p != result)) { err = mp_copy(p, result); } return err; } /* *---------------------------------------------------------------------- * * NormalizeRightward -- * |
︙ | ︙ | |||
3272 3273 3274 3275 3276 3277 3278 | /* * Compare B and S-m - which is the same as comparing B+m and S - which we * do by computing b+m and doing a bitwhack compare against * 2**(MP_DIGIT_BIT*sd) */ | < | | 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 | /* * Compare B and S-m - which is the same as comparing B+m and S - which we * do by computing b+m and doing a bitwhack compare against * 2**(MP_DIGIT_BIT*sd) */ if ((mp_add(b, m, temp) != MP_OKAY) || (temp->used <= sd)) { /* Too few digits to be > s */ return 0; } if (temp->used > sd+1 || temp->dp[sd] > 1) { /* >= 2s */ return 1; } for (i = sd-1; i >= 0; --i) { |
︙ | ︙ | |||
3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 | * converted. */ mp_int mplus, mminus; /* Bounds for roundoff. */ mp_digit digit; /* Current output digit. */ char *s = retval; /* Cursor in the output buffer. */ int i; /* Index in the output buffer. */ mp_int temp; int r1; /* * b = bw * 2**b2 * 5**b5 * mminus = 5**m5 */ | > | > > | > > > | > | > | | > | > > | > | | > | | > > | > | 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 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 | * converted. */ mp_int mplus, mminus; /* Bounds for roundoff. */ mp_digit digit; /* Current output digit. */ char *s = retval; /* Cursor in the output buffer. */ int i; /* Index in the output buffer. */ mp_int temp; int r1; mp_err err = MP_OKAY; /* * b = bw * 2**b2 * 5**b5 * mminus = 5**m5 */ if ((retval == NULL) || (mp_init_u64(&b, bw) != MP_OKAY)) { return NULL; } if (mp_init_set(&mminus, 1) != MP_OKAY) { mp_clear(&b); return NULL; } err = MulPow5(&b, b5, &b); if (err == MP_OKAY) { err = mp_mul_2d(&b, b2, &b); } /* * Adjust if the logarithm was guessed wrong. */ if ((err == MP_OKAY) && (b.used <= sd)) { err = mp_mul_d(&b, 10, &b); ++m2plus; ++m2minus; ++m5; ilim = ilim1; --k; } /* * mminus = 5**m5 * 2**m2minus * mplus = 5**m5 * 2**m2plus */ if (err == MP_OKAY) { err = mp_mul_2d(&mminus, m2minus, &mminus); } if (err == MP_OKAY) { err = MulPow5(&mminus, m5, &mminus); } if ((err == MP_OKAY) && (m2plus > m2minus)) { err = mp_init_copy(&mplus, &mminus); if (err == MP_OKAY) { err = mp_mul_2d(&mplus, m2plus-m2minus, &mplus); } } if (err == MP_OKAY) { err = mp_init(&temp); } /* * Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT) * by mp_digit extraction. */ i = 0; |
︙ | ︙ | |||
3456 3457 3458 3459 3460 3461 3462 | break; } /* * Advance to the next digit. */ | > | > > | > | | | | 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 | break; } /* * Advance to the next digit. */ if (err == MP_OKAY) { err = mp_mul_d(&b, 10, &b); } if (err == MP_OKAY) { err = mp_mul_d(&mminus, 10, &mminus); } if ((err == MP_OKAY) && (m2plus > m2minus)) { err = mp_mul_2d(&mminus, m2plus-m2minus, &mplus); } ++i; } /* * Endgame - store the location of the decimal point and the end of the * string. */ if (m2plus > m2minus) { mp_clear(&mplus); } mp_clear_multi(&b, &mminus, &temp, NULL); *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } return (err == MP_OKAY) ? retval : NULL; } /* *---------------------------------------------------------------------- * * StrictBignumConversionPowD -- * |
︙ | ︙ | |||
3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 | char *retval = (char *)ckalloc(len + 1); /* Output buffer. */ mp_int b; /* Numerator of the fraction being * converted. */ mp_digit digit; /* Current output digit. */ char *s = retval; /* Cursor in the output buffer. */ int i; /* Index in the output buffer. */ (void)dPtr; /* * b = bw * 2**b2 * 5**b5 */ | > | > > | > | > | | | | 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 | char *retval = (char *)ckalloc(len + 1); /* Output buffer. */ mp_int b; /* Numerator of the fraction being * converted. */ mp_digit digit; /* Current output digit. */ char *s = retval; /* Cursor in the output buffer. */ int i; /* Index in the output buffer. */ mp_err err; (void)dPtr; /* * b = bw * 2**b2 * 5**b5 */ if (mp_init_u64(&b, bw) != MP_OKAY) { return NULL; } err = MulPow5(&b, b5, &b); if (err == MP_OKAY) { err = mp_mul_2d(&b, b2, &b); } /* * Adjust if the logarithm was guessed wrong. */ if ((err == MP_OKAY) && (b.used <= sd)) { err = mp_mul_d(&b, 10, &b); ilim = ilim1; --k; } /* * Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT) * by mp_digit extraction. */ i = 1; while (err == MP_OKAY) { if (b.used <= sd) { digit = 0; } else { digit = b.dp[sd]; if (b.used > sd+1 || digit >= 10) { Tcl_Panic("wrong digit!"); } |
︙ | ︙ | |||
3584 3585 3586 3587 3588 3589 3590 | break; } /* * Advance to the next digit. */ | | | 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 | break; } /* * Advance to the next digit. */ err = mp_mul_d(&b, 10, &b); ++i; } /* * Endgame - store the location of the decimal point and the end of the * string. */ |
︙ | ︙ | |||
3666 3667 3668 3669 3670 3671 3672 | int r; mp_int temp; /* * Compare b and S-m: this is the same as comparing B+m and S. */ | | | > | 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 | int r; mp_int temp; /* * Compare b and S-m: this is the same as comparing B+m and S. */ if ((mp_init(&temp) != MP_OKAY) || (mp_add(b, m, &temp) != MP_OKAY)) { return 0; } r = mp_cmp_mag(&temp, S); mp_clear(&temp); switch(r) { case MP_LT: return 0; case MP_EQ: return isodd; |
︙ | ︙ | |||
3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 | mp_int mplus; /* 1/2 ulp above the result. */ mp_int S; /* Denominator of the result. */ mp_int dig; /* Current digit of the result. */ int digit; /* Current digit of the result. */ int minit = 1; /* Fudge factor for when we misguess k. */ int i; int r1; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 */ | > | > > | > | > > > > > | > | | > | > > | > | | > | > > | > | | | | 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 | mp_int mplus; /* 1/2 ulp above the result. */ mp_int S; /* Denominator of the result. */ mp_int dig; /* Current digit of the result. */ int digit; /* Current digit of the result. */ int minit = 1; /* Fudge factor for when we misguess k. */ int i; int r1; mp_err err; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 */ if ((retval == NULL) || (mp_init_u64(&b, bw) != MP_OKAY)) { return NULL; } err = mp_mul_2d(&b, b2, &b); if (err == MP_OKAY) { err = mp_init_set(&S, 1); } if (err == MP_OKAY) { err = MulPow5(&S, s5, &S); } if (err == MP_OKAY) { err = mp_mul_2d(&S, s2, &S); } /* * Handle the case where we guess the position of the decimal point wrong. */ if ((err == MP_OKAY) && (mp_cmp_mag(&b, &S) == MP_LT)) { err = mp_mul_d(&b, 10, &b); minit = 10; ilim =ilim1; --k; } /* * mminus = 2**m2minus * 5**m5 */ if (err == MP_OKAY) { err = mp_init_set(&mminus, minit); } if (err == MP_OKAY) { err = mp_mul_2d(&mminus, m2minus, &mminus); } if ((err == MP_OKAY) && (m2plus > m2minus)) { err = mp_init_copy(&mplus, &mminus); if (err == MP_OKAY) { err = mp_mul_2d(&mplus, m2plus-m2minus, &mplus); } } /* * Loop through the digits. */ if (err == MP_OKAY) { err = mp_init(&dig); } i = 1; while (err == MP_OKAY) { err = mp_div(&b, &S, &dig, &b); if (dig.used > 1 || dig.dp[0] >= 10) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; /* * Does the current digit leave us with a remainder small enough to * round to it? */ r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus); if (r1 == MP_LT || (r1 == MP_EQ && (dPtr->w.word1 & 1) == 0)) { err = mp_mul_2d(&b, 1, &b); if (ShouldBankerRoundUp(&b, &S, digit&1)) { ++digit; if (digit == 10) { *s++ = '9'; s = BumpUp(s, retval, &k); break; } |
︙ | ︙ | |||
3814 3815 3816 3817 3818 3819 3820 | } /* * Have we converted all the requested digits? */ *s++ = '0' + digit; | | | | | > | > | | > | > | 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 | } /* * Have we converted all the requested digits? */ *s++ = '0' + digit; if ((err == MP_OKAY) && (i == ilim)) { err = mp_mul_2d(&b, 1, &b); if (ShouldBankerRoundUp(&b, &S, digit&1)) { s = BumpUp(s, retval, &k); } break; } /* * Advance to the next digit. */ if ((err == MP_OKAY) && (s5 > 0)) { /* * Can possibly shorten the denominator. */ err = mp_mul_2d(&b, 1, &b); if (err == MP_OKAY) { err = mp_mul_2d(&mminus, 1, &mminus); } if ((err == MP_OKAY) && (m2plus > m2minus)) { err = mp_mul_2d(&mplus, 1, &mplus); } if (err == MP_OKAY) { err = mp_div_d(&S, 5, &S, NULL); } --s5; /* * IDEA: It might possibly be a win to fall back to int64_t * arithmetic here if S < 2**64/10. But it's a win only for * a fairly narrow range of magnitudes so perhaps not worth * bothering. We already know that we shorten the |
︙ | ︙ | |||
3866 3867 3868 3869 3870 3871 3872 | * 10**38 12 trips * 10**39 13 trips * 10**40 14 trips * 10**41 15 trips * 10**42 16 trips * thereafter no gain. */ | | | > | > | | | 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 | * 10**38 12 trips * 10**39 13 trips * 10**40 14 trips * 10**41 15 trips * 10**42 16 trips * thereafter no gain. */ } else if (err == MP_OKAY) { err = mp_mul_d(&b, 10, &b); if (err == MP_OKAY) { err = mp_mul_d(&mminus, 10, &mminus); } if ((err == MP_OKAY) && (m2plus > m2minus)) { err = mp_mul_2d(&mplus, 10, &mplus); } } ++i; } /* |
︙ | ︙ | |||
3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 | char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ mp_int S; /* Denominator of the result. */ mp_int dig; /* Current digit of the result. */ int digit; /* Current digit of the result. */ int g; /* Size of the current digit ground. */ int i, j; (void)dPtr; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 */ | > > | > | > > > | > | > > > > | > > | < | < | | | | > | > | > | > | | < | | 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 | char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ mp_int S; /* Denominator of the result. */ mp_int dig; /* Current digit of the result. */ int digit; /* Current digit of the result. */ int g; /* Size of the current digit ground. */ int i, j; mp_err err; (void)dPtr; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 */ if (mp_init(&dig) != MP_OKAY) { return NULL; } if (mp_init_u64(&b, bw) != MP_OKAY) { mp_clear(&dig); return NULL; } err = mp_mul_2d(&b, b2, &b); if (err == MP_OKAY) { err = mp_init_set(&S, 1); } if (err == MP_OKAY) { err = MulPow5(&S, s5, &S); if (err == MP_OKAY) { err = mp_mul_2d(&S, s2, &S); } } /* * Handle the case where we guess the position of the decimal point wrong. */ if ((mp_cmp_mag(&b, &S) == MP_LT) && (mp_mul_d(&b, 10, &b) == MP_OKAY)) { ilim =ilim1; --k; } /* * Convert the leading digit. */ i = 0; err = mp_div(&b, &S, &dig, &b); if (dig.used > 1 || dig.dp[0] >= 10) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; /* * Is a single digit all that was requested? */ *s++ = '0' + digit; if (++i >= ilim) { if ((mp_mul_2d(&b, 1, &b) == MP_OKAY) && ShouldBankerRoundUp(&b, &S, digit&1)) { s = BumpUp(s, retval, &k); } } else { while (err == MP_OKAY) { /* * Shift by a group of digits. */ g = ilim - i; if (g > DIGIT_GROUP) { g = DIGIT_GROUP; } if (s5 >= g) { err = mp_div_d(&S, dpow5[g], &S, NULL); s5 -= g; } else if (s5 > 0) { err = mp_div_d(&S, dpow5[s5], &S, NULL); if (err == MP_OKAY) { err = mp_mul_d(&b, dpow5[g - s5], &b); } s5 = 0; } else { err = mp_mul_d(&b, dpow5[g], &b); } if (err == MP_OKAY) { err = mp_mul_2d(&b, g, &b); } /* * As with the shortening bignum conversion, it's possible at this * point that we will have reduced the denominator to less than * 2**64/10, at which point it would be possible to fall back to * to int64_t arithmetic. But the potential payoff is tremendously * less - unless we're working in F format - because we know that * three groups of digits will always suffice for %#.17e, the * longest format that doesn't introduce empty precision. * * Extract the next group of digits. */ if ((err != MP_OKAY) || (mp_div(&b, &S, &dig, &b) != MP_OKAY) || (dig.used > 1)) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; for (j = g-1; j >= 0; --j) { int t = itens[j]; *s++ = digit / t + '0'; digit %= t; } i += g; /* * Have we converted all the requested digits? */ if (i == ilim) { if ((mp_mul_2d(&b, 1, &b) == MP_OKAY) && ShouldBankerRoundUp(&b, &S, digit&1)) { s = BumpUp(s, retval, &k); } break; } } } while (*--s == '0') { |
︙ | ︙ | |||
4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 | double d; #ifdef IEEE_FLOATING_POINT union { double dv; Tcl_WideUInt iv; } bitwhack; #endif #if defined(__sgi) && defined(_COMPILER_VERSION) union fpc_csr mipsCR; mipsCR.fc_word = get_fpc_csr(); mipsCR.fc_struct.flush = 0; set_fpc_csr(mipsCR.fc_word); #endif /* * Initialize table of powers of 10 expressed as wide integers. */ maxpow10_wide = (int) floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.)); | > | > | 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 | double d; #ifdef IEEE_FLOATING_POINT union { double dv; Tcl_WideUInt iv; } bitwhack; #endif mp_err err = MP_OKAY; #if defined(__sgi) && defined(_COMPILER_VERSION) union fpc_csr mipsCR; mipsCR.fc_word = get_fpc_csr(); mipsCR.fc_struct.flush = 0; set_fpc_csr(mipsCR.fc_word); #endif /* * Initialize table of powers of 10 expressed as wide integers. */ maxpow10_wide = (int) floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.)); pow10_wide = (Tcl_WideUInt *) ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt)); u = 1; for (i = 0; i < maxpow10_wide; ++i) { pow10_wide[i] = u; u *= 10; } pow10_wide[i] = u; |
︙ | ︙ | |||
4461 4462 4463 4464 4465 4466 4467 | } /* * Initialize a table of large powers of five. */ for (i=0; i<9; ++i) { | | | | | | > > > | 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 | } /* * Initialize a table of large powers of five. */ for (i=0; i<9; ++i) { err = err || mp_init(pow5 + i); } mp_set_u64(pow5, 5); for (i=0; i<8; ++i) { err = err || mp_sqr(pow5+i, pow5+i+1); } err = err || mp_init_u64(pow5_13, 1220703125); for (i = 1; i < 5; ++i) { err = err || mp_init(pow5_13 + i); err = err || mp_sqr(pow5_13 + i - 1, pow5_13 + i); } if (err != MP_OKAY) { Tcl_Panic("out of memory"); } /* * Determine the number of decimal digits to the left and right of the * decimal point in the largest and smallest double, the smallest double * that differs from zero, and the number of mp_digits needed to represent * the significand of a double. |
︙ | ︙ | |||
4558 4559 4560 4561 4562 4563 4564 | *---------------------------------------------------------------------- */ int Tcl_InitBignumFromDouble( Tcl_Interp *interp, /* For error message. */ double d, /* Number to convert. */ | | > > | | > > | | | > > > | 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 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 | *---------------------------------------------------------------------- */ int Tcl_InitBignumFromDouble( Tcl_Interp *interp, /* For error message. */ double d, /* Number to convert. */ void *big) /* Place to store the result. */ { double fract; int expt; mp_err err; mp_int *b = (mp_int *)big; /* * Infinite values can't convert to bignum. */ if (TclIsInfinite(d)) { if (interp != NULL) { const char *s = "integer value too large to represent"; Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL); } return TCL_ERROR; } fract = frexp(d, &expt); if (expt <= 0) { err = mp_init(b); mp_zero(b); } else { Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits); int shift = expt - mantBits; err = mp_init_i64(b, w); if (err != MP_OKAY) { /* just skip */ } else if (shift < 0) { err = mp_div_2d(b, -shift, b, NULL); } else if (shift > 0) { err = mp_mul_2d(b, shift, b); } } if (err != MP_OKAY) { return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
4612 4613 4614 4615 4616 4617 4618 | * too large to convert. * *---------------------------------------------------------------------- */ double TclBignumToDouble( | | > > | 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 | * too large to convert. * *---------------------------------------------------------------------- */ double TclBignumToDouble( const void *big) /* Integer to convert. */ { mp_int b; int bits, shift, i, lsb; double r; mp_err err; const mp_int *a = (const mp_int *)big; /* * We need a 'mantBits'-bit significand. Determine what shift will * give us that. */ |
︙ | ︙ | |||
4645 4646 4647 4648 4649 4650 4651 | * in length. If shift < 0, we will need to shift the significand right * by the requisite number of bits, and round it. If the '1-shift' * least significant bits are 0, but the 'shift'th bit is nonzero, * then the significand lies exactly between two values and must be * 'rounded to even'. */ | | > > | | | | | | | | > > | | | | > > > | | 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 | * in length. If shift < 0, we will need to shift the significand right * by the requisite number of bits, and round it. If the '1-shift' * least significant bits are 0, but the 'shift'th bit is nonzero, * then the significand lies exactly between two values and must be * 'rounded to even'. */ err = mp_init(&b); if (err != MP_OKAY) { /* just skip */ } else if (shift == 0) { err = mp_copy(a, &b); } else if (shift > 0) { err = mp_mul_2d(a, shift, &b); } else if (shift < 0) { lsb = mp_cnt_lsb(a); if (lsb == -1-shift) { /* * Round to even */ err = mp_div_2d(a, -shift, &b, NULL); if ((err == MP_OKAY) && mp_isodd(&b)) { if (mp_isneg(&b)) { err = mp_sub_d(&b, 1, &b); } else { err = mp_add_d(&b, 1, &b); } } } else { /* * Ordinary rounding */ err = mp_div_2d(a, -1-shift, &b, NULL); if (err != MP_OKAY) { /* just skip */ } else if (mp_isneg(&b)) { err = mp_sub_d(&b, 1, &b); } else { err = mp_add_d(&b, 1, &b); } err = mp_div_2d(&b, 1, &b, NULL); } } /* * Accumulate the result, one mp_digit at a time. */ if (err != MP_OKAY) { return 0.0; } r = 0.0; for (i = b.used-1; i>=0; --i) { r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } mp_clear(&b); /* * Scale the result to the correct number of bits. */ |
︙ | ︙ | |||
4725 4726 4727 4728 4729 4730 4731 | * Returns the floating point number. * *---------------------------------------------------------------------- */ double TclCeil( | | > > | | | > > | | | > | > | | | | > > > | 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 | * Returns the floating point number. * *---------------------------------------------------------------------- */ double TclCeil( const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; mp_err err; const mp_int *a = (const mp_int *)big; err = mp_init(&b); if ((err == MP_OKAY) && mp_isneg(a)) { err = mp_neg(a, &b); r = -TclFloor(&b); } else { int bits = mp_count_bits(a); if (bits > DBL_MAX_EXP*log2FLT_RADIX) { r = HUGE_VAL; } else { int i, exact = 1, shift = mantBits - bits; if (err != MP_OKAY) { /* just skip */ } else if (shift > 0) { err = mp_mul_2d(a, shift, &b); } else if (shift < 0) { mp_int d; err = mp_init(&d); if (err == MP_OKAY) { err = mp_div_2d(a, -shift, &b, &d); } exact = mp_iszero(&d); mp_clear(&d); } else { err = mp_copy(a, &b); } if ((err == MP_OKAY) && !exact) { err = mp_add_d(&b, 1, &b); } if (err != MP_OKAY) { return 0.0; } for (i=b.used-1 ; i>=0 ; --i) { r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } r = ldexp(r, bits - mantBits); } } |
︙ | ︙ | |||
4782 4783 4784 4785 4786 4787 4788 | * Returns the floating point value. * *---------------------------------------------------------------------- */ double TclFloor( | | > > | | | | | | > > > | 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 | * Returns the floating point value. * *---------------------------------------------------------------------- */ double TclFloor( const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; mp_err err; const mp_int *a = (const mp_int *)big; err = mp_init(&b); if ((err == MP_OKAY) && mp_isneg(a)) { err = mp_neg(a, &b); r = -TclCeil(&b); } else { int bits = mp_count_bits(a); if (bits > DBL_MAX_EXP*log2FLT_RADIX) { r = DBL_MAX; } else { int i, shift = mantBits - bits; if (shift > 0) { err = mp_mul_2d(a, shift, &b); } else if (shift < 0) { err = mp_div_2d(a, -shift, &b, NULL); } else { err = mp_copy(a, &b); } if (err != MP_OKAY) { return 0.0; } for (i=b.used-1 ; i>=0 ; --i) { r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } r = ldexp(r, bits - mantBits); } } |
︙ | ︙ | |||
4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 | int *machexp) /* Power of two. */ { mp_int b; int bits; int shift; int i; double r; /* * Determine how many bits we need, and extract that many from the input. * Round to nearest unit in the last place. */ bits = mp_count_bits(a); shift = mantBits - 2 - bits; | > | > > | | | > | | > | 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 5039 5040 5041 5042 5043 5044 5045 5046 5047 | int *machexp) /* Power of two. */ { mp_int b; int bits; int shift; int i; double r; mp_err err = MP_OKAY; /* * Determine how many bits we need, and extract that many from the input. * Round to nearest unit in the last place. */ bits = mp_count_bits(a); shift = mantBits - 2 - bits; if (mp_init(&b)) { return 0.0; } if (shift > 0) { err = mp_mul_2d(a, shift, &b); } else if (shift < 0) { err = mp_div_2d(a, -shift, &b, NULL); } else { err = mp_copy(a, &b); } /* * Accumulate the result, one mp_digit at a time. */ r = 0.0; if (err == MP_OKAY) { for (i=b.used-1; i>=0; --i) { r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } } mp_clear(&b); /* * Return the result with the appropriate sign. */ |
︙ | ︙ |
Changes to generic/tclStringObj.c.
︙ | ︙ | |||
567 568 569 570 571 572 573 | stringPtr = GET_STRING(objPtr); } if (index >= stringPtr->numChars) { return -1; } ch = stringPtr->unicode[index]; | | | 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 | stringPtr = GET_STRING(objPtr); } if (index >= stringPtr->numChars) { return -1; } ch = stringPtr->unicode[index]; #if TCL_UTF_MAX <= 3 /* See: bug [11ae2be95dac9417] */ if ((ch & 0xF800) == 0xD800) { if (ch & 0x400) { if ((index > 0) && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) { ch = -1; /* low surrogate preceded by high surrogate */ } |
︙ | ︙ | |||
751 752 753 754 755 756 757 | } if (last > stringPtr->numChars) { last = stringPtr->numChars; } if (last < first) { return Tcl_NewObj(); } | | | 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 | } if (last > stringPtr->numChars) { last = stringPtr->numChars; } if (last < first) { return Tcl_NewObj(); } #if TCL_UTF_MAX <= 3 /* See: bug [11ae2be95dac9417] */ if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { ++first; } if ((last + 1 < stringPtr->numChars) && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00) |
︙ | ︙ | |||
2269 2270 2271 2272 2273 2274 2275 | bits = uw; while (uw) { numDigits++; uw /= base; } #endif | | | 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 | bits = uw; while (uw) { numDigits++; uw /= base; } #endif } else if (useBig && !mp_iszero(&big)) { int leftover = (big.used * MP_DIGIT_BIT) % numBits; mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover); numDigits = 1 + (((Tcl_WideInt) big.used * MP_DIGIT_BIT) / numBits); while ((mask & big.dp[big.used-1]) == 0) { numDigits--; |
︙ | ︙ | |||
2308 2309 2310 2311 2312 2313 2314 | pure = Tcl_NewObj(); Tcl_SetObjLength(pure, (int) numDigits); bytes = TclGetString(pure); toAppend = length = (int) numDigits; while (numDigits--) { int digitOffset; | | | 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 | pure = Tcl_NewObj(); Tcl_SetObjLength(pure, (int) numDigits); bytes = TclGetString(pure); toAppend = length = (int) numDigits; while (numDigits--) { int digitOffset; if (useBig && !mp_iszero(&big)) { if (index < big.used && (size_t) shift < CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) { bits |= ((Tcl_WideUInt) big.dp[index++]) << shift; shift += MP_DIGIT_BIT; } shift -= numBits; } |
︙ | ︙ | |||
2612 2613 2614 2615 2616 2617 2618 | */ q = Tcl_UtfPrev(end, bytes); if (!Tcl_UtfCharComplete(q, (int)(end - q))) { end = q; } | | | 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 | */ q = Tcl_UtfPrev(end, bytes); if (!Tcl_UtfCharComplete(q, (int)(end - q))) { end = q; } q = bytes + 4; while ((bytes < end) && (bytes < q) && ((*bytes & 0xC0) == 0x80)) { bytes++; } Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj(bytes , (int)(end - bytes))); |
︙ | ︙ |
Changes to generic/tclStubInit.c.
︙ | ︙ | |||
36 37 38 39 40 41 42 43 44 45 46 47 48 49 | #undef Tcl_NewIntObj #undef Tcl_NewListObj #undef Tcl_NewLongObj #undef Tcl_DbNewLongObj #undef Tcl_NewObj #undef Tcl_NewStringObj #undef Tcl_GetUnicode #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory #undef Tcl_FindHashEntry #undef Tcl_CreateHashEntry #undef Tcl_Panic #undef Tcl_FindExecutable #undef Tcl_SetExitProc | > > > > > > > > | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | #undef Tcl_NewIntObj #undef Tcl_NewListObj #undef Tcl_NewLongObj #undef Tcl_DbNewLongObj #undef Tcl_NewObj #undef Tcl_NewStringObj #undef Tcl_GetUnicode #undef Tcl_GetUnicodeFromObj #undef Tcl_AppendUnicodeToObj #undef Tcl_NewUnicodeObj #undef Tcl_SetUnicodeObj #undef Tcl_UniCharNcasecmp #undef Tcl_UniCharCaseMatch #undef Tcl_UniCharLen #undef Tcl_UniCharNcmp #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory #undef Tcl_FindHashEntry #undef Tcl_CreateHashEntry #undef Tcl_Panic #undef Tcl_FindExecutable #undef Tcl_SetExitProc |
︙ | ︙ | |||
59 60 61 62 63 64 65 66 67 68 69 70 71 72 | #undef TclWinNToHS #undef TclStaticPackage #undef Tcl_BackgroundError #define TclStaticPackage Tcl_StaticPackage #undef Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar #define TclBN_mp_add mp_add #define TclBN_mp_and mp_and #define TclBN_mp_clamp mp_clamp #define TclBN_mp_clear mp_clear #define TclBN_mp_clear_multi mp_clear_multi #define TclBN_mp_cmp mp_cmp | > > > > > > > > > > > > > > > | 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 | #undef TclWinNToHS #undef TclStaticPackage #undef Tcl_BackgroundError #define TclStaticPackage Tcl_StaticPackage #undef Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar #if TCL_UTF_MAX > 3 static void uniCodePanic() { Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX); } # define Tcl_GetUnicode (int *(*)(Tcl_Obj *)) uniCodePanic # define Tcl_GetUnicodeFromObj (int *(*)(Tcl_Obj *, Tcl_UniChar *)) uniCodePanic # define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const int *, Tcl_UniChar)) uniCodePanic # define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int)) uniCodePanic # define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int)) uniCodePanic # define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long)) uniCodePanic # define Tcl_UniCharCaseMatch (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, int)) uniCodePanic # define Tcl_UniCharLen (int(*)(const Tcl_UniChar *)) uniCodePanic # define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long)) uniCodePanic #endif #define TclBN_mp_add mp_add #define TclBN_mp_and mp_and #define TclBN_mp_clamp mp_clamp #define TclBN_mp_clear mp_clear #define TclBN_mp_clear_multi mp_clear_multi #define TclBN_mp_cmp mp_cmp |
︙ | ︙ | |||
122 123 124 125 126 127 128 | #define TclBN_s_mp_mul_digs_fast s_mp_mul_digs_fast #define TclBN_s_mp_reverse s_mp_reverse #define TclBN_s_mp_sqr s_mp_sqr #define TclBN_s_mp_sqr_fast s_mp_sqr_fast #define TclBN_s_mp_sub s_mp_sub #define TclBN_mp_toom_mul s_mp_toom_mul #define TclBN_mp_toom_sqr s_mp_toom_sqr | | | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 | #define TclBN_s_mp_mul_digs_fast s_mp_mul_digs_fast #define TclBN_s_mp_reverse s_mp_reverse #define TclBN_s_mp_sqr s_mp_sqr #define TclBN_s_mp_sqr_fast s_mp_sqr_fast #define TclBN_s_mp_sub s_mp_sub #define TclBN_mp_toom_mul s_mp_toom_mul #define TclBN_mp_toom_sqr s_mp_toom_sqr #define TclUnusedStubEntry NULL /* See bug 510001: TclSockMinimumBuffers needs plat imp */ #if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 # define TclSockMinimumBuffersOld 0 #else #define TclSockMinimumBuffersOld sockMinimumBuffersOld static int TclSockMinimumBuffersOld(int sock, int size) |
︙ | ︙ | |||
147 148 149 150 151 152 153 | static mp_err TclBN_mp_set_long(mp_int *a, unsigned long i) { TclBN_mp_set_u64(a, i); return MP_OKAY; } | | | 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | static mp_err TclBN_mp_set_long(mp_int *a, unsigned long i) { TclBN_mp_set_u64(a, i); return MP_OKAY; } #define TclBN_mp_set_ul (void (*)(mp_int *a, unsigned long i))(void *)TclBN_mp_set_long mp_err MP_WUR TclBN_mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) { return mp_expt_u32(a, b, c); } mp_err TclBN_mp_add_d(const mp_int *a, unsigned int b, mp_int *c) { return mp_add_d(a, b, c); } |
︙ | ︙ | |||
228 229 230 231 232 233 234 235 236 237 238 239 240 241 | # define Tcl_ListMathFuncs 0 # define Tcl_SetIntObj 0 # define Tcl_SetLongObj 0 # define Tcl_NewIntObj 0 # define Tcl_NewLongObj 0 # define Tcl_DbNewLongObj 0 # define Tcl_BackgroundError 0 #else mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) { mp_digit d2; mp_err result = mp_div_d(a, 3, c, &d2); if (d) { *d = d2; | > | 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 | # define Tcl_ListMathFuncs 0 # define Tcl_SetIntObj 0 # define Tcl_SetLongObj 0 # define Tcl_NewIntObj 0 # define Tcl_NewLongObj 0 # define Tcl_DbNewLongObj 0 # define Tcl_BackgroundError 0 # define Tcl_FreeResult 0 #else mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) { mp_digit d2; mp_err result = mp_div_d(a, 3, c, &d2); if (d) { *d = d2; |
︙ | ︙ | |||
477 478 479 480 481 482 483 484 485 486 | "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 uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n); } | > | < < < < < < < < > > > > > > > > > | 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 | "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 #if TCL_UTF_MAX < 4 && !defined(TCL_NO_DEPRECATED) static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n); } #define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))(void *)uniCharNcmp static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n); } #define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp #endif static int utfNcmp(const char *s1, const char *s2, unsigned int n){ return Tcl_UtfNcmp(s1, s2, (unsigned long)n); } #define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcmp static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n); } #define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcasecmp #endif /* TCL_WIDE_INT_IS_LONG */ #endif /* __CYGWIN__ */ #if defined(TCL_NO_DEPRECATED) # define Tcl_SeekOld 0 |
︙ | ︙ | |||
588 589 590 591 592 593 594 595 596 597 598 599 600 601 | # define TclpGmtime 0 # define TclpLocaltime_unix 0 # define TclpGmtime_unix 0 # define Tcl_SetExitProc 0 # define Tcl_SetPanicProc 0 # define Tcl_FindExecutable 0 # define Tcl_GetUnicode 0 # undef Tcl_StringMatch # define Tcl_StringMatch 0 # define TclBN_reverse 0 # undef TclBN_s_mp_mul_digs_fast # define TclBN_s_mp_mul_digs_fast 0 # undef TclBN_s_mp_sqr_fast # define TclBN_s_mp_sqr_fast 0 | > > > > > > > | 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 | # define TclpGmtime 0 # define TclpLocaltime_unix 0 # define TclpGmtime_unix 0 # define Tcl_SetExitProc 0 # define Tcl_SetPanicProc 0 # define Tcl_FindExecutable 0 # define Tcl_GetUnicode 0 #if TCL_UTF_MAX < 4 # define Tcl_AppendUnicodeToObj 0 # define Tcl_UniCharCaseMatch 0 # define Tcl_UniCharLen 0 # define Tcl_UniCharNcasecmp 0 # define Tcl_UniCharNcmp 0 #endif # undef Tcl_StringMatch # define Tcl_StringMatch 0 # define TclBN_reverse 0 # undef TclBN_s_mp_mul_digs_fast # define TclBN_s_mp_mul_digs_fast 0 # undef TclBN_s_mp_sqr_fast # define TclBN_s_mp_sqr_fast 0 |
︙ | ︙ | |||
937 938 939 940 941 942 943 944 945 946 947 948 949 950 | TclPtrGetVar, /* 252 */ TclPtrSetVar, /* 253 */ TclPtrIncrObjVar, /* 254 */ TclPtrObjMakeUpvar, /* 255 */ TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ TclpCreateTemporaryDirectory, /* 258 */ }; static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ TclGetAndDetachPids, /* 0 */ | > | 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 | TclPtrGetVar, /* 252 */ TclPtrSetVar, /* 253 */ TclPtrIncrObjVar, /* 254 */ TclPtrObjMakeUpvar, /* 255 */ TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ TclpCreateTemporaryDirectory, /* 258 */ TclUnusedStubEntry, /* 259 */ }; static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ TclGetAndDetachPids, /* 0 */ |
︙ | ︙ |
Changes to generic/tclTestObj.c.
︙ | ︙ | |||
21 22 23 24 25 26 27 28 29 30 31 32 33 34 | #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" #else # include "tclTomMath.h" #endif #include "tclStringRep.h" /* * Forward declarations for functions defined later in this file: */ static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex); static int GetVariableIndex(Tcl_Interp *interp, | > > > > > > > > | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" #else # include "tclTomMath.h" #endif #include "tclStringRep.h" #ifdef __GNUC__ /* * The rest of this file shouldn't warn about deprecated functions; they're * there because we intend them to be so and know that this file is OK to * touch those fields. */ #pragma GCC diagnostic ignored "-Wdeprecated-declarations" #endif /* * Forward declarations for functions defined later in this file: */ static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex); static int GetVariableIndex(Tcl_Interp *interp, |
︙ | ︙ | |||
160 161 162 163 164 165 166 | }; enum options { BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN, BIGNUM_RADIXSIZE }; int index, varIndex; const char *string; | | | 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | }; enum options { BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN, BIGNUM_RADIXSIZE }; int index, varIndex; const char *string; mp_int bignumValue; Tcl_Obj **varPtr; (void)dummy; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
234 235 236 237 238 239 240 | if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } | < | < < | | < | < < | | > > > > > > | | | 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 | if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } if (mp_mul_d(&bignumValue, 10, &bignumValue) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, Tcl_NewStringObj("error in mp_mul_d", -1)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetBignumObj(varPtr[varIndex], &bignumValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue)); } break; case BIGNUM_DIV10: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } if (mp_div_d(&bignumValue, 10, &bignumValue, NULL) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, Tcl_NewStringObj("error in mp_div_d", -1)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetBignumObj(varPtr[varIndex], &bignumValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue)); } break; case BIGNUM_ISEVEN: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } if (mp_mod_2d(&bignumValue, 1, &bignumValue) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, Tcl_NewStringObj("error in mp_mod_2d", -1)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetIntObj(varPtr[varIndex], mp_iszero(&bignumValue)); } else { SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iszero(&bignumValue))); } mp_clear(&bignumValue); break; case BIGNUM_RADIXSIZE: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); |
︙ | ︙ |
Changes to generic/tclTrace.c.
︙ | ︙ | |||
75 76 77 78 79 80 81 | * TCL_TRACE_ANY_EXEC - OR'd combination of all EXEC flags. * TCL_TRACE_EXEC_IN_PROGRESS - The callback function on this trace is * currently executing. Therefore we don't let * further traces execute. * TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly * by the command being traced, not because of * an internal trace. | < | | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 | * TCL_TRACE_ANY_EXEC - OR'd combination of all EXEC flags. * TCL_TRACE_EXEC_IN_PROGRESS - The callback function on this trace is * currently executing. Therefore we don't let * further traces execute. * TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly * by the command being traced, not because of * an internal trace. * The flag 'TCL_TRACE_DESTROYED' may also be used in command execution traces. */ #define TCL_TRACE_ENTER_DURING_EXEC 4 #define TCL_TRACE_LEAVE_DURING_EXEC 8 #define TCL_TRACE_ANY_EXEC 15 #define TCL_TRACE_EXEC_IN_PROGRESS 0x10 #define TCL_TRACE_EXEC_DIRECT 0x20 |
︙ | ︙ | |||
2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 | part1 = TclGetString(part1Ptr); part2 = part2Ptr? TclGetString(part2Ptr) : NULL; return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg); } int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ | > > > | 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 | part1 = TclGetString(part1Ptr); part2 = part2Ptr? TclGetString(part2Ptr) : NULL; return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg); } #undef TCL_INTERP_DESTROYED #define TCL_INTERP_DESTROYED 0x100 int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ |
︙ | ︙ |
Changes to generic/tclUtf.c.
︙ | ︙ | |||
783 784 785 786 787 788 789 | { int len, fullchar; Tcl_UniChar find = 0; while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; | | | 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 | { int len, fullchar; Tcl_UniChar find = 0; while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; #if TCL_UTF_MAX <= 3 if ((fullchar != ch) && (find >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &find); fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000; } #endif if (fullchar == ch) { return src; |
︙ | ︙ | |||
831 832 833 834 835 836 837 | Tcl_UniChar find = 0; const char *last; last = NULL; while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; | | | 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 | Tcl_UniChar find = 0; const char *last; last = NULL; while (1) { len = TclUtfToUniChar(src, &find); fullchar = find; #if TCL_UTF_MAX <= 3 if ((fullchar != ch) && (find >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &find); fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000; } #endif if (fullchar == ch) { last = src; |
︙ | ︙ | |||
874 875 876 877 878 879 880 | const char * Tcl_UtfNext( const char *src) /* The current location in the string. */ { Tcl_UniChar ch = 0; int len = TclUtfToUniChar(src, &ch); | | | 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 | const char * Tcl_UtfNext( const char *src) /* The current location in the string. */ { Tcl_UniChar ch = 0; int len = TclUtfToUniChar(src, &ch); #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); } #endif return src + len; } |
︙ | ︙ | |||
956 957 958 959 960 961 962 | int Tcl_UniCharAtIndex( const char *src, /* The UTF-8 string to dereference. */ int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int fullchar = 0; | | | | | | 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 | int Tcl_UniCharAtIndex( const char *src, /* The UTF-8 string to dereference. */ int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int fullchar = 0; #if TCL_UTF_MAX <= 3 int len = 0; #endif while (index-- >= 0) { #if TCL_UTF_MAX <= 3 src += (len = TclUtfToUniChar(src, &ch)); #else src += TclUtfToUniChar(src, &ch); #endif } fullchar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { /* If last Tcl_UniChar was a high surrogate, combine with low surrogate */ (void)TclUtfToUniChar(src, &ch); fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif return fullchar; } /* *--------------------------------------------------------------------------- * * Tcl_UtfAtIndex -- * * Returns a pointer to the specified character (not byte) position in * the UTF-8 string. If TCL_UTF_MAX <= 3, characters > U+FFFF count as * 2 positions, but then the pointer should never be placed between * the two positions. * * Results: * As above. * * Side effects: |
︙ | ︙ | |||
1009 1010 1011 1012 1013 1014 1015 | Tcl_UniChar ch = 0; int len = 0; while (index-- > 0) { len = TclUtfToUniChar(src, &ch); src += len; } | | | 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 | Tcl_UniChar ch = 0; int len = 0; while (index-- > 0) { len = TclUtfToUniChar(src, &ch); src += len; } #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { /* Index points at character following high Surrogate */ src += TclUtfToUniChar(src, &ch); } #endif return src; } |
︙ | ︙ | |||
1106 1107 1108 1109 1110 1111 1112 | * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { len = TclUtfToUniChar(src, &ch); upChar = ch; | | | 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 | * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { len = TclUtfToUniChar(src, &ch); upChar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ upChar = (((upChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif upChar = Tcl_UniCharToUpper(upChar); |
︙ | ︙ | |||
1168 1169 1170 1171 1172 1173 1174 | * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { len = TclUtfToUniChar(src, &ch); lowChar = ch; | | | 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 | * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { len = TclUtfToUniChar(src, &ch); lowChar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif lowChar = Tcl_UniCharToLower(lowChar); |
︙ | ︙ | |||
1233 1234 1235 1236 1237 1238 1239 | */ src = dst = str; if (*src) { len = TclUtfToUniChar(src, &ch); titleChar = ch; | | | | 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 | */ src = dst = str; if (*src) { len = TclUtfToUniChar(src, &ch); titleChar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ titleChar = (((titleChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif titleChar = Tcl_UniCharToTitle(titleChar); if ((len < TclUtfCount(titleChar)) || ((titleChar & 0xF800) == 0xD800)) { memmove(dst, src, len); dst += len; } else { dst += Tcl_UniCharToUtf(titleChar, dst); } src += len; } while (*src) { len = TclUtfToUniChar(src, &ch); lowChar = ch; #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { len += TclUtfToUniChar(src + len, &ch); /* Combine surrogates */ lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif /* Special exception for Georgian Asomtavruli chars, no titlecase. */ |
︙ | ︙ | |||
1365 1366 1367 1368 1369 1370 1371 | * only when both strings are of at least n chars long (no need for \0 * check) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { | | | 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 | * only when both strings are of at least n chars long (no need for \0 * check) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; |
︙ | ︙ | |||
1416 1417 1418 1419 1420 1421 1422 | * 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) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { | | | 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 | * 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) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; |
︙ | ︙ | |||
1465 1466 1467 1468 1469 1470 1471 | { Tcl_UniChar ch1 = 0, ch2 = 0; while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { | | | 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 | { Tcl_UniChar ch1 = 0, ch2 = 0; while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; |
︙ | ︙ | |||
1511 1512 1513 1514 1515 1516 1517 | { Tcl_UniChar ch1 = 0, ch2 = 0; while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { | | | 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 | { Tcl_UniChar ch1 = 0, ch2 = 0; while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; |
︙ | ︙ |
Changes to generic/tclZipfs.c.
︙ | ︙ | |||
388 389 390 391 392 393 394 395 396 397 398 399 400 401 | Tcl_Interp *interp); static int ZipChannelGetFile(void *instanceData, int direction, void **handlePtr); static int ZipChannelRead(void *instanceData, char *buf, int toRead, int *errloc); static int ZipChannelSeek(void *instanceData, long offset, int mode, int *errloc); static void ZipChannelWatchChannel(void *instanceData, int mask); static int ZipChannelWrite(void *instanceData, const char *buf, int toWrite, int *errloc); /* * Define the ZIP filesystem dispatch table. | > > | 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 | Tcl_Interp *interp); static int ZipChannelGetFile(void *instanceData, int direction, void **handlePtr); static int ZipChannelRead(void *instanceData, char *buf, int toRead, int *errloc); static int ZipChannelSeek(void *instanceData, long offset, int mode, int *errloc); static Tcl_WideInt ZipChannelWideSeek(void *instanceData, Tcl_WideInt offset, int mode, int *errloc); static void ZipChannelWatchChannel(void *instanceData, int mask); static int ZipChannelWrite(void *instanceData, const char *buf, int toWrite, int *errloc); /* * Define the ZIP filesystem dispatch table. |
︙ | ︙ | |||
426 427 428 429 430 431 432 | NULL, /* createDirectoryProc */ NULL, /* removeDirectoryProc */ NULL, /* deleteFileProc */ NULL, /* copyFileProc */ NULL, /* renameFileProc */ NULL, /* copyDirectoryProc */ NULL, /* lstatProc */ | | | 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 | NULL, /* createDirectoryProc */ NULL, /* removeDirectoryProc */ NULL, /* deleteFileProc */ NULL, /* copyFileProc */ NULL, /* renameFileProc */ NULL, /* copyDirectoryProc */ NULL, /* lstatProc */ (Tcl_FSLoadFileProc *)(void *)ZipFSLoadFile, NULL, /* getCwdProc */ NULL, /* chdirProc */ }; /* * The channel type/driver definition used for ZIP archive members. */ |
︙ | ︙ | |||
450 451 452 453 454 455 456 | NULL, /* Get options, NULL'able */ ZipChannelWatchChannel, /* Initialize notifier */ ZipChannelGetFile, /* Get OS handle from the channel */ NULL, /* 2nd version of close channel, NULL'able */ NULL, /* Set blocking mode for raw channel, NULL'able */ NULL, /* Function to flush channel, NULL'able */ NULL, /* Function to handle event, NULL'able */ | | | 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 | NULL, /* Get options, NULL'able */ ZipChannelWatchChannel, /* Initialize notifier */ ZipChannelGetFile, /* Get OS handle from the channel */ NULL, /* 2nd version of close channel, NULL'able */ NULL, /* Set blocking mode for raw channel, NULL'able */ NULL, /* Function to flush channel, NULL'able */ NULL, /* Function to handle event, NULL'able */ ZipChannelWideSeek, /* Wide seek function, NULL'able */ NULL, /* Thread action function, NULL'able */ NULL, /* Truncate function, NULL'able */ }; /* * Miscellaneous constants. */ |
︙ | ︙ | |||
1282 1283 1284 1285 1286 1287 1288 | ZipFSCloseArchive(interp, zf0); return TCL_ERROR; } Unlock(); *zf = *zf0; zf->mountPoint = (char *)Tcl_GetHashKey(&ZipFS.zipHash, hPtr); | | | 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 | ZipFSCloseArchive(interp, zf0); return TCL_ERROR; } Unlock(); *zf = *zf0; zf->mountPoint = (char *)Tcl_GetHashKey(&ZipFS.zipHash, hPtr); Tcl_CreateExitHandler(ZipfsExitHandler, zf); zf->mountPointLen = strlen(zf->mountPoint); zf->nameLength = strlen(zipname); zf->name = (char *)ckalloc(zf->nameLength + 1); memcpy(zf->name, zipname, zf->nameLength + 1); zf->entries = NULL; zf->topEnts = NULL; zf->numOpen = 0; |
︙ | ︙ | |||
1848 1849 1850 1851 1852 1853 1854 | } if (z->data) { ckfree(z->data); } ckfree(z); } ZipFSCloseArchive(interp, zf); | | | 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 | } if (z->data) { ckfree(z->data); } ckfree(z); } ZipFSCloseArchive(interp, zf); Tcl_DeleteExitHandler(ZipfsExitHandler, zf); ckfree(zf); unmounted = 1; done: Unlock(); if (unmounted) { Tcl_FSMountsChanged(NULL); } |
︙ | ︙ | |||
3495 3496 3497 3498 3499 3500 3501 | *errloc = 0; return toWrite; } /* *------------------------------------------------------------------------- * | | | | | | | 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 | *errloc = 0; return toWrite; } /* *------------------------------------------------------------------------- * * ZipChannelSeek/ZipChannelWideSeek -- * * This function is called to position file pointer of channel. * * Results: * New file position or -1 on error with error number set. * * Side effects: * File pointer is repositioned according to offset and mode. * *------------------------------------------------------------------------- */ static Tcl_WideInt ZipChannelWideSeek( void *instanceData, Tcl_WideInt offset, int mode, int *errloc) { ZipChannel *info = (ZipChannel *) instanceData; size_t end; if (!info->isWriting && (info->isDirectory < 0)) { /* * Special case: when executable combined with ZIP archive file, seek * within front of ZIP, i.e. the executable itself. */ end = info->zipFilePtr->baseOffset; |
︙ | ︙ | |||
3548 3549 3550 3551 3552 3553 3554 | return -1; } if (offset < 0) { *errloc = EINVAL; return -1; } if (info->isWriting) { | | | | | > > > > > > > > > > | 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 | return -1; } if (offset < 0) { *errloc = EINVAL; return -1; } if (info->isWriting) { if ((size_t) offset > info->maxWrite) { *errloc = EINVAL; return -1; } if ((size_t) offset > info->numBytes) { info->numBytes = offset; } } else if ((size_t) offset > end) { *errloc = EINVAL; return -1; } info->numRead = (size_t) offset; return info->numRead; } static int ZipChannelSeek( void *instanceData, long offset, int mode, int *errloc) { return ZipChannelWideSeek(instanceData, offset, mode, errloc); } /* *------------------------------------------------------------------------- * * ZipChannelWatchChannel -- * * This function is called for event notifications on channel. Does |
︙ | ︙ | |||
4739 4740 4741 4742 4743 4744 4745 | if (objs[0]) { Tcl_DecrRefCount(objs[0]); } if (objs[1]) { Tcl_DecrRefCount(objs[1]); } | | | 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 | if (objs[0]) { Tcl_DecrRefCount(objs[0]); } if (objs[1]) { Tcl_DecrRefCount(objs[1]); } loadFileProc = (Tcl_FSLoadFileProc2 *)(void *)tclNativeFilesystem.loadFileProc; if (loadFileProc) { ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); } else { Tcl_SetErrno(ENOENT); ZIPFS_ERROR(interp, Tcl_PosixError(interp)); } if (altPath) { |
︙ | ︙ |
Changes to generic/tclZlib.c.
︙ | ︙ | |||
200 201 202 203 204 205 206 | /* * Type of zlib-based compressing and decompressing channels. */ static const Tcl_ChannelType zlibChannelType = { "zlib", | | | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 | /* * Type of zlib-based compressing and decompressing channels. */ static const Tcl_ChannelType zlibChannelType = { "zlib", TCL_CHANNEL_VERSION_5, ZlibTransformClose, ZlibTransformInput, ZlibTransformOutput, NULL, /* seekProc */ ZlibTransformSetOption, ZlibTransformGetOption, ZlibTransformWatch, |
︙ | ︙ |
Changes to library/tcltest/tcltest.tcl.
︙ | ︙ | |||
966 967 968 969 970 971 972 | variable testConstraints variable Option DebugPuts 3 "entering testConstraint $constraint $value" if {[llength [info level 0]] == 2} { return $testConstraints($constraint) } # Check for boolean values | | | 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 | variable testConstraints variable Option DebugPuts 3 "entering testConstraint $constraint $value" if {[llength [info level 0]] == 2} { return $testConstraints($constraint) } # Check for boolean values if {[catch {expr {$value && 1}} msg]} { return -code error $msg } if {[limitConstraints] && ($constraint ni $Option(-constraints))} { set value 0 } set testConstraints($constraint) $value } |
︙ | ︙ |
Changes to libtommath/tommath_private.h.
︙ | ︙ | |||
279 280 281 282 283 284 285 | b >>= ((MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) ? 0 : MP_DIGIT_BIT); \ } \ a->used = i; \ a->sign = MP_ZPOS; \ MP_ZERO_DIGITS(a->dp + a->used, a->alloc - a->used); \ } | < < < < | 279 280 281 282 283 284 285 286 287 288 289 290 291 292 | b >>= ((MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) ? 0 : MP_DIGIT_BIT); \ } \ a->used = i; \ a->sign = MP_ZPOS; \ MP_ZERO_DIGITS(a->dp + a->used, a->alloc - a->used); \ } #define MP_SET_SIGNED(name, uname, type, utype) \ void name(mp_int * a, type b) \ { \ uname(a, (b < 0) ? -(utype)b : (utype)b); \ if (b < 0) { a->sign = MP_NEG; } \ } |
︙ | ︙ |
Changes to tests/cmdIL.test.
︙ | ︙ | |||
15 16 17 18 19 20 21 22 23 24 25 26 27 28 | ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] testConstraint testobj [llength [info commands testobj]] test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort } -result {wrong # args: should be "lsort ?-option value ...? list"} test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort -foo {1 3 2 5} } -result {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, -stride, or -unique} | > > | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] testConstraint testobj [llength [info commands testobj]] source [file join [file dirname [info script]] internals.tcl] namespace import -force ::tcltest::internals::* test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort } -result {wrong # args: should be "lsort ?-option value ...? list"} test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort -foo {1 3 2 5} } -result {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, -stride, or -unique} |
︙ | ︙ | |||
515 516 517 518 519 520 521 522 523 524 525 526 527 528 | test_lsort 0 } -result 0 -cleanup { rename test_lsort "" } test cmdIL-5.6 {lsort with multiple list-style index options} { lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}} } {{a b} {b e} {c d}} # Compiled version test cmdIL-6.1 {lassign command syntax} -returnCodes error -body { apply {{} { lassign }} } -result {wrong # args: should be "lassign list ?varName ...?"} test cmdIL-6.2 {lassign command syntax} { apply {{} { lassign x }} | > > > > > > > > > > > > > > > | 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 | test_lsort 0 } -result 0 -cleanup { rename test_lsort "" } test cmdIL-5.6 {lsort with multiple list-style index options} { lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}} } {{a b} {b e} {c d}} test cmdIL-5.7 {lsort memory exhaustion} -constraints {testWithLimit} -body { # test it in child process (with limited address space) ca. 80MB extra memory # on x64 system it would be not enough to sort 4M items (the half 2M only), # warn and skip if no error (enough memory) or error by list creation: testWithLimit \ -warn-on-code 0 -warn-on-alloc-error 1 \ -addmem [expr {$tcl_platform(pointerSize)*4000000 + $tcl_platform(pointerSize)*3*2000000}] \ { # create list and get length (avoid too long output in interactive shells): llength [set l [lrepeat 4000000 ""]] # test OOM: llength [lsort $l] } # expecting error no memory by sort } -returnCodes 1 -result {no enough memory to proccess sort of 4000000 items} # Compiled version test cmdIL-6.1 {lassign command syntax} -returnCodes error -body { apply {{} { lassign }} } -result {wrong # args: should be "lassign list ?varName ...?"} test cmdIL-6.2 {lassign command syntax} { apply {{} { lassign x }} |
︙ | ︙ |
Added tests/internals.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | # This file contains internal facilities for Tcl tests. # # Source this file in the related tests to include from tcl-tests: # # source [file join [file dirname [info script]] internals.tcl] # # Copyright (c) 2020 Sergey G. Brester (sebres). # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[namespace which -command ::tcltest::internals::scriptpath] eq ""} {namespace eval ::tcltest::internals { namespace path ::tcltest ::tcltest::ConstraintInitializer testWithLimit { expr {[testConstraint macOrUnix] && ![catch { exec prlimit --version }]} } # test-with-limit -- # # Usage: test-with-limit ?-addmem bytes? ?-maxmem bytes? command # Options: # -addmem - set additional memory limit (in bytes) as difference (extra memory needed to run a test) # -maxmem - set absolute maximum address space limit (in bytes) # proc testWithLimit args { set body [lindex $args end] array set in [lrange $args 0 end-1] # test in child process (with limits): set pipe {} if {[catch { # start new process: set pipe [open |[list [interpreter]] r+] set ppid [pid $pipe] # create prlimit args: set args {} # with limited address space: if {[info exists in(-addmem)] || [info exists in(-maxmem)]} { if {[info exists in(-addmem)]} { # as differnce to normal usage, so try to retrieve current memory usage: if {[catch { # using ps (vsz is in KB): incr in(-addmem) [expr {[lindex [exec ps -hq $ppid -o vsz] end] * 1024}] }]} { # ps failed, use default size 20MB: incr in(-addmem) 20000000 # + size of locale-archive (may be up to 100MB): incr in(-addmem) [expr { [file exists /usr/lib/locale/locale-archive] ? [file size /usr/lib/locale/locale-archive] : 0 }] } if {![info exists in(-maxmem)]} { set in(-maxmem) $in(-addmem) } set in(-maxmem) [expr { max($in(-addmem), $in(-maxmem)) }] } append args --as=$in(-maxmem) } # apply limits: exec prlimit -p $ppid {*}$args } msg opt]} { catch {close $pipe} tcltest::Warn "testWithLimit: error - [regsub {^\s*([^\n]*).*$} $msg {\1}]" tcltest::Skip testWithLimit } # execute body, close process and return: set ret [catch { chan configure $pipe -buffering line puts $pipe "puts \[$body\]" puts $pipe exit set result [read $pipe] close $pipe set pipe {} set result } result opt] if {$pipe ne ""} { catch { close $pipe } } if {$ret && [dict get $opt -errorcode] eq "BYPASS-SKIPPED-TEST"} { return {*}$opt $result } if { ( [info exists in(-warn-on-code)] && $ret in $in(-warn-on-code) ) || ( $ret && [info exists in(-warn-on-alloc-error)] && $in(-warn-on-alloc-error) && [regexp {\munable to (?:re)?alloc\M} $result] ) } { tcltest::Warn "testWithLimit: wrong limit, result: $result" tcltest::Skip testWithLimit } return {*}$opt $result } # export all routines starting with test namespace export test* # for script path & as mark for loaded proc scriptpath {} [list return [info script]] }}; # end of internals. |
Changes to tests/oo.test.
︙ | ︙ | |||
107 108 109 110 111 112 113 | } leaktest {[foo new] destroy} } -cleanup { foo destroy } -result 0 test oo-0.9 {various types of presence of the TclOO package} { list [lsearch -nocase -all -inline [package names] tcloo] \ | | | | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 | } leaktest {[foo new] destroy} } -cleanup { foo destroy } -result 0 test oo-0.9 {various types of presence of the TclOO package} { list [lsearch -nocase -all -inline [package names] tcloo] \ [package present TclOO] [expr {$::oo::patchlevel in [package versions TclOO]}] } [list TclOO $::oo::patchlevel 1] test oo-1.1 {basic test of OO functionality: no classes} { set result {} lappend result [oo::object create foo] lappend result [oo::objdefine foo { method bar args { global result |
︙ | ︙ |
Changes to tests/stringObj.test.
︙ | ︙ | |||
19 20 21 22 23 24 25 26 27 28 29 30 31 32 | ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [llength [info commands testobj]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] test stringObj-1.1 {string type registration} testobj { set t [testobj types] set first [string first "string" $t] set result [expr {$first != -1}] } {1} | > > | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [llength [info commands testobj]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] testConstraint tip389 [expr {[string length \U010000] == 2}] testConstraint nodep [info exists tcl_precision] test stringObj-1.1 {string type registration} testobj { set t [testobj types] set first [string first "string" $t] set result [expr {$first != -1}] } {1} |
︙ | ︙ | |||
460 461 462 463 464 465 466 | teststringobj set 1 foo teststringobj appendself 1 2 } fooo test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself 1 3 } foo | | | | | | 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 | teststringobj set 1 foo teststringobj appendself 1 2 } fooo test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself 1 3 } foo test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} { teststringobj set 1 foo teststringobj appendself2 1 0 } foofoo test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} { teststringobj set 1 foo teststringobj appendself2 1 1 } foooo test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} { teststringobj set 1 foo teststringobj appendself2 1 2 } fooo test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} { teststringobj set 1 foo teststringobj appendself2 1 3 } foo if {[testConstraint testobj]} { testobj freeallvars } |
︙ | ︙ |
Changes to unix/Makefile.in.
︙ | ︙ | |||
278 279 280 281 282 283 284 | #-------------------------------------------------------------------------- STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \ ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ ${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \ @EXTRA_CC_SWITCHES@ | | | 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 | #-------------------------------------------------------------------------- STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \ ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ ${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \ @EXTRA_CC_SWITCHES@ CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS -DMP_NO_STDINT APP_CC_SWITCHES = $(CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@ LIBS = @TCL_LIBS@ DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ ${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ |
︙ | ︙ |
Changes to unix/configure.
︙ | ︙ | |||
4677 4678 4679 4680 4681 4682 4683 | libtommath_ok=no fi if test $libtommath_ok = yes; then : | | | | | > < | | | < < < < | | < < < < < | < < < < < | | | < < | | < | 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 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 | libtommath_ok=no fi if test $libtommath_ok = yes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mp_log_u32 in -ltommath" >&5 $as_echo_n "checking for mp_log_u32 in -ltommath... " >&6; } if ${ac_cv_lib_tommath_mp_log_u32+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS LIBS="-ltommath $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char mp_log_u32 (); int main () { return mp_log_u32 (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO"; then : ac_cv_lib_tommath_mp_log_u32=yes else ac_cv_lib_tommath_mp_log_u32=no fi rm -f core conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tommath_mp_log_u32" >&5 $as_echo "$ac_cv_lib_tommath_mp_log_u32" >&6; } if test "x$ac_cv_lib_tommath_mp_log_u32" = xyes; then : MATH_LIBS="$MATH_LIBS -ltommath" else libtommath_ok=no fi fi fi if test $libtommath_ok = yes; then : |
︙ | ︙ | |||
5326 5327 5328 5329 5330 5331 5332 | DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 | | | 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 | DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\[email protected]" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Cygwin version of gcc" >&5 $as_echo_n "checking for Cygwin version of gcc... " >&6; } if ${ac_cv_cygwin+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext |
︙ | ︙ | |||
6596 6597 6598 6599 6600 6601 6602 | UNSHARED_LIB_SUFFIX='${VERSION}.a' fi DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then : LIB_SUFFIX=${SHARED_LIB_SUFFIX} | | | 6579 6580 6581 6582 6583 6584 6585 6586 6587 6588 6589 6590 6591 6592 6593 | UNSHARED_LIB_SUFFIX='${VERSION}.a' fi DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then : LIB_SUFFIX=${SHARED_LIB_SUFFIX} MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' if test "${SHLIB_SUFFIX}" = ".dll"; then : INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" else |
︙ | ︙ | |||
6746 6747 6748 6749 6750 6751 6752 | if test "${enable_symbols+set}" = set; then : enableval=$enable_symbols; tcl_ok=$enableval else tcl_ok=no fi # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. | < | 6729 6730 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 | if test "${enable_symbols+set}" = set; then : enableval=$enable_symbols; tcl_ok=$enableval else tcl_ok=no fi # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' $as_echo "#define NDEBUG 1" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 |
︙ | ︙ |
Changes to unix/configure.ac.
︙ | ︙ | |||
176 177 178 179 180 181 182 | [use external libtommath (default: true if available, false otherwise)]), libtommath_ok=${withval}) if test x"${libtommath_ok}" = x -o x"${libtommath_ok}" != xno; then AC_CHECK_HEADER([tommath.h],[ AC_CHECK_TYPE([mp_int],[],[libtommath_ok=no],[#include <tommath.h>])],[ libtommath_ok=no]) AS_IF([test $libtommath_ok = yes], [ | | | < | 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 | [use external libtommath (default: true if available, false otherwise)]), libtommath_ok=${withval}) if test x"${libtommath_ok}" = x -o x"${libtommath_ok}" != xno; then AC_CHECK_HEADER([tommath.h],[ AC_CHECK_TYPE([mp_int],[],[libtommath_ok=no],[#include <tommath.h>])],[ libtommath_ok=no]) AS_IF([test $libtommath_ok = yes], [ AC_CHECK_LIB([tommath],[mp_log_u32],[MATH_LIBS="$MATH_LIBS -ltommath"],[ libtommath_ok=no])]) fi AS_IF([test $libtommath_ok = yes], [ AC_DEFINE(TCL_WITH_EXTERNAL_TOMMATH, 1, [Tcl with external libtommath]) ], [ AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}]) AC_SUBST(TOMMATH_SRCS,[\${TOMMATH_SRCS}]) AC_SUBST(TOMMATH_INCLUDE,[-I\${TOMMATH_DIR}]) |
︙ | ︙ |
Changes to unix/tcl.m4.
︙ | ︙ | |||
289 290 291 292 293 294 295 | if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TCL_BIN_DIR}/tclConfig.sh" else AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi | < < < < | 289 290 291 292 293 294 295 296 297 298 299 300 301 302 | if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TCL_BIN_DIR}/tclConfig.sh" else AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi # If the TCL_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TCL_LIB_SPEC will be set to the value # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC # instead of TCL_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TCL_BIN_DIR}/Makefile" ; then |
︙ | ︙ | |||
326 327 328 329 330 331 332 | TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" fi ;; esac fi | < < < < < < | 322 323 324 325 326 327 328 329 330 331 332 333 334 335 | TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" fi ;; esac fi AC_SUBST(TCL_VERSION) AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) |
︙ | ︙ | |||
372 373 374 375 376 377 378 | if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TK_BIN_DIR}/tkConfig.sh" else AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi | < < < < | 362 363 364 365 366 367 368 369 370 371 372 373 374 375 | if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then AC_MSG_RESULT([loading]) . "${TK_BIN_DIR}/tkConfig.sh" else AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi # If the TK_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TK_LIB_SPEC will be set to the value # of TK_BUILD_LIB_SPEC. An extension should make use of TK_LIB_SPEC # instead of TK_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TK_BIN_DIR}/Makefile" ; then |
︙ | ︙ | |||
409 410 411 412 413 414 415 | TK_STUB_LIB_SPEC="-L` echo "${TK_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TK_STUB_LIB_FLAG}" TK_STUB_LIB_PATH="${TK_BIN_DIR}/${TK_STUB_LIB_FILE}" fi ;; esac fi | < < < < < < | 395 396 397 398 399 400 401 402 403 404 405 406 407 408 | TK_STUB_LIB_SPEC="-L` echo "${TK_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TK_STUB_LIB_FLAG}" TK_STUB_LIB_PATH="${TK_BIN_DIR}/${TK_STUB_LIB_FILE}" fi ;; esac fi AC_SUBST(TK_VERSION) AC_SUBST(TK_BIN_DIR) AC_SUBST(TK_SRC_DIR) AC_SUBST(TK_LIB_FILE) AC_SUBST(TK_LIB_FLAG) AC_SUBST(TK_LIB_SPEC) |
︙ | ︙ | |||
620 621 622 623 624 625 626 | # --enable-symbols # # Defines the following vars: # CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true # Sets to $(CFLAGS_OPTIMIZE) if false # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false | < < < | 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 | # --enable-symbols # # Defines the following vars: # CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true # Sets to $(CFLAGS_OPTIMIZE) if false # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, AC_HELP_STRING([--enable-symbols], [build with debugging symbols (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?]) AC_MSG_RESULT([no]) AC_DEFINE(TCL_CFG_OPTIMIZED, 1, [Is this an optimized build?]) else |
︙ | ︙ | |||
1105 1106 1107 1108 1109 1110 1111 | DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 | | | 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 | DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a" AC_CACHE_CHECK(for Cygwin version of gcc, ac_cv_cygwin, AC_TRY_COMPILE([ #ifdef __CYGWIN__ #error cygwin #endif |
︙ | ︙ | |||
1817 1818 1819 1820 1821 1822 1823 | SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}']) AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [ UNSHARED_LIB_SUFFIX='${VERSION}.a']) DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [ LIB_SUFFIX=${SHARED_LIB_SUFFIX} | | | 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 | SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}']) AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [ UNSHARED_LIB_SUFFIX='${VERSION}.a']) DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [ LIB_SUFFIX=${SHARED_LIB_SUFFIX} MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" ], [ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' ]) ], [ |
︙ | ︙ |
Changes to unix/tcl.pc.in.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # tcl pkg-config source file prefix=@prefix@ exec_prefix=@exec_prefix@ libdir=@libdir@ includedir=@includedir@ libfile=@TCL_LIB_FILE@ zipfile=@TCL_ZIP_FILE@ Name: Tool Command Language Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses. URL: http://www.tcl.tk/ Version: @TCL_VERSION@@TCL_PATCH_LEVEL@ | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | # tcl pkg-config source file prefix=@prefix@ exec_prefix=@exec_prefix@ libdir=@libdir@ includedir=@includedir@ libfile=@TCL_LIB_FILE@ zipfile=@TCL_ZIP_FILE@ Name: Tool Command Language Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses. URL: http://www.tcl.tk/ Version: @TCL_VERSION@@TCL_PATCH_LEVEL@ Requires.private: zlib >= 1.2.3, libtommath >= 1.2.0 Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_STUB_LIB_FLAG@ Libs.private: @TCL_LIBS@ Cflags: -I${includedir} |
Changes to unix/tclUnixSock.c.
︙ | ︙ | |||
685 686 687 688 689 690 691 | static int TcpClose2Proc( void *instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = (TcpState *)instanceData; | | | < < < < < | < < < | < < | > | | | | < | 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 | static int TcpClose2Proc( void *instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = (TcpState *)instanceData; int readError = 0; int writeError = 0; /* * Shutdown the OS socket handle. */ if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { return TcpCloseProc(instanceData, interp); } if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->fds.fd, SHUT_RD) < 0)) { readError = errno; } if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->fds.fd, SHUT_WR) < 0)) { writeError = errno; } return (readError != 0) ? readError : writeError; } /* *---------------------------------------------------------------------- * * TcpHostPortList -- * |
︙ | ︙ |
Changes to unix/tclUnixThrd.c.
︙ | ︙ | |||
262 263 264 265 266 267 268 | #endif /* HAVE_PTHREAD_ATTR_SETSTACKSIZE */ if (!(flags & TCL_THREAD_JOINABLE)) { pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); } if (pthread_create(&theThread, &attr, | | | | 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 | #endif /* HAVE_PTHREAD_ATTR_SETSTACKSIZE */ if (!(flags & TCL_THREAD_JOINABLE)) { pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); } if (pthread_create(&theThread, &attr, (void * (*)(void *))(void *)proc, (void *) clientData) && pthread_create(&theThread, NULL, (void * (*)(void *))(void *)proc, (void *) clientData)) { result = TCL_ERROR; } else { *idPtr = (Tcl_ThreadId) theThread; result = TCL_OK; } pthread_attr_destroy(&attr); return result; |
︙ | ︙ |
Changes to win/Makefile.in.
︙ | ︙ | |||
78 79 80 81 82 83 84 | 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) | | | 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 | 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@ -D_ATL_XP_TARGETING -DMP_FIXED_CUTOFFS -DMP_NO_STDINT # 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 |
︙ | ︙ | |||
830 831 832 833 834 835 836 | echo Installing $(REG_LIB_FILE); \ $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi install-libraries-zipfs-shared: libraries install-libraries-zipfs-static: install-libraries-zipfs-shared | | | 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 | echo Installing $(REG_LIB_FILE); \ $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi install-libraries-zipfs-shared: libraries install-libraries-zipfs-static: install-libraries-zipfs-shared $(COPY) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" install-libraries: libraries install-tzdata install-msgs @for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \ $(SCRIPT_INSTALL_DIR); \ do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ |
︙ | ︙ |
Changes to win/makefile.vc.
︙ | ︙ | |||
435 436 437 438 439 440 441 | ### the left side of implicit rules. TOMMATHDIR = $(ROOT)\libtommath PKGSDIR = $(ROOT)\pkgs # Additional include and C macro definitions for the implicit rules # defined in rules.vc PRJ_INCLUDES = -I"$(TOMMATHDIR)" | | | 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 | ### the left side of implicit rules. TOMMATHDIR = $(ROOT)\libtommath PKGSDIR = $(ROOT)\pkgs # Additional include and C macro definitions for the implicit rules # defined in rules.vc PRJ_INCLUDES = -I"$(TOMMATHDIR)" PRJ_DEFINES = /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS # Additional Link libraries needed beyond those in rules.vc PRJ_LIBS = netapi32.lib user32.lib userenv.lib ws2_32.lib #--------------------------------------------------------------------- # TclTest flags #--------------------------------------------------------------------- |
︙ | ︙ |
Changes to win/rules.vc.
︙ | ︙ | |||
682 683 684 685 686 687 688 | # UNCHECKED - 1 -> when doing a debug build with symbols, use the release # C runtime, 0 -> use the debug C runtime. # USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking # CONFIG_CHECK - 1 -> check current build configuration against Tcl # configuration (ignored for Tcl itself) # _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build # (CRT library should support this) | | | 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 | # UNCHECKED - 1 -> when doing a debug build with symbols, use the release # C runtime, 0 -> use the debug C runtime. # USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking # CONFIG_CHECK - 1 -> check current build configuration against Tcl # configuration (ignored for Tcl itself) # _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build # (CRT library should support this) # TCL_UTF_MAX=4 - forces a build allowing 4-byte UTF-8 sequences internally. # Further, LINKERFLAGS are modified based on above. # Default values for all the above STATIC_BUILD = 0 TCL_THREADS = 1 DEBUG = 0 SYMBOLS = 0 |
︙ | ︙ | |||
757 758 759 760 761 762 763 | !if [nmakehlp -f $(OPTS) "time64bit"] !message *** Force 64-bit time_t _USE_64BIT_TIME_T = 1 !endif !if [nmakehlp -f $(OPTS) "utfmax"] | | | | 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 | !if [nmakehlp -f $(OPTS) "time64bit"] !message *** Force 64-bit time_t _USE_64BIT_TIME_T = 1 !endif !if [nmakehlp -f $(OPTS) "utfmax"] !message *** Force allowing 4-byte UTF-8 sequences internally TCL_UTF_MAX = 4 !endif # Yes, it's weird that the "symbols" option controls DEBUG and # the "pdbs" option controls SYMBOLS. That's historical. !if [nmakehlp -f $(OPTS) "symbols"] !message *** Doing symbols DEBUG = 1 |
︙ | ︙ | |||
1298 1299 1300 1301 1302 1303 1304 | OPTDEFINES = /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS !if $(VCVERSION) >= 1600 OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1 !else OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1 !endif | < < < | | 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 | OPTDEFINES = /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS !if $(VCVERSION) >= 1600 OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1 !else OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1 !endif !if $(VCVERSION) >= 1800 OPTDEFINES = $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1 !endif !if $(TCL_MEM_DEBUG) OPTDEFINES = $(OPTDEFINES) /DTCL_MEM_DEBUG !endif !if $(TCL_COMPILE_DEBUG) OPTDEFINES = $(OPTDEFINES) /DTCL_COMPILE_DEBUG /DTCL_COMPILE_STATS |
︙ | ︙ | |||
1359 1360 1361 1362 1363 1364 1365 | !if $(VCVERSION) < 1300 OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1 !endif !if "$(_USE_64BIT_TIME_T)" == "1" OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1 !endif | | | | 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 | !if $(VCVERSION) < 1300 OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1 !endif !if "$(_USE_64BIT_TIME_T)" == "1" OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1 !endif !if "$(TCL_UTF_MAX)" == "4" OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=4 !endif # _ATL_XP_TARGETING - Newer SDK's need this to build for XP COMPILERFLAGS = /D_ATL_XP_TARGETING # Like the TEA system only set this non empty for non-Tk extensions # Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME |
︙ | ︙ |
Changes to win/tclWinInit.c.
︙ | ︙ | |||
450 451 452 453 454 455 456 457 | Tcl_DStringFree(&encodingName); } const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) { Tcl_DStringInit(bufPtr); | > > > > > | | | > | 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 | Tcl_DStringFree(&encodingName); } const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) { UINT acp = GetACP(); Tcl_DStringInit(bufPtr); if (acp == CP_UTF8) { Tcl_DStringAppend(bufPtr, "utf-8", 5); } else { Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE); wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP()); Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr))); } return Tcl_DStringValue(bufPtr); } const char * TclpGetUserName( Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * the name of user. */ |
︙ | ︙ |
Changes to win/tclWinSock.c.
︙ | ︙ | |||
1133 1134 1135 1136 1137 1138 1139 | static int TcpClose2Proc( ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = (TcpState *)instanceData; | | | < < < < | < < < < < < < | | | > > > | | | 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 | static int TcpClose2Proc( ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = (TcpState *)instanceData; int readError = 0; int writeError = 0; /* * Shutdown the OS socket handle. */ if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { return TcpCloseProc(instanceData, interp); } /* * Single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or * TCL_WRITABLE so this should never be called for a server socket. */ if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) { TclWinConvertError((DWORD) WSAGetLastError()); readError = Tcl_GetErrno(); } if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) { TclWinConvertError((DWORD) WSAGetLastError()); writeError = Tcl_GetErrno(); } return (readError != 0) ? readError : writeError; } /* *---------------------------------------------------------------------- * * TcpSetOptionProc -- * |
︙ | ︙ |