Compare commits
170
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
5e7e1715af | ||
|
|
674dc6d84e | ||
|
|
f85eb13554 | ||
|
|
50eb79b797 | ||
|
|
dd66ab423e | ||
|
|
7600da9e6c | ||
|
|
a1300ad826 | ||
|
|
fea0c84f2f | ||
|
|
25fb9a6a54 | ||
|
|
baf1eb36e4 | ||
|
|
6c22f6b730 | ||
|
|
2071be71b1 | ||
|
|
51f0bfd5ae | ||
|
|
a7c911213a | ||
|
|
41da2b1489 | ||
|
|
b359029baa | ||
|
|
c447bf4370 | ||
|
|
68328fdcd5 | ||
|
|
c8c0db5f21 | ||
|
|
c29132ab84 | ||
|
|
edbf195dff | ||
|
|
6da79937df | ||
|
|
66c0809095 | ||
|
|
5f690c8fae | ||
|
|
c811b1d642 | ||
|
|
50c851a04b | ||
|
|
e1051201ce | ||
|
|
410ffcdefa | ||
|
|
09dd330c44 | ||
|
|
3458214e46 | ||
|
|
0987bb4b63 | ||
|
|
64a0be31b9 | ||
|
|
2098e71e79 | ||
|
|
4a24561f0b | ||
|
|
df1dd156ed | ||
|
|
1a819d1063 | ||
|
|
6ee4d2b394 | ||
|
|
26c9f5e773 | ||
|
|
466e7c47c6 | ||
|
|
37dceb3922 | ||
|
|
0c2d0f0ab7 | ||
|
|
2fb58dc372 | ||
|
|
2c78daa2b0 | ||
|
|
02c0281379 | ||
|
|
e736d151a0 | ||
|
|
dcb3b835e4 | ||
|
|
e027188168 | ||
|
|
c4c090889c | ||
|
|
01570cabab | ||
|
|
182b7f85f6 | ||
|
|
e1b3b51a8f | ||
|
|
23dd40e1a2 | ||
|
|
9af2fb9efe | ||
|
|
1a7bbea40c | ||
|
|
aec3f90f4d | ||
|
|
198dbe0117 | ||
|
|
19eccf461d | ||
|
|
ca96bc096f | ||
|
|
034957707a | ||
|
|
ce003df1ca | ||
|
|
63e2ca9905 | ||
|
|
9512351bc5 | ||
|
|
ce353e21ed | ||
|
|
fb61224892 | ||
|
|
f10942c112 | ||
|
|
62e806dc83 | ||
|
|
9831556bf7 | ||
|
|
9586d2f54c | ||
|
|
800f0a1edf | ||
|
|
304ca9a172 | ||
|
|
d7fdb20ed5 | ||
|
|
6e4c20e3a6 | ||
|
|
704627190d | ||
|
|
a8075a956d | ||
|
|
ab1a8089de | ||
|
|
9c35850e30 | ||
|
|
55bb2e9be3 | ||
|
|
0033456148 | ||
|
|
ce60562f86 | ||
|
|
aad734db91 | ||
|
|
c1ebc6273f | ||
|
|
e08e3fbc09 | ||
|
|
ae955d6d24 | ||
|
|
756913ce13 | ||
|
|
21fec5d3d1 | ||
|
|
72557b402d | ||
|
|
a1d4fac3d8 | ||
|
|
3e3ef5f0be | ||
|
|
c70c765bc7 | ||
|
|
a67d7e8610 | ||
|
|
2b4d8d160a | ||
|
|
3504682d15 | ||
|
|
065cc78833 | ||
|
|
32aba95cdd | ||
|
|
15dbbaf497 | ||
|
|
f52fe2c0c0 | ||
|
|
fc1e6cc187 | ||
|
|
dff9e4fbb2 | ||
|
|
92aeea296b | ||
|
|
42bbf78a33 | ||
|
|
04ef72b73b | ||
|
|
e47a1c3779 | ||
|
|
ce09232ac7 | ||
|
|
0a3bf031ac | ||
|
|
e78c831950 | ||
|
|
e284637f4c | ||
|
|
97195d18a9 | ||
|
|
99af05cca8 | ||
|
|
29a34b9b95 | ||
|
|
30b1f27305 | ||
|
|
b2687dde17 | ||
|
|
a0ec63efa5 | ||
|
|
e1fca6fb5d | ||
|
|
0fcfcc0f88 | ||
|
|
1852320cca | ||
|
|
79e893e6f2 | ||
|
|
4232bc484d | ||
|
|
af2c18d5ea | ||
|
|
fadb579028 | ||
|
|
ed01d27700 | ||
|
|
09b9930667 | ||
|
|
657095d29a | ||
|
|
05277ab690 | ||
|
|
333b4efa28 | ||
|
|
adbdca59a9 | ||
|
|
2918f547d8 | ||
|
|
c52403ad33 | ||
|
|
2b343d0207 | ||
|
|
5363b1f11f | ||
|
|
b49efc9ae0 | ||
|
|
7fe77d7ff8 | ||
|
|
f54d9a7c69 | ||
|
|
9832ae4232 | ||
|
|
388bc52075 | ||
|
|
2c039a780e | ||
|
|
5c70426f61 | ||
|
|
d2fa0702bc | ||
|
|
530d3a7f83 | ||
|
|
f98272ec1e | ||
|
|
ba64c646ee | ||
|
|
f79b9fa715 | ||
|
|
50baebbe77 | ||
|
|
749fefd640 | ||
|
|
2e12764223 | ||
|
|
fc2acd077c | ||
|
|
e6c0a3dcfb | ||
|
|
962a5361ab | ||
|
|
a15ae048d3 | ||
|
|
f91edb6f99 | ||
|
|
3763c10f23 | ||
|
|
84f1110b9d | ||
|
|
6bb895f4c6 | ||
|
|
c4329d52b1 | ||
|
|
86ec6ab749 | ||
|
|
07235a8a6f | ||
|
|
e36e170f46 | ||
|
|
5f1e5885b7 | ||
|
|
f04818aaa8 | ||
|
|
2e1f7ff673 | ||
|
|
6d704ccf07 | ||
|
|
fef646d799 | ||
|
|
2f0b5c46a2 | ||
|
|
03a672aeea | ||
|
|
3294957eb6 | ||
|
|
4789965abd | ||
|
|
9735f7b1a9 | ||
|
|
0779620efd | ||
|
|
69675d1a04 | ||
|
|
57ed822ecb | ||
|
|
314feacb7c |
@@ -48,11 +48,9 @@ libtommath/*.tex
|
||||
macosx/configure
|
||||
unix/autoMkindex.tcl
|
||||
unix/dltest.marker
|
||||
unix/dltest/embtest
|
||||
unix/dltest/*.bundle
|
||||
unix/dltest/*.dll
|
||||
unix/dltest/*.dylib
|
||||
unix/dltest/*.exe
|
||||
unix/dltest/*.o
|
||||
unix/dltest/*.sl
|
||||
unix/dltest/*.so
|
||||
|
||||
@@ -4,7 +4,6 @@ on:
|
||||
branches:
|
||||
- "main"
|
||||
- "core-8-branch"
|
||||
- "core-8-6-branch"
|
||||
tags:
|
||||
- "core-**"
|
||||
permissions:
|
||||
@@ -16,8 +15,6 @@ jobs:
|
||||
matrix:
|
||||
cfgopt:
|
||||
- ""
|
||||
- "CFLAGS=-DTCL_UTF_MAX=3"
|
||||
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
|
||||
- "--disable-shared"
|
||||
- "--enable-symbols"
|
||||
- "--enable-symbols=mem"
|
||||
@@ -29,7 +26,6 @@ jobs:
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
timeout-minutes: 5
|
||||
- name: Prepare
|
||||
run: |
|
||||
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
|
||||
@@ -40,30 +36,23 @@ jobs:
|
||||
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
|
||||
env:
|
||||
CFGOPT: ${{ matrix.cfgopt }}
|
||||
timeout-minutes: 5
|
||||
- name: Build
|
||||
run: |
|
||||
make all
|
||||
timeout-minutes: 5
|
||||
- name: Build Test Harness
|
||||
run: |
|
||||
make tcltest
|
||||
timeout-minutes: 5
|
||||
- name: Run Tests
|
||||
run: |
|
||||
make test
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
timeout-minutes: 30
|
||||
- name: Test-Drive Installation
|
||||
run: |
|
||||
make install
|
||||
timeout-minutes: 5
|
||||
- name: Create Distribution Package
|
||||
run: |
|
||||
make dist
|
||||
timeout-minutes: 5
|
||||
- name: Convert Documentation to HTML
|
||||
run: |
|
||||
make html-tcl
|
||||
timeout-minutes: 5
|
||||
|
||||
@@ -4,7 +4,6 @@ on:
|
||||
branches:
|
||||
- "main"
|
||||
- "core-8-branch"
|
||||
- "core-8-6-branch"
|
||||
tags:
|
||||
- "core-**"
|
||||
permissions:
|
||||
@@ -19,7 +18,6 @@ jobs:
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
timeout-minutes: 5
|
||||
- name: Prepare
|
||||
run: |
|
||||
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
|
||||
@@ -28,13 +26,11 @@ jobs:
|
||||
run: make all
|
||||
env:
|
||||
CFLAGS: -arch x86_64 -arch arm64
|
||||
timeout-minutes: 15
|
||||
- name: Run Tests
|
||||
run: make test styles=develop
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
MAC_CI: 1
|
||||
timeout-minutes: 15
|
||||
clang:
|
||||
runs-on: macos-11
|
||||
strategy:
|
||||
@@ -52,7 +48,6 @@ jobs:
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
timeout-minutes: 5
|
||||
- name: Prepare
|
||||
run: |
|
||||
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
|
||||
@@ -64,17 +59,14 @@ jobs:
|
||||
env:
|
||||
CFLAGS: -arch x86_64 -arch arm64
|
||||
CFGOPT: ${{ matrix.cfgopt }}
|
||||
timeout-minutes: 5
|
||||
- name: Build
|
||||
run: |
|
||||
make all tcltest
|
||||
env:
|
||||
CFLAGS: -arch x86_64 -arch arm64
|
||||
timeout-minutes: 15
|
||||
- name: Run Tests
|
||||
run: |
|
||||
make test
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
MAC_CI: 1
|
||||
timeout-minutes: 15
|
||||
|
||||
@@ -15,7 +15,6 @@ jobs:
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
timeout-minutes: 10
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
@@ -51,7 +50,6 @@ jobs:
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
timeout-minutes: 10
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
@@ -114,7 +112,6 @@ jobs:
|
||||
defaults:
|
||||
run:
|
||||
shell: msys2 {0}
|
||||
timeout-minutes: 10
|
||||
env:
|
||||
CC: gcc
|
||||
CFGOPT: --disable-symbols --disable-shared
|
||||
|
||||
@@ -4,7 +4,6 @@ on:
|
||||
branches:
|
||||
- "main"
|
||||
- "core-8-branch"
|
||||
- "core-8-6-branch"
|
||||
tags:
|
||||
- "core-**"
|
||||
permissions:
|
||||
@@ -31,31 +30,26 @@ jobs:
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
timeout-minutes: 5
|
||||
- name: Init MSVC
|
||||
uses: ilammy/msvc-dev-cmd@v1
|
||||
timeout-minutes: 5
|
||||
- name: Build ${{ matrix.cfgopt }}
|
||||
run: |
|
||||
&nmake -f makefile.vc ${{ matrix.cfgopt }} all
|
||||
if ($lastexitcode -ne 0) {
|
||||
throw "nmake exit code: $lastexitcode"
|
||||
}
|
||||
timeout-minutes: 5
|
||||
- name: Build Test Harness ${{ matrix.cfgopt }}
|
||||
run: |
|
||||
&nmake -f makefile.vc ${{ matrix.cfgopt }} tcltest
|
||||
if ($lastexitcode -ne 0) {
|
||||
throw "nmake exit code: $lastexitcode"
|
||||
}
|
||||
timeout-minutes: 5
|
||||
- name: Run Tests ${{ matrix.cfgopt }}
|
||||
run: |
|
||||
&nmake -f makefile.vc ${{ matrix.cfgopt }} test
|
||||
if ($lastexitcode -ne 0) {
|
||||
throw "nmake exit code: $lastexitcode"
|
||||
}
|
||||
timeout-minutes: 30
|
||||
gcc:
|
||||
runs-on: windows-2022
|
||||
defaults:
|
||||
@@ -66,8 +60,6 @@ jobs:
|
||||
matrix:
|
||||
cfgopt:
|
||||
- ""
|
||||
- "CFLAGS=-DTCL_UTF_MAX=3"
|
||||
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
|
||||
- "--disable-shared"
|
||||
- "--enable-symbols"
|
||||
- "--enable-symbols=mem"
|
||||
@@ -79,10 +71,8 @@ jobs:
|
||||
with:
|
||||
msystem: MINGW64
|
||||
install: git mingw-w64-x86_64-toolchain make
|
||||
timeout-minutes: 10
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
timeout-minutes: 5
|
||||
- name: Prepare
|
||||
run: |
|
||||
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
|
||||
@@ -93,16 +83,12 @@ jobs:
|
||||
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
|
||||
env:
|
||||
CFGOPT: --enable-64bit ${{ matrix.cfgopt }}
|
||||
timeout-minutes: 5
|
||||
- name: Build
|
||||
run: make all
|
||||
timeout-minutes: 5
|
||||
- name: Build Test Harness
|
||||
run: make tcltest
|
||||
timeout-minutes: 5
|
||||
- name: Run Tests
|
||||
run: make test
|
||||
timeout-minutes: 30
|
||||
|
||||
# If you add builds with Wine, be sure to define the environment variable
|
||||
# CI_USING_WINE when running them so that broken tests know not to run.
|
||||
|
||||
@@ -53,7 +53,6 @@ libtommath/*.tex
|
||||
macosx/configure
|
||||
unix/autoMkindex.tcl
|
||||
unix/dltest.marker
|
||||
unix/dltest/embtest
|
||||
unix/tcl.pc
|
||||
unix/tclIndex
|
||||
unix/pkgs/*
|
||||
|
||||
-36
@@ -20,20 +20,12 @@ jobs:
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- name: "Linux/GCC/Shared: UTF_MAX=3"
|
||||
os: linux
|
||||
dist: focal
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT="CFLAGS=-DTCL_UTF_MAX=3"
|
||||
- name: "Linux/GCC/Shared: NO_DEPRECATED"
|
||||
os: linux
|
||||
dist: focal
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
|
||||
- name: "Linux/GCC/Static"
|
||||
os: linux
|
||||
dist: focal
|
||||
@@ -301,20 +293,6 @@ jobs:
|
||||
- touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
|
||||
- choco install -y make zip
|
||||
- cd ${BUILD_DIR}
|
||||
- name: "Windows/GCC/Shared: UTF_MAX=3"
|
||||
os: windows
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3"
|
||||
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"
|
||||
before_install: *makepreinst
|
||||
- name: "Windows/GCC/Static"
|
||||
os: windows
|
||||
compiler: gcc
|
||||
@@ -343,20 +321,6 @@ jobs:
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
before_install: *makepreinst
|
||||
- name: "Windows/GCC-x86/Shared: UTF_MAX=3"
|
||||
os: windows
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT="CFLAGS=-DTCL_UTF_MAX=3"
|
||||
before_install: *makepreinst
|
||||
- name: "Windows/GCC-x86/Shared: NO_DEPRECATED"
|
||||
os: windows
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
|
||||
before_install: *makepreinst
|
||||
- name: "Windows/GCC-x86/Static"
|
||||
os: windows
|
||||
compiler: gcc
|
||||
|
||||
@@ -8247,7 +8247,7 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
|
||||
|
||||
2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)
|
||||
|
||||
2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1F (nijtmans)
|
||||
2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans)
|
||||
|
||||
2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans)
|
||||
|
||||
|
||||
@@ -0,0 +1,21 @@
|
||||
/*
|
||||
* dirent.h --
|
||||
*
|
||||
* This file is a replacement for <dirent.h> in systems that
|
||||
* support the old BSD-style <sys/dir.h> with a "struct direct".
|
||||
*
|
||||
* Copyright (c) 1991 The Regents of the University of California.
|
||||
* Copyright (c) 1994 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution
|
||||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#ifndef _DIRENT
|
||||
#define _DIRENT
|
||||
|
||||
#include <sys/dir.h>
|
||||
|
||||
#define dirent direct
|
||||
|
||||
#endif /* _DIRENT */
|
||||
@@ -0,0 +1,53 @@
|
||||
/*
|
||||
* dirent.h --
|
||||
*
|
||||
* Declarations of a library of directory-reading procedures
|
||||
* in the POSIX style ("struct dirent").
|
||||
*
|
||||
* Copyright (c) 1991 The Regents of the University of California.
|
||||
* Copyright (c) 1994 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution
|
||||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#ifndef _DIRENT
|
||||
#define _DIRENT
|
||||
|
||||
/*
|
||||
* Dirent structure, which holds information about a single
|
||||
* directory entry.
|
||||
*/
|
||||
|
||||
#define MAXNAMLEN 255
|
||||
#define DIRBLKSIZ 512
|
||||
|
||||
struct dirent {
|
||||
long d_ino; /* Inode number of entry */
|
||||
short d_reclen; /* Length of this record */
|
||||
short d_namlen; /* Length of string in d_name */
|
||||
char d_name[MAXNAMLEN + 1]; /* Name must be no longer than this */
|
||||
};
|
||||
|
||||
/*
|
||||
* State that keeps track of the reading of a directory (clients
|
||||
* should never look inside this structure; the fields should
|
||||
* only be accessed by the library procedures).
|
||||
*/
|
||||
|
||||
typedef struct _dirdesc {
|
||||
int dd_fd;
|
||||
long dd_loc;
|
||||
long dd_size;
|
||||
char dd_buf[DIRBLKSIZ];
|
||||
} DIR;
|
||||
|
||||
/*
|
||||
* Procedures defined for reading directories:
|
||||
*/
|
||||
|
||||
extern void closedir (DIR *dirp);
|
||||
extern DIR * opendir (char *name);
|
||||
extern struct dirent * readdir (DIR *dirp);
|
||||
|
||||
#endif /* _DIRENT */
|
||||
@@ -0,0 +1,64 @@
|
||||
/*
|
||||
* memcmp.c --
|
||||
*
|
||||
* Source code for the "memcmp" library routine.
|
||||
*
|
||||
* Copyright (c) 1998 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include "tclPort.h"
|
||||
|
||||
/*
|
||||
* Here is the prototype just in case it is not included in tclPort.h.
|
||||
*/
|
||||
|
||||
int memcmp(const void *s1, const void *s2, size_t n);
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* memcmp --
|
||||
*
|
||||
* Compares two bytes sequences.
|
||||
*
|
||||
* Results:
|
||||
* Compares its arguments, looking at the first n bytes (each interpreted
|
||||
* as an unsigned char), and returns an integer less than, equal to, or
|
||||
* greater than 0, according as s1 is less than, equal to, or greater
|
||||
* than s2 when taken to be unsigned 8 bit numbers.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
memcmp(
|
||||
const void *s1, /* First string. */
|
||||
const void *s2, /* Second string. */
|
||||
size_t n) /* Length to compare. */
|
||||
{
|
||||
const unsigned char *ptr1 = (const unsigned char *) s1;
|
||||
const unsigned char *ptr2 = (const unsigned char *) s2;
|
||||
|
||||
for ( ; n-- ; ptr1++, ptr2++) {
|
||||
unsigned char u1 = *ptr1, u2 = *ptr2;
|
||||
|
||||
if (u1 != u2) {
|
||||
return (u1-u2);
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
* c-basic-offset: 4
|
||||
* fill-column: 78
|
||||
* End:
|
||||
*/
|
||||
@@ -0,0 +1,109 @@
|
||||
/*
|
||||
* opendir.c --
|
||||
*
|
||||
* This file provides dirent-style directory-reading procedures for V7
|
||||
* Unix systems that don't have such procedures. The origin of this code
|
||||
* is unclear, but it seems to have come originally from Larry Wall.
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
#undef DIRSIZ
|
||||
#define DIRSIZ(dp) \
|
||||
((sizeof(struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))
|
||||
|
||||
/*
|
||||
* open a directory.
|
||||
*/
|
||||
|
||||
DIR *
|
||||
opendir(
|
||||
char *name)
|
||||
{
|
||||
DIR *dirp;
|
||||
int fd;
|
||||
const char *myname;
|
||||
|
||||
myname = ((*name == '\0') ? "." : name);
|
||||
if ((fd = open(myname, 0, 0)) == -1) {
|
||||
return NULL;
|
||||
}
|
||||
dirp = (DIR *) Tcl_AttemptAlloc(sizeof(DIR));
|
||||
if (dirp == NULL) {
|
||||
close(fd);
|
||||
return NULL;
|
||||
}
|
||||
dirp->dd_fd = fd;
|
||||
dirp->dd_loc = 0;
|
||||
return dirp;
|
||||
}
|
||||
|
||||
/*
|
||||
* read an old style directory entry and present it as a new one
|
||||
*/
|
||||
#ifndef pyr
|
||||
#define ODIRSIZ 14
|
||||
|
||||
struct olddirect {
|
||||
ino_t od_ino;
|
||||
char od_name[ODIRSIZ];
|
||||
};
|
||||
#else /* a Pyramid in the ATT universe */
|
||||
#define ODIRSIZ 248
|
||||
|
||||
struct olddirect {
|
||||
long od_ino;
|
||||
short od_fill1, od_fill2;
|
||||
char od_name[ODIRSIZ];
|
||||
};
|
||||
#endif
|
||||
|
||||
/*
|
||||
* get next entry in a directory.
|
||||
*/
|
||||
|
||||
struct dirent *
|
||||
readdir(
|
||||
DIR *dirp)
|
||||
{
|
||||
struct olddirect *dp;
|
||||
static struct dirent dir;
|
||||
|
||||
for (;;) {
|
||||
if (dirp->dd_loc == 0) {
|
||||
dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ);
|
||||
if (dirp->dd_size <= 0) {
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
if (dirp->dd_loc >= dirp->dd_size) {
|
||||
dirp->dd_loc = 0;
|
||||
continue;
|
||||
}
|
||||
dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
|
||||
dirp->dd_loc += sizeof(struct olddirect);
|
||||
if (dp->od_ino == 0) {
|
||||
continue;
|
||||
}
|
||||
dir.d_ino = dp->od_ino;
|
||||
strncpy(dir.d_name, dp->od_name, ODIRSIZ);
|
||||
dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
|
||||
dir.d_namlen = strlen(dir.d_name);
|
||||
dir.d_reclen = DIRSIZ(&dir);
|
||||
return &dir;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* close a directory.
|
||||
*/
|
||||
|
||||
void
|
||||
closedir(
|
||||
DIR *dirp)
|
||||
{
|
||||
close(dirp->dd_fd);
|
||||
dirp->dd_fd = -1;
|
||||
dirp->dd_loc = 0;
|
||||
Tcl_Free(dirp);
|
||||
}
|
||||
+919
@@ -0,0 +1,919 @@
|
||||
/* A portable stdint.h
|
||||
****************************************************************************
|
||||
* BSD License:
|
||||
****************************************************************************
|
||||
*
|
||||
* Copyright (c) 2005-2016 Paul Hsieh
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above copyright
|
||||
* notice, this list of conditions and the following disclaimer in the
|
||||
* documentation and/or other materials provided with the distribution.
|
||||
* 3. The name of the author may not be used to endorse or promote products
|
||||
* derived from this software without specific prior written permission.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
|
||||
* IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
|
||||
* OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
|
||||
* IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
|
||||
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
|
||||
* THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
****************************************************************************
|
||||
*
|
||||
* Version 0.1.16.0
|
||||
*
|
||||
* The ANSI C standard committee, for the C99 standard, specified the
|
||||
* inclusion of a new standard include file called stdint.h. This is
|
||||
* a very useful and long desired include file which contains several
|
||||
* very precise definitions for integer scalar types that is critically
|
||||
* important for making several classes of applications portable
|
||||
* including cryptography, hashing, variable length integer libraries
|
||||
* and so on. But for most developers its likely useful just for
|
||||
* programming sanity.
|
||||
*
|
||||
* The problem is that some compiler vendors chose to ignore the C99
|
||||
* standard and some older compilers have no opportunity to be updated.
|
||||
* Because of this situation, simply including stdint.h in your code
|
||||
* makes it unportable.
|
||||
*
|
||||
* So that's what this file is all about. It's an attempt to build a
|
||||
* single universal include file that works on as many platforms as
|
||||
* possible to deliver what stdint.h is supposed to. Even compilers
|
||||
* that already come with stdint.h can use this file instead without
|
||||
* any loss of functionality. A few things that should be noted about
|
||||
* this file:
|
||||
*
|
||||
* 1) It is not guaranteed to be portable and/or present an identical
|
||||
* interface on all platforms. The extreme variability of the
|
||||
* ANSI C standard makes this an impossibility right from the
|
||||
* very get go. Its really only meant to be useful for the vast
|
||||
* majority of platforms that possess the capability of
|
||||
* implementing usefully and precisely defined, standard sized
|
||||
* integer scalars. Systems which are not intrinsically 2s
|
||||
* complement may produce invalid constants.
|
||||
*
|
||||
* 2) There is an unavoidable use of non-reserved symbols.
|
||||
*
|
||||
* 3) Other standard include files are invoked.
|
||||
*
|
||||
* 4) This file may come in conflict with future platforms that do
|
||||
* include stdint.h. The hope is that one or the other can be
|
||||
* used with no real difference.
|
||||
*
|
||||
* 5) In the current version, if your platform can't represent
|
||||
* int32_t, int16_t and int8_t, it just dumps out with a compiler
|
||||
* error.
|
||||
*
|
||||
* 6) 64 bit integers may or may not be defined. Test for their
|
||||
* presence with the test: #ifdef INT64_MAX or #ifdef UINT64_MAX.
|
||||
* Note that this is different from the C99 specification which
|
||||
* requires the existence of 64 bit support in the compiler. If
|
||||
* this is not defined for your platform, yet it is capable of
|
||||
* dealing with 64 bits then it is because this file has not yet
|
||||
* been extended to cover all of your system's capabilities.
|
||||
*
|
||||
* 7) (u)intptr_t may or may not be defined. Test for its presence
|
||||
* with the test: #ifdef PTRDIFF_MAX. If this is not defined
|
||||
* for your platform, then it is because this file has not yet
|
||||
* been extended to cover all of your system's capabilities, not
|
||||
* because its optional.
|
||||
*
|
||||
* 8) The following might not been defined even if your platform is
|
||||
* capable of defining it:
|
||||
*
|
||||
* WCHAR_MIN
|
||||
* WCHAR_MAX
|
||||
* (u)int64_t
|
||||
* PTRDIFF_MIN
|
||||
* PTRDIFF_MAX
|
||||
* (u)intptr_t
|
||||
*
|
||||
* 9) The following have not been defined:
|
||||
*
|
||||
* WINT_MIN
|
||||
* WINT_MAX
|
||||
*
|
||||
* 10) The criteria for defining (u)int_least(*)_t isn't clear,
|
||||
* except for systems which don't have a type that precisely
|
||||
* defined 8, 16, or 32 bit types (which this include file does
|
||||
* not support anyways). Default definitions have been given.
|
||||
*
|
||||
* 11) The criteria for defining (u)int_fast(*)_t isn't something I
|
||||
* would trust to any particular compiler vendor or the ANSI C
|
||||
* committee. It is well known that "compatible systems" are
|
||||
* commonly created that have very different performance
|
||||
* characteristics from the systems they are compatible with,
|
||||
* especially those whose vendors make both the compiler and the
|
||||
* system. Default definitions have been given, but its strongly
|
||||
* recommended that users never use these definitions for any
|
||||
* reason (they do *NOT* deliver any serious guarantee of
|
||||
* improved performance -- not in this file, nor any vendor's
|
||||
* stdint.h).
|
||||
*
|
||||
* 12) The following macros:
|
||||
*
|
||||
* PRINTF_INTMAX_MODIFIER
|
||||
* PRINTF_INT64_MODIFIER
|
||||
* PRINTF_INT32_MODIFIER
|
||||
* PRINTF_INT16_MODIFIER
|
||||
* PRINTF_LEAST64_MODIFIER
|
||||
* PRINTF_LEAST32_MODIFIER
|
||||
* PRINTF_LEAST16_MODIFIER
|
||||
* PRINTF_INTPTR_MODIFIER
|
||||
*
|
||||
* are strings which have been defined as the modifiers required
|
||||
* for the "d", "u" and "x" printf formats to correctly output
|
||||
* (u)intmax_t, (u)int64_t, (u)int32_t, (u)int16_t, (u)least64_t,
|
||||
* (u)least32_t, (u)least16_t and (u)intptr_t types respectively.
|
||||
* PRINTF_INTPTR_MODIFIER is not defined for some systems which
|
||||
* provide their own stdint.h. PRINTF_INT64_MODIFIER is not
|
||||
* defined if INT64_MAX is not defined. These are an extension
|
||||
* beyond what C99 specifies must be in stdint.h.
|
||||
*
|
||||
* In addition, the following macros are defined:
|
||||
*
|
||||
* PRINTF_INTMAX_HEX_WIDTH
|
||||
* PRINTF_INT64_HEX_WIDTH
|
||||
* PRINTF_INT32_HEX_WIDTH
|
||||
* PRINTF_INT16_HEX_WIDTH
|
||||
* PRINTF_INT8_HEX_WIDTH
|
||||
* PRINTF_INTMAX_DEC_WIDTH
|
||||
* PRINTF_INT64_DEC_WIDTH
|
||||
* PRINTF_INT32_DEC_WIDTH
|
||||
* PRINTF_INT16_DEC_WIDTH
|
||||
* PRINTF_UINT8_DEC_WIDTH
|
||||
* PRINTF_UINTMAX_DEC_WIDTH
|
||||
* PRINTF_UINT64_DEC_WIDTH
|
||||
* PRINTF_UINT32_DEC_WIDTH
|
||||
* PRINTF_UINT16_DEC_WIDTH
|
||||
* PRINTF_UINT8_DEC_WIDTH
|
||||
*
|
||||
* Which specifies the maximum number of characters required to
|
||||
* print the number of that type in either hexadecimal or decimal.
|
||||
* These are an extension beyond what C99 specifies must be in
|
||||
* stdint.h.
|
||||
*
|
||||
* Compilers tested (all with 0 warnings at their highest respective
|
||||
* settings): Borland Turbo C 2.0, WATCOM C/C++ 11.0 (16 bits and 32
|
||||
* bits), Microsoft Visual C++ 6.0 (32 bit), Microsoft Visual Studio
|
||||
* .net (VC7), Intel C++ 4.0, GNU gcc v3.3.3
|
||||
*
|
||||
* This file should be considered a work in progress. Suggestions for
|
||||
* improvements, especially those which increase coverage are strongly
|
||||
* encouraged.
|
||||
*
|
||||
* Acknowledgements
|
||||
*
|
||||
* The following people have made significant contributions to the
|
||||
* development and testing of this file:
|
||||
*
|
||||
* Chris Howie
|
||||
* John Steele Scott
|
||||
* Dave Thorup
|
||||
* John Dill
|
||||
* Florian Wobbe
|
||||
* Christopher Sean Morrison
|
||||
* Mikkel Fahnoe Jorgensen
|
||||
*
|
||||
*/
|
||||
|
||||
#include <stddef.h>
|
||||
#include <limits.h>
|
||||
#include <signal.h>
|
||||
|
||||
/*
|
||||
* For gcc with _STDINT_H, fill in the PRINTF_INT*_MODIFIER macros, and
|
||||
* do nothing else. On the Mac OS X version of gcc this is _STDINT_H_.
|
||||
*/
|
||||
|
||||
#if ((defined(__SUNPRO_C) && __SUNPRO_C >= 0x570) || (defined(_MSC_VER) && _MSC_VER >= 1600) || (defined(__STDC__) && __STDC__ && defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined (__WATCOMC__) && (defined (_STDINT_H_INCLUDED) || __WATCOMC__ >= 1250)) || (defined(__GNUC__) && (__GNUC__ > 3 || defined(_STDINT_H) || defined(_STDINT_H_) || defined (__UINT_FAST64_TYPE__)) )) && !defined (_PSTDINT_H_INCLUDED)
|
||||
#include <stdint.h>
|
||||
#define _PSTDINT_H_INCLUDED
|
||||
# if defined(__GNUC__) && (defined(__x86_64__) || defined(__ppc64__)) && !(defined(__APPLE__) && defined(__MACH__))
|
||||
# ifndef PRINTF_INT64_MODIFIER
|
||||
# define PRINTF_INT64_MODIFIER "l"
|
||||
# endif
|
||||
# ifndef PRINTF_INT32_MODIFIER
|
||||
# define PRINTF_INT32_MODIFIER ""
|
||||
# endif
|
||||
# else
|
||||
# ifndef PRINTF_INT64_MODIFIER
|
||||
# define PRINTF_INT64_MODIFIER "ll"
|
||||
# endif
|
||||
# ifndef PRINTF_INT32_MODIFIER
|
||||
# if (UINT_MAX == UINT32_MAX)
|
||||
# define PRINTF_INT32_MODIFIER ""
|
||||
# else
|
||||
# define PRINTF_INT32_MODIFIER "l"
|
||||
# endif
|
||||
# endif
|
||||
# endif
|
||||
# ifndef PRINTF_INT16_MODIFIER
|
||||
# define PRINTF_INT16_MODIFIER "h"
|
||||
# endif
|
||||
# ifndef PRINTF_INTMAX_MODIFIER
|
||||
# define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
|
||||
# endif
|
||||
# ifndef PRINTF_INT64_HEX_WIDTH
|
||||
# define PRINTF_INT64_HEX_WIDTH "16"
|
||||
# endif
|
||||
# ifndef PRINTF_UINT64_HEX_WIDTH
|
||||
# define PRINTF_UINT64_HEX_WIDTH "16"
|
||||
# endif
|
||||
# ifndef PRINTF_INT32_HEX_WIDTH
|
||||
# define PRINTF_INT32_HEX_WIDTH "8"
|
||||
# endif
|
||||
# ifndef PRINTF_UINT32_HEX_WIDTH
|
||||
# define PRINTF_UINT32_HEX_WIDTH "8"
|
||||
# endif
|
||||
# ifndef PRINTF_INT16_HEX_WIDTH
|
||||
# define PRINTF_INT16_HEX_WIDTH "4"
|
||||
# endif
|
||||
# ifndef PRINTF_UINT16_HEX_WIDTH
|
||||
# define PRINTF_UINT16_HEX_WIDTH "4"
|
||||
# endif
|
||||
# ifndef PRINTF_INT8_HEX_WIDTH
|
||||
# define PRINTF_INT8_HEX_WIDTH "2"
|
||||
# endif
|
||||
# ifndef PRINTF_UINT8_HEX_WIDTH
|
||||
# define PRINTF_UINT8_HEX_WIDTH "2"
|
||||
# endif
|
||||
# ifndef PRINTF_INT64_DEC_WIDTH
|
||||
# define PRINTF_INT64_DEC_WIDTH "19"
|
||||
# endif
|
||||
# ifndef PRINTF_UINT64_DEC_WIDTH
|
||||
# define PRINTF_UINT64_DEC_WIDTH "20"
|
||||
# endif
|
||||
# ifndef PRINTF_INT32_DEC_WIDTH
|
||||
# define PRINTF_INT32_DEC_WIDTH "10"
|
||||
# endif
|
||||
# ifndef PRINTF_UINT32_DEC_WIDTH
|
||||
# define PRINTF_UINT32_DEC_WIDTH "10"
|
||||
# endif
|
||||
# ifndef PRINTF_INT16_DEC_WIDTH
|
||||
# define PRINTF_INT16_DEC_WIDTH "5"
|
||||
# endif
|
||||
# ifndef PRINTF_UINT16_DEC_WIDTH
|
||||
# define PRINTF_UINT16_DEC_WIDTH "5"
|
||||
# endif
|
||||
# ifndef PRINTF_INT8_DEC_WIDTH
|
||||
# define PRINTF_INT8_DEC_WIDTH "3"
|
||||
# endif
|
||||
# ifndef PRINTF_UINT8_DEC_WIDTH
|
||||
# define PRINTF_UINT8_DEC_WIDTH "3"
|
||||
# endif
|
||||
# ifndef PRINTF_INTMAX_HEX_WIDTH
|
||||
# define PRINTF_INTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
|
||||
# endif
|
||||
# ifndef PRINTF_UINTMAX_HEX_WIDTH
|
||||
# define PRINTF_UINTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
|
||||
# endif
|
||||
# ifndef PRINTF_INTMAX_DEC_WIDTH
|
||||
# define PRINTF_INTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
|
||||
# endif
|
||||
# ifndef PRINTF_UINTMAX_DEC_WIDTH
|
||||
# define PRINTF_UINTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
|
||||
# endif
|
||||
|
||||
/*
|
||||
* Something really weird is going on with Open Watcom. Just pull some of
|
||||
* these duplicated definitions from Open Watcom's stdint.h file for now.
|
||||
*/
|
||||
|
||||
# if defined (__WATCOMC__) && __WATCOMC__ >= 1250
|
||||
# if !defined (INT64_C)
|
||||
# define INT64_C(x) (x + (INT64_MAX - INT64_MAX))
|
||||
# endif
|
||||
# if !defined (UINT64_C)
|
||||
# define UINT64_C(x) (x + (UINT64_MAX - UINT64_MAX))
|
||||
# endif
|
||||
# if !defined (INT32_C)
|
||||
# define INT32_C(x) (x + (INT32_MAX - INT32_MAX))
|
||||
# endif
|
||||
# if !defined (UINT32_C)
|
||||
# define UINT32_C(x) (x + (UINT32_MAX - UINT32_MAX))
|
||||
# endif
|
||||
# if !defined (INT16_C)
|
||||
# define INT16_C(x) (x)
|
||||
# endif
|
||||
# if !defined (UINT16_C)
|
||||
# define UINT16_C(x) (x)
|
||||
# endif
|
||||
# if !defined (INT8_C)
|
||||
# define INT8_C(x) (x)
|
||||
# endif
|
||||
# if !defined (UINT8_C)
|
||||
# define UINT8_C(x) (x)
|
||||
# endif
|
||||
# if !defined (UINT64_MAX)
|
||||
# define UINT64_MAX 18446744073709551615ULL
|
||||
# endif
|
||||
# if !defined (INT64_MAX)
|
||||
# define INT64_MAX 9223372036854775807LL
|
||||
# endif
|
||||
# if !defined (UINT32_MAX)
|
||||
# define UINT32_MAX 4294967295UL
|
||||
# endif
|
||||
# if !defined (INT32_MAX)
|
||||
# define INT32_MAX 2147483647L
|
||||
# endif
|
||||
# if !defined (INTMAX_MAX)
|
||||
# define INTMAX_MAX INT64_MAX
|
||||
# endif
|
||||
# if !defined (INTMAX_MIN)
|
||||
# define INTMAX_MIN INT64_MIN
|
||||
# endif
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* I have no idea what is the truly correct thing to do on older Solaris.
|
||||
* From some online discussions, this seems to be what is being
|
||||
* recommended. For people who actually are developing on older Solaris,
|
||||
* what I would like to know is, does this define all of the relevant
|
||||
* macros of a complete stdint.h? Remember, in pstdint.h 64 bit is
|
||||
* considered optional.
|
||||
*/
|
||||
|
||||
#if (defined(__SUNPRO_C) && __SUNPRO_C >= 0x420) && !defined(_PSTDINT_H_INCLUDED)
|
||||
#include <sys/inttypes.h>
|
||||
#define _PSTDINT_H_INCLUDED
|
||||
#endif
|
||||
|
||||
#ifndef _PSTDINT_H_INCLUDED
|
||||
#define _PSTDINT_H_INCLUDED
|
||||
|
||||
#ifndef SIZE_MAX
|
||||
# define SIZE_MAX ((size_t)-1)
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Deduce the type assignments from limits.h under the assumption that
|
||||
* integer sizes in bits are powers of 2, and follow the ANSI
|
||||
* definitions.
|
||||
*/
|
||||
|
||||
#ifndef UINT8_MAX
|
||||
# define UINT8_MAX 0xff
|
||||
#endif
|
||||
#if !defined(uint8_t) && !defined(_UINT8_T) && !defined(vxWorks)
|
||||
# if (UCHAR_MAX == UINT8_MAX) || defined (S_SPLINT_S)
|
||||
typedef unsigned char uint8_t;
|
||||
# define UINT8_C(v) ((uint8_t) v)
|
||||
# else
|
||||
# error "Platform not supported"
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifndef INT8_MAX
|
||||
# define INT8_MAX 0x7f
|
||||
#endif
|
||||
#ifndef INT8_MIN
|
||||
# define INT8_MIN INT8_C(0x80)
|
||||
#endif
|
||||
#if !defined(int8_t) && !defined(_INT8_T) && !defined(vxWorks)
|
||||
# if (SCHAR_MAX == INT8_MAX) || defined (S_SPLINT_S)
|
||||
typedef signed char int8_t;
|
||||
# define INT8_C(v) ((int8_t) v)
|
||||
# else
|
||||
# error "Platform not supported"
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifndef UINT16_MAX
|
||||
# define UINT16_MAX 0xffff
|
||||
#endif
|
||||
#if !defined(uint16_t) && !defined(_UINT16_T) && !defined(vxWorks)
|
||||
#if (UINT_MAX == UINT16_MAX) || defined (S_SPLINT_S)
|
||||
typedef unsigned int uint16_t;
|
||||
# ifndef PRINTF_INT16_MODIFIER
|
||||
# define PRINTF_INT16_MODIFIER ""
|
||||
# endif
|
||||
# define UINT16_C(v) ((uint16_t) (v))
|
||||
#elif (USHRT_MAX == UINT16_MAX)
|
||||
typedef unsigned short uint16_t;
|
||||
# define UINT16_C(v) ((uint16_t) (v))
|
||||
# ifndef PRINTF_INT16_MODIFIER
|
||||
# define PRINTF_INT16_MODIFIER "h"
|
||||
# endif
|
||||
#else
|
||||
#error "Platform not supported"
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifndef INT16_MAX
|
||||
# define INT16_MAX 0x7fff
|
||||
#endif
|
||||
#ifndef INT16_MIN
|
||||
# define INT16_MIN INT16_C(0x8000)
|
||||
#endif
|
||||
#if !defined(int16_t) && !defined(_INT16_T) && !defined(vxWorks)
|
||||
#if (INT_MAX == INT16_MAX) || defined (S_SPLINT_S)
|
||||
typedef signed int int16_t;
|
||||
# define INT16_C(v) ((int16_t) (v))
|
||||
# ifndef PRINTF_INT16_MODIFIER
|
||||
# define PRINTF_INT16_MODIFIER ""
|
||||
# endif
|
||||
#elif (SHRT_MAX == INT16_MAX)
|
||||
typedef signed short int16_t;
|
||||
# define INT16_C(v) ((int16_t) (v))
|
||||
# ifndef PRINTF_INT16_MODIFIER
|
||||
# define PRINTF_INT16_MODIFIER "h"
|
||||
# endif
|
||||
#else
|
||||
#error "Platform not supported"
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifndef UINT32_MAX
|
||||
# define UINT32_MAX (0xffffffffUL)
|
||||
#endif
|
||||
#if !defined(uint32_t) && !defined(_UINT32_T) && !defined(vxWorks)
|
||||
#if (ULONG_MAX == UINT32_MAX) || defined (S_SPLINT_S)
|
||||
typedef unsigned long uint32_t;
|
||||
# define UINT32_C(v) v ## UL
|
||||
# ifndef PRINTF_INT32_MODIFIER
|
||||
# define PRINTF_INT32_MODIFIER "l"
|
||||
# endif
|
||||
#elif (UINT_MAX == UINT32_MAX)
|
||||
typedef unsigned int uint32_t;
|
||||
# ifndef PRINTF_INT32_MODIFIER
|
||||
# define PRINTF_INT32_MODIFIER ""
|
||||
# endif
|
||||
# define UINT32_C(v) v ## U
|
||||
#elif (USHRT_MAX == UINT32_MAX)
|
||||
typedef unsigned short uint32_t;
|
||||
# define UINT32_C(v) ((unsigned short) (v))
|
||||
# ifndef PRINTF_INT32_MODIFIER
|
||||
# define PRINTF_INT32_MODIFIER ""
|
||||
# endif
|
||||
#else
|
||||
#error "Platform not supported"
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifndef INT32_MAX
|
||||
# define INT32_MAX (0x7fffffffL)
|
||||
#endif
|
||||
#ifndef INT32_MIN
|
||||
# define INT32_MIN INT32_C(0x80000000)
|
||||
#endif
|
||||
#if !defined(int32_t) && !defined(_INT32_T) && !defined(vxWorks)
|
||||
#if (LONG_MAX == INT32_MAX) || defined (S_SPLINT_S)
|
||||
typedef signed long int32_t;
|
||||
# define INT32_C(v) v ## L
|
||||
# ifndef PRINTF_INT32_MODIFIER
|
||||
# define PRINTF_INT32_MODIFIER "l"
|
||||
# endif
|
||||
#elif (INT_MAX == INT32_MAX)
|
||||
typedef signed int int32_t;
|
||||
# define INT32_C(v) v
|
||||
# ifndef PRINTF_INT32_MODIFIER
|
||||
# define PRINTF_INT32_MODIFIER ""
|
||||
# endif
|
||||
#elif (SHRT_MAX == INT32_MAX)
|
||||
typedef signed short int32_t;
|
||||
# define INT32_C(v) ((short) (v))
|
||||
# ifndef PRINTF_INT32_MODIFIER
|
||||
# define PRINTF_INT32_MODIFIER ""
|
||||
# endif
|
||||
#else
|
||||
#error "Platform not supported"
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* The macro stdint_int64_defined is temporarily used to record
|
||||
* whether or not 64 integer support is available. It must be
|
||||
* defined for any 64 integer extensions for new platforms that are
|
||||
* added.
|
||||
*/
|
||||
|
||||
#undef stdint_int64_defined
|
||||
#if (defined(__STDC__) && defined(__STDC_VERSION__)) || defined (S_SPLINT_S)
|
||||
# if (__STDC__ && __STDC_VERSION__ >= 199901L) || defined (S_SPLINT_S)
|
||||
# define stdint_int64_defined
|
||||
typedef long long int64_t;
|
||||
typedef unsigned long long uint64_t;
|
||||
# define UINT64_C(v) v ## ULL
|
||||
# define INT64_C(v) v ## LL
|
||||
# ifndef PRINTF_INT64_MODIFIER
|
||||
# define PRINTF_INT64_MODIFIER "ll"
|
||||
# endif
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if !defined (stdint_int64_defined)
|
||||
# if defined(__GNUC__) && !defined(vxWorks)
|
||||
# define stdint_int64_defined
|
||||
__extension__ typedef long long int64_t;
|
||||
__extension__ typedef unsigned long long uint64_t;
|
||||
# define UINT64_C(v) v ## ULL
|
||||
# define INT64_C(v) v ## LL
|
||||
# ifndef PRINTF_INT64_MODIFIER
|
||||
# define PRINTF_INT64_MODIFIER "ll"
|
||||
# endif
|
||||
# elif defined(__MWERKS__) || defined (__SUNPRO_C) || defined (__SUNPRO_CC) || defined (__APPLE_CC__) || defined (_LONG_LONG) || defined (_CRAYC) || defined (S_SPLINT_S)
|
||||
# define stdint_int64_defined
|
||||
typedef long long int64_t;
|
||||
typedef unsigned long long uint64_t;
|
||||
# define UINT64_C(v) v ## ULL
|
||||
# define INT64_C(v) v ## LL
|
||||
# ifndef PRINTF_INT64_MODIFIER
|
||||
# define PRINTF_INT64_MODIFIER "ll"
|
||||
# endif
|
||||
# elif (defined(__WATCOMC__) && defined(__WATCOM_INT64__)) || (defined(_MSC_VER) && _INTEGRAL_MAX_BITS >= 64) || (defined (__BORLANDC__) && __BORLANDC__ > 0x460) || defined (__alpha) || defined (__DECC)
|
||||
# define stdint_int64_defined
|
||||
typedef __int64 int64_t;
|
||||
typedef unsigned __int64 uint64_t;
|
||||
# define UINT64_C(v) v ## UI64
|
||||
# define INT64_C(v) v ## I64
|
||||
# ifndef PRINTF_INT64_MODIFIER
|
||||
# define PRINTF_INT64_MODIFIER "I64"
|
||||
# endif
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if !defined (LONG_LONG_MAX) && defined (INT64_C)
|
||||
# define LONG_LONG_MAX INT64_C (9223372036854775807)
|
||||
#endif
|
||||
#ifndef ULONG_LONG_MAX
|
||||
# define ULONG_LONG_MAX UINT64_C (18446744073709551615)
|
||||
#endif
|
||||
|
||||
#if !defined (INT64_MAX) && defined (INT64_C)
|
||||
# define INT64_MAX INT64_C (9223372036854775807)
|
||||
#endif
|
||||
#if !defined (INT64_MIN) && defined (INT64_C)
|
||||
# define INT64_MIN INT64_C (-9223372036854775808)
|
||||
#endif
|
||||
#if !defined (UINT64_MAX) && defined (INT64_C)
|
||||
# define UINT64_MAX UINT64_C (18446744073709551615)
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Width of hexadecimal for number field.
|
||||
*/
|
||||
|
||||
#ifndef PRINTF_INT64_HEX_WIDTH
|
||||
# define PRINTF_INT64_HEX_WIDTH "16"
|
||||
#endif
|
||||
#ifndef PRINTF_INT32_HEX_WIDTH
|
||||
# define PRINTF_INT32_HEX_WIDTH "8"
|
||||
#endif
|
||||
#ifndef PRINTF_INT16_HEX_WIDTH
|
||||
# define PRINTF_INT16_HEX_WIDTH "4"
|
||||
#endif
|
||||
#ifndef PRINTF_INT8_HEX_WIDTH
|
||||
# define PRINTF_INT8_HEX_WIDTH "2"
|
||||
#endif
|
||||
#ifndef PRINTF_INT64_DEC_WIDTH
|
||||
# define PRINTF_INT64_DEC_WIDTH "19"
|
||||
#endif
|
||||
#ifndef PRINTF_INT32_DEC_WIDTH
|
||||
# define PRINTF_INT32_DEC_WIDTH "10"
|
||||
#endif
|
||||
#ifndef PRINTF_INT16_DEC_WIDTH
|
||||
# define PRINTF_INT16_DEC_WIDTH "5"
|
||||
#endif
|
||||
#ifndef PRINTF_INT8_DEC_WIDTH
|
||||
# define PRINTF_INT8_DEC_WIDTH "3"
|
||||
#endif
|
||||
#ifndef PRINTF_UINT64_DEC_WIDTH
|
||||
# define PRINTF_UINT64_DEC_WIDTH "20"
|
||||
#endif
|
||||
#ifndef PRINTF_UINT32_DEC_WIDTH
|
||||
# define PRINTF_UINT32_DEC_WIDTH "10"
|
||||
#endif
|
||||
#ifndef PRINTF_UINT16_DEC_WIDTH
|
||||
# define PRINTF_UINT16_DEC_WIDTH "5"
|
||||
#endif
|
||||
#ifndef PRINTF_UINT8_DEC_WIDTH
|
||||
# define PRINTF_UINT8_DEC_WIDTH "3"
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Ok, lets not worry about 128 bit integers for now. Moore's law says
|
||||
* we don't need to worry about that until about 2040 at which point
|
||||
* we'll have bigger things to worry about.
|
||||
*/
|
||||
|
||||
#ifdef stdint_int64_defined
|
||||
typedef int64_t intmax_t;
|
||||
typedef uint64_t uintmax_t;
|
||||
# define INTMAX_MAX INT64_MAX
|
||||
# define INTMAX_MIN INT64_MIN
|
||||
# define UINTMAX_MAX UINT64_MAX
|
||||
# define UINTMAX_C(v) UINT64_C(v)
|
||||
# define INTMAX_C(v) INT64_C(v)
|
||||
# ifndef PRINTF_INTMAX_MODIFIER
|
||||
# define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
|
||||
# endif
|
||||
# ifndef PRINTF_INTMAX_HEX_WIDTH
|
||||
# define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT64_HEX_WIDTH
|
||||
# endif
|
||||
# ifndef PRINTF_INTMAX_DEC_WIDTH
|
||||
# define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT64_DEC_WIDTH
|
||||
# endif
|
||||
#else
|
||||
typedef int32_t intmax_t;
|
||||
typedef uint32_t uintmax_t;
|
||||
# define INTMAX_MAX INT32_MAX
|
||||
# define UINTMAX_MAX UINT32_MAX
|
||||
# define UINTMAX_C(v) UINT32_C(v)
|
||||
# define INTMAX_C(v) INT32_C(v)
|
||||
# ifndef PRINTF_INTMAX_MODIFIER
|
||||
# define PRINTF_INTMAX_MODIFIER PRINTF_INT32_MODIFIER
|
||||
# endif
|
||||
# ifndef PRINTF_INTMAX_HEX_WIDTH
|
||||
# define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT32_HEX_WIDTH
|
||||
# endif
|
||||
# ifndef PRINTF_INTMAX_DEC_WIDTH
|
||||
# define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT32_DEC_WIDTH
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Because this file currently only supports platforms which have
|
||||
* precise powers of 2 as bit sizes for the default integers, the
|
||||
* least definitions are all trivial. Its possible that a future
|
||||
* version of this file could have different definitions.
|
||||
*/
|
||||
|
||||
#ifndef stdint_least_defined
|
||||
typedef int8_t int_least8_t;
|
||||
typedef uint8_t uint_least8_t;
|
||||
typedef int16_t int_least16_t;
|
||||
typedef uint16_t uint_least16_t;
|
||||
typedef int32_t int_least32_t;
|
||||
typedef uint32_t uint_least32_t;
|
||||
# define PRINTF_LEAST32_MODIFIER PRINTF_INT32_MODIFIER
|
||||
# define PRINTF_LEAST16_MODIFIER PRINTF_INT16_MODIFIER
|
||||
# define UINT_LEAST8_MAX UINT8_MAX
|
||||
# define INT_LEAST8_MAX INT8_MAX
|
||||
# define UINT_LEAST16_MAX UINT16_MAX
|
||||
# define INT_LEAST16_MAX INT16_MAX
|
||||
# define UINT_LEAST32_MAX UINT32_MAX
|
||||
# define INT_LEAST32_MAX INT32_MAX
|
||||
# define INT_LEAST8_MIN INT8_MIN
|
||||
# define INT_LEAST16_MIN INT16_MIN
|
||||
# define INT_LEAST32_MIN INT32_MIN
|
||||
# ifdef stdint_int64_defined
|
||||
typedef int64_t int_least64_t;
|
||||
typedef uint64_t uint_least64_t;
|
||||
# define PRINTF_LEAST64_MODIFIER PRINTF_INT64_MODIFIER
|
||||
# define UINT_LEAST64_MAX UINT64_MAX
|
||||
# define INT_LEAST64_MAX INT64_MAX
|
||||
# define INT_LEAST64_MIN INT64_MIN
|
||||
# endif
|
||||
#endif
|
||||
#undef stdint_least_defined
|
||||
|
||||
/*
|
||||
* The ANSI C committee has defined *int*_fast*_t types as well. This,
|
||||
* of course, defies rationality -- you can't know what will be fast
|
||||
* just from the type itself. Even for a given architecture, compatible
|
||||
* implementations might have different performance characteristics.
|
||||
* Developers are warned to stay away from these types when using this
|
||||
* or any other stdint.h.
|
||||
*/
|
||||
|
||||
typedef int_least8_t int_fast8_t;
|
||||
typedef uint_least8_t uint_fast8_t;
|
||||
typedef int_least16_t int_fast16_t;
|
||||
typedef uint_least16_t uint_fast16_t;
|
||||
typedef int_least32_t int_fast32_t;
|
||||
typedef uint_least32_t uint_fast32_t;
|
||||
#define UINT_FAST8_MAX UINT_LEAST8_MAX
|
||||
#define INT_FAST8_MAX INT_LEAST8_MAX
|
||||
#define UINT_FAST16_MAX UINT_LEAST16_MAX
|
||||
#define INT_FAST16_MAX INT_LEAST16_MAX
|
||||
#define UINT_FAST32_MAX UINT_LEAST32_MAX
|
||||
#define INT_FAST32_MAX INT_LEAST32_MAX
|
||||
#define INT_FAST8_MIN INT_LEAST8_MIN
|
||||
#define INT_FAST16_MIN INT_LEAST16_MIN
|
||||
#define INT_FAST32_MIN INT_LEAST32_MIN
|
||||
#ifdef stdint_int64_defined
|
||||
typedef int_least64_t int_fast64_t;
|
||||
typedef uint_least64_t uint_fast64_t;
|
||||
# define UINT_FAST64_MAX UINT_LEAST64_MAX
|
||||
# define INT_FAST64_MAX INT_LEAST64_MAX
|
||||
# define INT_FAST64_MIN INT_LEAST64_MIN
|
||||
#endif
|
||||
|
||||
#undef stdint_int64_defined
|
||||
|
||||
/*
|
||||
* Whatever piecemeal, per compiler thing we can do about the wchar_t
|
||||
* type limits.
|
||||
*/
|
||||
|
||||
#if defined(__WATCOMC__) || defined(_MSC_VER) || defined (__GNUC__) && !defined(vxWorks)
|
||||
# include <wchar.h>
|
||||
# ifndef WCHAR_MIN
|
||||
# define WCHAR_MIN 0
|
||||
# endif
|
||||
# ifndef WCHAR_MAX
|
||||
# define WCHAR_MAX ((wchar_t)-1)
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Whatever piecemeal, per compiler/platform thing we can do about the
|
||||
* (u)intptr_t types and limits.
|
||||
*/
|
||||
|
||||
#if (defined (_MSC_VER) && defined (_UINTPTR_T_DEFINED)) || defined (_UINTPTR_T)
|
||||
# define STDINT_H_UINTPTR_T_DEFINED
|
||||
#endif
|
||||
|
||||
#ifndef STDINT_H_UINTPTR_T_DEFINED
|
||||
# if defined (__alpha__) || defined (__ia64__) || defined (__x86_64__) || defined (_WIN64) || defined (__ppc64__)
|
||||
# define stdint_intptr_bits 64
|
||||
# elif defined (__WATCOMC__) || defined (__TURBOC__)
|
||||
# if defined(__TINY__) || defined(__SMALL__) || defined(__MEDIUM__)
|
||||
# define stdint_intptr_bits 16
|
||||
# else
|
||||
# define stdint_intptr_bits 32
|
||||
# endif
|
||||
# elif defined (__i386__) || defined (_WIN32) || defined (WIN32) || defined (__ppc64__)
|
||||
# define stdint_intptr_bits 32
|
||||
# elif defined (__INTEL_COMPILER)
|
||||
/* TODO -- what did Intel do about x86-64? */
|
||||
# else
|
||||
/* #error "This platform might not be supported yet" */
|
||||
# endif
|
||||
|
||||
# ifdef stdint_intptr_bits
|
||||
# define stdint_intptr_glue3_i(a,b,c) a##b##c
|
||||
# define stdint_intptr_glue3(a,b,c) stdint_intptr_glue3_i(a,b,c)
|
||||
# ifndef PRINTF_INTPTR_MODIFIER
|
||||
# define PRINTF_INTPTR_MODIFIER stdint_intptr_glue3(PRINTF_INT,stdint_intptr_bits,_MODIFIER)
|
||||
# endif
|
||||
# ifndef PTRDIFF_MAX
|
||||
# define PTRDIFF_MAX stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
|
||||
# endif
|
||||
# ifndef PTRDIFF_MIN
|
||||
# define PTRDIFF_MIN stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
|
||||
# endif
|
||||
# ifndef UINTPTR_MAX
|
||||
# define UINTPTR_MAX stdint_intptr_glue3(UINT,stdint_intptr_bits,_MAX)
|
||||
# endif
|
||||
# ifndef INTPTR_MAX
|
||||
# define INTPTR_MAX stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
|
||||
# endif
|
||||
# ifndef INTPTR_MIN
|
||||
# define INTPTR_MIN stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
|
||||
# endif
|
||||
# ifndef INTPTR_C
|
||||
# define INTPTR_C(x) stdint_intptr_glue3(INT,stdint_intptr_bits,_C)(x)
|
||||
# endif
|
||||
# ifndef UINTPTR_C
|
||||
# define UINTPTR_C(x) stdint_intptr_glue3(UINT,stdint_intptr_bits,_C)(x)
|
||||
# endif
|
||||
typedef stdint_intptr_glue3(uint,stdint_intptr_bits,_t) uintptr_t;
|
||||
typedef stdint_intptr_glue3( int,stdint_intptr_bits,_t) intptr_t;
|
||||
# else
|
||||
/* TODO -- This following is likely wrong for some platforms, and does
|
||||
nothing for the definition of uintptr_t. */
|
||||
typedef ptrdiff_t intptr_t;
|
||||
# endif
|
||||
# define STDINT_H_UINTPTR_T_DEFINED
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Assumes sig_atomic_t is signed and we have a 2s complement machine.
|
||||
*/
|
||||
|
||||
#ifndef SIG_ATOMIC_MAX
|
||||
# define SIG_ATOMIC_MAX ((((sig_atomic_t) 1) << (sizeof (sig_atomic_t)*CHAR_BIT-1)) - 1)
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
#if defined (__TEST_PSTDINT_FOR_CORRECTNESS)
|
||||
|
||||
/*
|
||||
* Please compile with the maximum warning settings to make sure macros are
|
||||
* not defined more than once.
|
||||
*/
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#define glue3_aux(x,y,z) x ## y ## z
|
||||
#define glue3(x,y,z) glue3_aux(x,y,z)
|
||||
|
||||
#define DECLU(bits) glue3(uint,bits,_t) glue3(u,bits,) = glue3(UINT,bits,_C) (0);
|
||||
#define DECLI(bits) glue3(int,bits,_t) glue3(i,bits,) = glue3(INT,bits,_C) (0);
|
||||
|
||||
#define DECL(us,bits) glue3(DECL,us,) (bits)
|
||||
|
||||
#define TESTUMAX(bits) glue3(u,bits,) = ~glue3(u,bits,); if (glue3(UINT,bits,_MAX) != glue3(u,bits,)) printf ("Something wrong with UINT%d_MAX\n", bits)
|
||||
|
||||
#define REPORTERROR(msg) { err_n++; if (err_first <= 0) err_first = __LINE__; printf msg; }
|
||||
|
||||
#define X_SIZE_MAX ((size_t)-1)
|
||||
|
||||
int main () {
|
||||
int err_n = 0;
|
||||
int err_first = 0;
|
||||
DECL(I,8)
|
||||
DECL(U,8)
|
||||
DECL(I,16)
|
||||
DECL(U,16)
|
||||
DECL(I,32)
|
||||
DECL(U,32)
|
||||
#ifdef INT64_MAX
|
||||
DECL(I,64)
|
||||
DECL(U,64)
|
||||
#endif
|
||||
intmax_t imax = INTMAX_C(0);
|
||||
uintmax_t umax = UINTMAX_C(0);
|
||||
char str0[256], str1[256];
|
||||
|
||||
sprintf (str0, "%" PRINTF_INT32_MODIFIER "d", INT32_C(2147483647));
|
||||
if (0 != strcmp (str0, "2147483647")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
|
||||
if (atoi(PRINTF_INT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_INT32_DEC_WIDTH : %s\n", PRINTF_INT32_DEC_WIDTH));
|
||||
sprintf (str0, "%" PRINTF_INT32_MODIFIER "u", UINT32_C(4294967295));
|
||||
if (0 != strcmp (str0, "4294967295")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
|
||||
if (atoi(PRINTF_UINT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_UINT32_DEC_WIDTH : %s\n", PRINTF_UINT32_DEC_WIDTH));
|
||||
#ifdef INT64_MAX
|
||||
sprintf (str1, "%" PRINTF_INT64_MODIFIER "d", INT64_C(9223372036854775807));
|
||||
if (0 != strcmp (str1, "9223372036854775807")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
|
||||
if (atoi(PRINTF_INT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_INT64_DEC_WIDTH : %s, %d\n", PRINTF_INT64_DEC_WIDTH, (int) strlen(str1)));
|
||||
sprintf (str1, "%" PRINTF_INT64_MODIFIER "u", UINT64_C(18446744073709550591));
|
||||
if (0 != strcmp (str1, "18446744073709550591")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
|
||||
if (atoi(PRINTF_UINT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_UINT64_DEC_WIDTH : %s, %d\n", PRINTF_UINT64_DEC_WIDTH, (int) strlen(str1)));
|
||||
#endif
|
||||
|
||||
sprintf (str0, "%d %x\n", 0, ~0);
|
||||
|
||||
sprintf (str1, "%d %x\n", i8, ~0);
|
||||
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i8 : %s\n", str1));
|
||||
sprintf (str1, "%u %x\n", u8, ~0);
|
||||
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u8 : %s\n", str1));
|
||||
sprintf (str1, "%d %x\n", i16, ~0);
|
||||
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i16 : %s\n", str1));
|
||||
sprintf (str1, "%u %x\n", u16, ~0);
|
||||
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u16 : %s\n", str1));
|
||||
sprintf (str1, "%" PRINTF_INT32_MODIFIER "d %x\n", i32, ~0);
|
||||
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i32 : %s\n", str1));
|
||||
sprintf (str1, "%" PRINTF_INT32_MODIFIER "u %x\n", u32, ~0);
|
||||
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u32 : %s\n", str1));
|
||||
#ifdef INT64_MAX
|
||||
sprintf (str1, "%" PRINTF_INT64_MODIFIER "d %x\n", i64, ~0);
|
||||
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i64 : %s\n", str1));
|
||||
#endif
|
||||
sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "d %x\n", imax, ~0);
|
||||
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with imax : %s\n", str1));
|
||||
sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "u %x\n", umax, ~0);
|
||||
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with umax : %s\n", str1));
|
||||
|
||||
TESTUMAX(8);
|
||||
TESTUMAX(16);
|
||||
TESTUMAX(32);
|
||||
#ifdef INT64_MAX
|
||||
TESTUMAX(64);
|
||||
#endif
|
||||
|
||||
#define STR(v) #v
|
||||
#define Q(v) printf ("sizeof " STR(v) " = %u\n", (unsigned) sizeof (v));
|
||||
if (err_n) {
|
||||
printf ("pstdint.h is not correct. Please use sizes below to correct it:\n");
|
||||
}
|
||||
|
||||
Q(int)
|
||||
Q(unsigned)
|
||||
Q(long int)
|
||||
Q(short int)
|
||||
Q(int8_t)
|
||||
Q(int16_t)
|
||||
Q(int32_t)
|
||||
#ifdef INT64_MAX
|
||||
Q(int64_t)
|
||||
#endif
|
||||
|
||||
#if UINT_MAX < X_SIZE_MAX
|
||||
printf ("UINT_MAX < X_SIZE_MAX\n");
|
||||
#else
|
||||
printf ("UINT_MAX >= X_SIZE_MAX\n");
|
||||
#endif
|
||||
printf ("%" PRINTF_INT64_MODIFIER "u vs %" PRINTF_INT64_MODIFIER "u\n", UINT_MAX, X_SIZE_MAX);
|
||||
|
||||
return EXIT_SUCCESS;
|
||||
}
|
||||
|
||||
#endif
|
||||
@@ -0,0 +1,39 @@
|
||||
/*
|
||||
* stdlib.h --
|
||||
*
|
||||
* Declares facilities exported by the "stdlib" portion of the C library.
|
||||
* This file isn't complete in the ANSI-C sense; it only declares things
|
||||
* that are needed by Tcl. This file is needed even on many systems with
|
||||
* their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare
|
||||
* all the procedures needed here (such as strtol/strtoul).
|
||||
*
|
||||
* Copyright (c) 1991 The Regents of the University of California.
|
||||
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#ifndef _STDLIB
|
||||
#define _STDLIB
|
||||
|
||||
extern void abort(void);
|
||||
extern double atof(const char *string);
|
||||
extern int atoi(const char *string);
|
||||
extern long atol(const char *string);
|
||||
extern void * calloc(unsigned long numElements, unsigned long size);
|
||||
extern void exit(int status);
|
||||
extern void free(void *blockPtr);
|
||||
extern char * getenv(const char *name);
|
||||
extern void * malloc(unsigned long numBytes);
|
||||
extern void qsort(void *base, unsigned long n, unsigned long size, int (*compar)(
|
||||
const void *element1, const void *element2));
|
||||
extern void * realloc(void *ptr, unsigned long numBytes);
|
||||
extern char * realpath(const char *path, char *resolved_path);
|
||||
extern int mkstemps(char *templ, int suffixlen);
|
||||
extern int mkstemp(char *templ);
|
||||
extern char * mkdtemp(char *templ);
|
||||
extern long strtol(const char *string, char **endPtr, int base);
|
||||
extern unsigned long strtoul(const char *string, char **endPtr, int base);
|
||||
|
||||
#endif /* _STDLIB */
|
||||
@@ -0,0 +1,70 @@
|
||||
/*
|
||||
* strstr.c --
|
||||
*
|
||||
* Source code for the "strstr" library routine.
|
||||
*
|
||||
* Copyright (c) 1988-1993 The Regents of the University of California.
|
||||
* Copyright (c) 1994 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include "tcl.h"
|
||||
#ifndef NULL
|
||||
#define NULL 0
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* strstr --
|
||||
*
|
||||
* Locate the first instance of a substring in a string.
|
||||
*
|
||||
* Results:
|
||||
* If string contains substring, the return value is the location of the
|
||||
* first matching instance of substring in string. If string doesn't
|
||||
* contain substring, the return value is 0. Matching is done on an exact
|
||||
* character-for-character basis with no wildcards or special characters.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
char *
|
||||
strstr(
|
||||
const char *string, /* String to search. */
|
||||
const char *substring) /* Substring to try to find in string. */
|
||||
{
|
||||
const char *a, *b;
|
||||
|
||||
/*
|
||||
* First scan quickly through the two strings looking for a
|
||||
* single-character match. When it's found, then compare the rest of the
|
||||
* substring.
|
||||
*/
|
||||
|
||||
b = substring;
|
||||
if (*b == 0) {
|
||||
return (char *)string;
|
||||
}
|
||||
for ( ; *string != 0; string += 1) {
|
||||
if (*string != *b) {
|
||||
continue;
|
||||
}
|
||||
a = string;
|
||||
while (1) {
|
||||
if (*b == 0) {
|
||||
return (char *)string;
|
||||
}
|
||||
if (*a++ != *b++) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
b = substring;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
@@ -0,0 +1,77 @@
|
||||
/*
|
||||
* strtol.c --
|
||||
*
|
||||
* Source code for the "strtol" library procedure.
|
||||
*
|
||||
* Copyright (c) 1988 The Regents of the University of California.
|
||||
* Copyright (c) 1994 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* strtol --
|
||||
*
|
||||
* Convert an ASCII string into an integer.
|
||||
*
|
||||
* Results:
|
||||
* The return value is the integer equivalent of string. If endPtr is
|
||||
* non-NULL, then *endPtr is filled in with the character after the last
|
||||
* one that was part of the integer. If string doesn't contain a valid
|
||||
* integer value, then zero is returned and *endPtr is set to string.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
long int
|
||||
strtol(
|
||||
const char *string, /* String of ASCII digits, possibly preceded
|
||||
* by white space. For bases greater than 10,
|
||||
* either lower- or upper-case digits may be
|
||||
* used. */
|
||||
char **endPtr, /* Where to store address of terminating
|
||||
* character, or NULL. */
|
||||
int base) /* Base for conversion. Must be less than 37.
|
||||
* If 0, then the base is chosen from the
|
||||
* leading characters of string: "0x" means
|
||||
* hex, "0" means octal, anything else means
|
||||
* decimal. */
|
||||
{
|
||||
const char *p;
|
||||
long result;
|
||||
|
||||
/*
|
||||
* Skip any leading blanks.
|
||||
*/
|
||||
|
||||
p = string;
|
||||
while (isspace(UCHAR(*p))) {
|
||||
p += 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* Check for a sign.
|
||||
*/
|
||||
|
||||
if (*p == '-') {
|
||||
p += 1;
|
||||
result = -(strtoul(p, endPtr, base));
|
||||
} else {
|
||||
if (*p == '+') {
|
||||
p += 1;
|
||||
}
|
||||
result = strtoul(p, endPtr, base);
|
||||
}
|
||||
if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
|
||||
*endPtr = (char *) string;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
@@ -0,0 +1,214 @@
|
||||
/*
|
||||
* strtoul.c --
|
||||
*
|
||||
* Source code for the "strtoul" library procedure.
|
||||
*
|
||||
* Copyright (c) 1988 The Regents of the University of California.
|
||||
* Copyright (c) 1994 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
/*
|
||||
* The table below is used to convert from ASCII digits to a numerical
|
||||
* equivalent. It maps from '0' through 'z' to integers (100 for non-digit
|
||||
* characters).
|
||||
*/
|
||||
|
||||
static const char cvtIn[] = {
|
||||
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, /* '0' - '9' */
|
||||
100, 100, 100, 100, 100, 100, 100, /* punctuation */
|
||||
10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'A' - 'Z' */
|
||||
20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
|
||||
30, 31, 32, 33, 34, 35,
|
||||
100, 100, 100, 100, 100, 100, /* punctuation */
|
||||
10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'a' - 'z' */
|
||||
20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
|
||||
30, 31, 32, 33, 34, 35};
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* strtoul --
|
||||
*
|
||||
* Convert an ASCII string into an integer.
|
||||
*
|
||||
* Results:
|
||||
* The return value is the integer equivalent of string. If endPtr is
|
||||
* non-NULL, then *endPtr is filled in with the character after the last
|
||||
* one that was part of the integer. If string doesn't contain a valid
|
||||
* integer value, then zero is returned and *endPtr is set to string.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
unsigned long int
|
||||
strtoul(
|
||||
const char *string, /* String of ASCII digits, possibly preceded
|
||||
* by white space. For bases greater than 10,
|
||||
* either lower- or upper-case digits may be
|
||||
* used. */
|
||||
char **endPtr, /* Where to store address of terminating
|
||||
* character, or NULL. */
|
||||
int base) /* Base for conversion. Must be less than 37.
|
||||
* If 0, then the base is chosen from the
|
||||
* leading characters of string: "0x" means
|
||||
* hex, "0" means octal, anything else means
|
||||
* decimal. */
|
||||
{
|
||||
const char *p;
|
||||
unsigned long int result = 0;
|
||||
unsigned digit;
|
||||
int anyDigits = 0;
|
||||
int negative=0;
|
||||
int overflow=0;
|
||||
|
||||
/*
|
||||
* Skip any leading blanks.
|
||||
*/
|
||||
|
||||
p = string;
|
||||
while (isspace(UCHAR(*p))) {
|
||||
p += 1;
|
||||
}
|
||||
if (*p == '-') {
|
||||
negative = 1;
|
||||
p += 1;
|
||||
} else {
|
||||
if (*p == '+') {
|
||||
p += 1;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* If no base was provided, pick one from the leading characters of the
|
||||
* string.
|
||||
*/
|
||||
|
||||
if (base == 0) {
|
||||
if (*p == '0') {
|
||||
p += 1;
|
||||
if ((*p == 'x') || (*p == 'X')) {
|
||||
p += 1;
|
||||
base = 16;
|
||||
} else {
|
||||
/*
|
||||
* Must set anyDigits here, otherwise "0" produces a "no
|
||||
* digits" error.
|
||||
*/
|
||||
|
||||
anyDigits = 1;
|
||||
base = 8;
|
||||
}
|
||||
} else {
|
||||
base = 10;
|
||||
}
|
||||
} else if (base == 16) {
|
||||
/*
|
||||
* Skip a leading "0x" from hex numbers.
|
||||
*/
|
||||
|
||||
if ((p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
|
||||
p += 2;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Sorry this code is so messy, but speed seems important. Do different
|
||||
* things for base 8, 10, 16, and other.
|
||||
*/
|
||||
|
||||
if (base == 8) {
|
||||
unsigned long maxres = ULONG_MAX >> 3;
|
||||
|
||||
for ( ; ; p += 1) {
|
||||
digit = *p - '0';
|
||||
if (digit > 7) {
|
||||
break;
|
||||
}
|
||||
if (result > maxres) { overflow = 1; }
|
||||
result = (result << 3);
|
||||
if (digit > (ULONG_MAX - result)) { overflow = 1; }
|
||||
result += digit;
|
||||
anyDigits = 1;
|
||||
}
|
||||
} else if (base == 10) {
|
||||
unsigned long maxres = ULONG_MAX / 10;
|
||||
|
||||
for ( ; ; p += 1) {
|
||||
digit = *p - '0';
|
||||
if (digit > 9) {
|
||||
break;
|
||||
}
|
||||
if (result > maxres) { overflow = 1; }
|
||||
result *= 10;
|
||||
if (digit > (ULONG_MAX - result)) { overflow = 1; }
|
||||
result += digit;
|
||||
anyDigits = 1;
|
||||
}
|
||||
} else if (base == 16) {
|
||||
unsigned long maxres = ULONG_MAX >> 4;
|
||||
|
||||
for ( ; ; p += 1) {
|
||||
digit = *p - '0';
|
||||
if (digit > ('z' - '0')) {
|
||||
break;
|
||||
}
|
||||
digit = cvtIn[digit];
|
||||
if (digit > 15) {
|
||||
break;
|
||||
}
|
||||
if (result > maxres) { overflow = 1; }
|
||||
result = (result << 4);
|
||||
if (digit > (ULONG_MAX - result)) { overflow = 1; }
|
||||
result += digit;
|
||||
anyDigits = 1;
|
||||
}
|
||||
} else if (base >= 2 && base <= 36) {
|
||||
unsigned long maxres = ULONG_MAX / base;
|
||||
|
||||
for ( ; ; p += 1) {
|
||||
digit = *p - '0';
|
||||
if (digit > ('z' - '0')) {
|
||||
break;
|
||||
}
|
||||
digit = cvtIn[digit];
|
||||
if (digit >= ( (unsigned) base )) {
|
||||
break;
|
||||
}
|
||||
if (result > maxres) { overflow = 1; }
|
||||
result *= base;
|
||||
if (digit > (ULONG_MAX - result)) { overflow = 1; }
|
||||
result += digit;
|
||||
anyDigits = 1;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* See if there were any digits at all.
|
||||
*/
|
||||
|
||||
if (!anyDigits) {
|
||||
p = string;
|
||||
}
|
||||
|
||||
if (endPtr != 0) {
|
||||
/* unsafe, but required by the strtoul prototype */
|
||||
*endPtr = (char *) p;
|
||||
}
|
||||
|
||||
if (overflow) {
|
||||
errno = ERANGE;
|
||||
return ULONG_MAX;
|
||||
}
|
||||
if (negative) {
|
||||
return -result;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
Regular → Executable
+1
-1
@@ -32,7 +32,7 @@ void
|
||||
\fBTcl_GetMemoryInfo\fR(\fIdsPtr\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS char *size
|
||||
.AP "size_t" size in
|
||||
.AP "unsigned int" size in
|
||||
Size in bytes of the memory block to allocate.
|
||||
.AP char *ptr in
|
||||
Pointer to memory block to free or realloc.
|
||||
|
||||
+1
-1
@@ -9,7 +9,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult, Tcl_DStringToObj \- manipulate dynamic strings
|
||||
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
|
||||
+14
-13
@@ -218,16 +218,17 @@ used. The return value is a pointer to the value stored in the DString.
|
||||
be used to specify the profile to be used for the transform. The
|
||||
\fBTCL_ENCODING_START\fR and \fBTCL_ENCODING_END\fR bits in \fBflags\fR are
|
||||
ignored as the function assumes the entire source string to be decoded is passed
|
||||
into the function. On success, the function returns \fBTCL_OK\fR with the
|
||||
converted string stored in \fB*dstPtr\fR. For errors \fIother than conversion
|
||||
errors\fR, such as invalid flags, the function returns \fBTCL_ERROR\fR with an error
|
||||
into the function. On success, the function returns \fBTCL_ERROR\fR with the
|
||||
converted string stored in \fB*dstPtr\fR. For errors other than conversion
|
||||
errors, such as invalid flags, the function returns \fBTCL_OK\fR with an error
|
||||
message in \fBinterp\fR if it is not NULL.
|
||||
.PP
|
||||
For conversion errors, \fBTcl_ExternalToUtfDStringEx\fR returns one
|
||||
of the \fBTCL_CONVERT_*\fR errors listed below for \fBTcl_ExternalToUtf\fR.
|
||||
When one of these conversion errors is returned, an error message is
|
||||
stored in \fBinterp\fR only if \fBerrorIdxPtr\fR is NULL. Otherwise, no error message
|
||||
is stored as the function expects the caller is interested the decoded data
|
||||
up to that point and not treating this as an immediate error condition.
|
||||
is stored as the function expects the caller is interested whatever is
|
||||
decoded to that point and not treating this as an immediate error condition.
|
||||
The index of the error location is stored in \fB*errorIdxPtr\fR.
|
||||
.PP
|
||||
The caller must call \fBTcl_DStringFree\fR to free up the \fB*dstPtr\fR resources
|
||||
@@ -546,13 +547,13 @@ encoding:
|
||||
E
|
||||
init {}
|
||||
final {}
|
||||
iso8859-1 \ex1B(B
|
||||
jis0201 \ex1B(J
|
||||
jis0208 \ex1B$@
|
||||
jis0208 \ex1B$B
|
||||
jis0212 \ex1B$(D
|
||||
gb2312 \ex1B$A
|
||||
ksc5601 \ex1B$(C
|
||||
iso8859-1 \ex1b(B
|
||||
jis0201 \ex1b(J
|
||||
jis0208 \ex1b$@
|
||||
jis0208 \ex1b$B
|
||||
jis0212 \ex1b$(D
|
||||
gb2312 \ex1b$A
|
||||
ksc5601 \ex1b$(C
|
||||
.CE
|
||||
.PP
|
||||
In the file, the first column represents an option and the second column
|
||||
@@ -564,7 +565,7 @@ marks that encoding. Tcl syntax is used for the values; in the above
|
||||
example, for instance,
|
||||
.QW \fB{}\fR
|
||||
represents the empty string and
|
||||
.QW \fB\ex1B\fR
|
||||
.QW \fB\ex1b\fR
|
||||
represents character 27.
|
||||
.PP
|
||||
When \fBTcl_GetEncoding\fR encounters an encoding \fIname\fR that has not
|
||||
|
||||
+25
-46
@@ -23,8 +23,6 @@ Tcl_Obj *
|
||||
.sp
|
||||
\fBTcl_DecrRefCount\fR(\fIobjPtr\fR)
|
||||
.sp
|
||||
\fBTcl_BounceRefCount\fR(\fIobjPtr\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_IsShared\fR(\fIobjPtr\fR)
|
||||
.sp
|
||||
@@ -280,27 +278,26 @@ The string representation is now \fB124\fR
|
||||
and both representations are again valid.
|
||||
.SH "STORAGE MANAGEMENT OF VALUES"
|
||||
.PP
|
||||
Tcl values are allocated on the heap and are shared as much as
|
||||
possible to reduce storage requirements. Reference counting is used
|
||||
to determine when a value is no longer needed and can safely be freed.
|
||||
A value just created by \fBTcl_NewObj\fR, \fBTcl_NewStringObj\fR, or
|
||||
any Abstract List command or function, has \fIrefCount\fR 0, meaning
|
||||
that the object can often be given to a function like
|
||||
\fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or
|
||||
\fBTcl_DictObjPut\fR (as a value) without explicit reference
|
||||
management, all of which are common use cases. (The latter two require
|
||||
that the target list or dictionary be well-formed, but that is
|
||||
often easy to arrange when the value is being initially constructed.)
|
||||
The macro \fBTcl_IncrRefCount\fR increments the reference count when a
|
||||
new reference to the value is created.
|
||||
The macro \fBTcl_DecrRefCount\fR decrements the count when a reference is no longer needed.
|
||||
If the value's reference count drops to zero, frees
|
||||
its storage.
|
||||
The macro \fBTcl_BounceRefCount\fR will check if the value has no references (i.e. in a "new" state) and free the value.
|
||||
Tcl values are allocated on the heap and are shared as much as possible
|
||||
to reduce storage requirements.
|
||||
Reference counting is used to determine when a value is
|
||||
no longer needed and can safely be freed.
|
||||
A value just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR
|
||||
has \fIrefCount\fR 0, meaning that the object can often be given to a function
|
||||
like \fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or
|
||||
\fBTcl_DictObjPut\fR (as a value) without explicit reference management, all
|
||||
of which are common use cases. (The latter two require that the the target
|
||||
list or dictionary be well-formed, but that is often easy to arrange when the
|
||||
value is being initially constructed.)
|
||||
The macro \fBTcl_IncrRefCount\fR increments the reference count
|
||||
when a new reference to the value is created.
|
||||
The macro \fBTcl_DecrRefCount\fR decrements the count
|
||||
when a reference is no longer needed and,
|
||||
if the value's reference count drops to zero, frees its storage.
|
||||
A value shared by different code or data structures has
|
||||
\fIrefCount\fR greater than 1. Incrementing a value's reference count
|
||||
ensures that it will not be freed too early or have its value change
|
||||
accidentally.
|
||||
\fIrefCount\fR greater than 1.
|
||||
Incrementing a value's reference count ensures that
|
||||
it will not be freed too early or have its value change accidentally.
|
||||
.PP
|
||||
As an example, the bytecode interpreter shares argument values
|
||||
between calling and called Tcl procedures to avoid having to copy values.
|
||||
@@ -314,25 +311,12 @@ the interpreter calls \fBTcl_DecrRefCount\fR to decrement
|
||||
each argument's reference count.
|
||||
When a value's reference count drops less than or equal to zero,
|
||||
\fBTcl_DecrRefCount\fR reclaims its storage.
|
||||
|
||||
.PP
|
||||
Most command procedures have not been concerned about reference
|
||||
counting since they use a value's value immediately and do not retain
|
||||
a pointer to the value after they return. However, there are some
|
||||
procedures that may return a new value, with a refCount of 0. In this
|
||||
situation, it is the caller's responsibility to free the value before
|
||||
the procedure returns. One way to cover this is to always call
|
||||
\fBTcl_IncrRefCount\fR before using the value, then call
|
||||
\fBTcl_DecrRefCount\fR before returning. The other way is to use
|
||||
\fBTcl_BounceRefCount\fR after the value is no longer needed or
|
||||
referenced. This macro will free the value if there are no other
|
||||
references to the value. When retaining a pointer to a value in a data
|
||||
structure the procedure must be careful to increment its reference
|
||||
count since the retained pointer is a new reference. Examples of
|
||||
procedures that return new values are \fBTcl_NewIntObj\fR, and
|
||||
commands like \fBlseq\fR, which creates an Abstract List, and an
|
||||
lindex on this list may return a new Obj with a refCount of 0.
|
||||
|
||||
Most command procedures do not have to be concerned about
|
||||
reference counting since they use a value's value immediately
|
||||
and do not retain a pointer to the value after they return.
|
||||
However, if they do retain a pointer to a value in a data structure,
|
||||
they must be careful to increment its reference count
|
||||
since the retained pointer is a new reference.
|
||||
.PP
|
||||
Command procedures that directly modify values
|
||||
such as those for \fBlappend\fR and \fBlinsert\fR must be careful to
|
||||
@@ -366,11 +350,6 @@ must check whether the variable's value is shared before
|
||||
incrementing the integer in its internal representation.
|
||||
If it is shared, it needs to duplicate the value
|
||||
in order to avoid accidentally changing values in other data structures.
|
||||
.PP
|
||||
In cases where a value is obtained, used, and not retained, the value
|
||||
can be freed using \fBTcl_BounceRefCount\fR. This
|
||||
is functionally equivalent to calling \fBTcl_IncrRefCount\fR followed
|
||||
\fBTcl_DecrRefCount\fR.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_ConvertToType(3), Tcl_GetIntFromObj(3), Tcl_ListObjAppendElement(3), Tcl_ListObjIndex(3), Tcl_ListObjReplace(3), Tcl_RegisterObjType(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
+12
-164
@@ -4,7 +4,7 @@
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH Tcl_ObjType 3 9.0 Tcl "Tcl Library Procedures"
|
||||
.TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures"
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
@@ -93,13 +93,14 @@ free to set the internal representation for \fIobjPtr\fR to make
|
||||
use of another related Tcl_ObjType, if it sees fit.
|
||||
.SH "THE TCL_OBJTYPE STRUCTURE"
|
||||
.PP
|
||||
Extension writers can define new value types by defining four to eight
|
||||
procedures and initializing a Tcl_ObjType structure to describe the
|
||||
type. Extension writers may also pass a pointer to their Tcl_ObjType
|
||||
structure to \fBTcl_RegisterObjType\fR if they wish to permit other
|
||||
extensions to look up their Tcl_ObjType by name with the
|
||||
\fBTcl_GetObjType\fR routine. The \fBTcl_ObjType\fR structure is
|
||||
defined as follows:
|
||||
Extension writers can define new value types by defining four
|
||||
procedures and
|
||||
initializing a Tcl_ObjType structure to describe the type.
|
||||
Extension writers may also pass a pointer to their Tcl_ObjType
|
||||
structure to \fBTcl_RegisterObjType\fR if they wish to permit
|
||||
other extensions to look up their Tcl_ObjType by name with
|
||||
the \fBTcl_GetObjType\fR routine.
|
||||
The \fBTcl_ObjType\fR structure is defined as follows:
|
||||
.PP
|
||||
.CS
|
||||
typedef struct Tcl_ObjType {
|
||||
@@ -109,16 +110,6 @@ typedef struct Tcl_ObjType {
|
||||
Tcl_UpdateStringProc *\fIupdateStringProc\fR;
|
||||
Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
|
||||
size_t \fIversion\fR;
|
||||
/* List emulation functions - ObjType Version 1 & 2 */
|
||||
Tcl_ObjTypeLengthProc *lengthProc;
|
||||
/* List emulation functions - ObjType Version 2 */
|
||||
Tcl_ObjTypeIndexProc *\fIindexProc\fR;
|
||||
Tcl_ObjTypeSliceProc *\fIsliceProc\fR;
|
||||
Tcl_ObjTypeReverseProc *\fIreverseProc\fR;
|
||||
Tcl_ObjTypeGetElements *\fIgetElementsProc\fR;
|
||||
Tcl_ObjTypeSetElement *\fIsetElementProc\fR;
|
||||
Tcl_ObjTypeReplaceProc *\fIreplaceProc\fR;
|
||||
Tcl_ObjTypeInOperatorProc *\fIinOperProc\fR;
|
||||
} \fBTcl_ObjType\fR;
|
||||
.CE
|
||||
.SS "THE NAME FIELD"
|
||||
@@ -215,7 +206,6 @@ The \fIdupIntRepProc\fR member contains the address of a function
|
||||
called to copy an internal representation from one value to another.
|
||||
.PP
|
||||
.CS
|
||||
|
||||
typedef void \fBTcl_DupInternalRepProc\fR(
|
||||
Tcl_Obj *\fIsrcPtr\fR,
|
||||
Tcl_Obj *\fIdupPtr\fR);
|
||||
@@ -239,7 +229,6 @@ The \fIfreeIntRepProc\fR member contains the address of a function
|
||||
that is called when a value is freed.
|
||||
.PP
|
||||
.CS
|
||||
|
||||
typedef void \fBTcl_FreeInternalRepProc\fR(
|
||||
Tcl_Obj *\fIobjPtr\fR);
|
||||
.CE
|
||||
@@ -267,149 +256,8 @@ immediately, in order to limit stack usage. However, the value will be freed
|
||||
before the outermost current \fBTcl_DecrRefCount\fR returns.
|
||||
.SS "THE VERSION FIELD"
|
||||
.PP
|
||||
The \fIversion\fR member provides for future extensibility of the
|
||||
structure and should be set to \fBTCL_OBJTYPE_V0\fR for compatability
|
||||
of ObjType definitions prior to version 9.0. Specifics about versions
|
||||
will be described further in the sections below.
|
||||
.SH "ABSTRACT LIST TYPES"
|
||||
.PP
|
||||
Additional fields in the Tcl_ObjType descriptor allow for control over
|
||||
how custom data values can be manipulated using Tcl's List commands
|
||||
without converting the value to a List type. This requires the custom
|
||||
type to provide functions that will perform the given operation on the
|
||||
custom data representation. Not all functions are required. In the
|
||||
absence of a particular function (set to NULL), the fallback is to
|
||||
allow the internal List operation to perform the operation, most
|
||||
likely causing the value type to be converted to a traditional list.
|
||||
.SS "SCALAR VALUE TYPES"
|
||||
.PP
|
||||
For a custom value type that is scalar or atomic in nature, i.e., not
|
||||
a divisible collection, version \fBTCL_OBJTYPE_V1\fR is
|
||||
recommended. In this case, List commands will treat the scalar value
|
||||
as if it where a list of length 1, and not convert the value to a List
|
||||
type.
|
||||
.SS "VERSION 2: ABSTRACT LISTS"
|
||||
.PP
|
||||
Version 2, \fBTCL_OBJTYPE_V2\fR, allows full List support when the
|
||||
functions described below are provided. This allows for script level
|
||||
use of the List commands without causing the type of the Tcl_Obj value
|
||||
to be converted to a list.
|
||||
.SS "THE LENGTHPROC FIELD"
|
||||
.PP
|
||||
The \fBLengthProc\fR function correlates with the \fBTcl_ListObjLength\fR
|
||||
C API. The function returns the number of elements in the list. It
|
||||
is used in every List operation and is required for all Abstract List
|
||||
implementations.
|
||||
.CS
|
||||
|
||||
typedef Tcl_Size
|
||||
(Tcl_ObjTypeLengthProc) (Tcl_Obj *listPtr);
|
||||
.CE
|
||||
|
||||
.PP
|
||||
.SS "THE INDEXPROC FIELD"
|
||||
.PP
|
||||
The \fBIndexProc\fR function correlates with with the
|
||||
\fBTcl_ListObjIndex\fR C API. The function returns a Tcl_Obj value for
|
||||
the element at the specified index.
|
||||
.CS
|
||||
|
||||
typedef int
|
||||
(Tcl_ObjTypeIndexProc) (
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *listPtr,
|
||||
Tcl_Size index,
|
||||
Tcl_Obj** elemObj);
|
||||
.CE
|
||||
.SS "THE SLICEPROC FIELD"
|
||||
.PP
|
||||
The \fBSliceProc\fR correlates with the \fBlrange\fR command,
|
||||
returning a new List or Abstract List for the portion of the original
|
||||
list specifed.
|
||||
.CS
|
||||
|
||||
typedef int
|
||||
(Tcl_ObjTypeSliceProc) (
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *listPtr,
|
||||
Tcl_Size fromIdx,
|
||||
Tcl_Size toIdx,
|
||||
Tcl_Obj **newObjPtr);
|
||||
.CE
|
||||
.SS "THE REVERSEPROC FIELD"
|
||||
.PP
|
||||
The \fBReverseProc\fR correlates with the \fBlreverse\fR command,
|
||||
returning a List or Abstract List that has the same elements as the
|
||||
input Abstract List, with the elements in the reverse order.
|
||||
.CS
|
||||
|
||||
typedef int
|
||||
(Tcl_ObjTypeReverseProc) (
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *listPtr,
|
||||
Tcl_Obj **newObjPtr);
|
||||
.CE
|
||||
.SS "THE GETELEMENTS FIELD"
|
||||
.PP
|
||||
The \fBGetElements\fR function returns a count and a pointer to an
|
||||
array of Tcl_Obj values for the entire Abstract List. This is a
|
||||
correlary to the \fBTcl_ListObjGetElements\fR C API call.
|
||||
.CS
|
||||
|
||||
typedef int
|
||||
(Tcl_ObjTypeGetElements) (
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *listPtr,
|
||||
Tcl_Size *objcptr,
|
||||
Tcl_Obj ***objvptr);
|
||||
.CE
|
||||
.SS "THE SETELEMENT FIELD"
|
||||
.PP
|
||||
The \fBSetElement\fR function replaces the element within the
|
||||
specified list at the give index. This function correlates to the
|
||||
\fBlset\fR command.
|
||||
.CS
|
||||
|
||||
typedef Tcl_Obj*
|
||||
Tcl_ObjTypeSetElement) (
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *listPtr,
|
||||
Tcl_Size indexCount,
|
||||
Tcl_Obj *const indexArray[],
|
||||
Tcl_Obj *valueObj);
|
||||
.CE
|
||||
.SS "REPLACEPROC FIELD"
|
||||
.PP
|
||||
The \fBReplaceProc\fR returns a new list after modfying the list
|
||||
replacing the elements to be deleted, and adding the elements to be
|
||||
inserted. This function correlates to the \fBTcl_ListObjReplace\fR C API.
|
||||
.CS
|
||||
|
||||
typedef int
|
||||
(Tcl_ObjTypeReplaceProc) (
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *listObj,
|
||||
Tcl_Size first,
|
||||
Tcl_Size numToDelete,
|
||||
Tcl_Size numToInsert,
|
||||
Tcl_Obj *const insertObjs[]);
|
||||
.CE
|
||||
.SS "THE INOPERATORPROC FIELD"
|
||||
.PP
|
||||
The \fBInOperProc\fR function determines whether the value is present in the
|
||||
given list, according to equivalent string comparison of elements. The
|
||||
\fBboolResult\fR is set to 1 (true) if the value is present, and 0
|
||||
(false) if it is not present. This function implements the "in" and
|
||||
"ni" math operators for an abstract list.
|
||||
.CS
|
||||
|
||||
typedef int
|
||||
(Tcl_ObjTypeInOperatorProc) (
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *valueObj,
|
||||
Tcl_Obj *listObj,
|
||||
int *boolResult);
|
||||
.CE
|
||||
The \fIversion\fR member provides for future extensibility of the structure
|
||||
and should be set to \fITCL_OBJTYPE_V0\fR.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared
|
||||
@@ -428,6 +276,6 @@ modify the reference count of their arguments, but if the values contain
|
||||
subsidiary values (e.g., the elements of a list or the keys of a dictionary)
|
||||
then those subsidiary values may have their reference counts modified.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_BounceRefCount(3)
|
||||
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3)
|
||||
.SH KEYWORDS
|
||||
internal representation, value, value type, string representation, type conversion
|
||||
|
||||
+2
-2
@@ -47,10 +47,10 @@ int
|
||||
int
|
||||
\fBTcl_Close\fR(\fIinterp, channel\fR)
|
||||
.sp
|
||||
Tcl_Size
|
||||
int
|
||||
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
|
||||
.sp
|
||||
Tcl_Size
|
||||
int
|
||||
\fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
|
||||
.sp
|
||||
Tcl_Size
|
||||
|
||||
@@ -8,7 +8,7 @@
|
||||
.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_WCharToUtfDString, Tcl_WCharLen, Tcl_Char16Len, 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
|
||||
Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharLen, Tcl_Char16Len, 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
|
||||
@@ -28,28 +28,28 @@ Tcl_Size
|
||||
\fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR)
|
||||
.sp
|
||||
char *
|
||||
\fBTcl_UniCharToUtfDString\fR(\fIuniStr, numUniChars, dsPtr\fR)
|
||||
\fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR)
|
||||
.sp
|
||||
char *
|
||||
\fBTcl_Char16ToUtfDString\fR(\fIutf16, numUtf16, dsPtr\fR)
|
||||
\fBTcl_Char16ToUtfDString\fR(\fIuStr, uniLength, dsPtr\fR)
|
||||
.sp
|
||||
char *
|
||||
\fBTcl_WCharToUtfDString\fR(\fIwcharStr, numWChars, dsPtr\fR)
|
||||
\fBTcl_WCharToUtfDString\fR(\fIwStr, uniLength, dsPtr\fR)
|
||||
.sp
|
||||
Tcl_UniChar *
|
||||
\fBTcl_UtfToUniCharDString\fR(\fIsrc, numBytes, dsPtr\fR)
|
||||
\fBTcl_UtfToUniCharDString\fR(\fIsrc, length, dsPtr\fR)
|
||||
.sp
|
||||
unsigned short *
|
||||
\fBTcl_UtfToChar16DString\fR(\fIsrc, numBytes, dsPtr\fR)
|
||||
\fBTcl_UtfToChar16DString\fR(\fIsrc, length, dsPtr\fR)
|
||||
.sp
|
||||
wchar_t *
|
||||
\fBTcl_UtfToWCharDString\fR(\fIsrc, numBytes, dsPtr\fR)
|
||||
\fBTcl_UtfToWCharDString\fR(\fIsrc, length, dsPtr\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_Char16Len\fR(\fIutf16\fR)
|
||||
\fBTcl_Char16Len\fR(\fIuniStr\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_WCharLen\fR(\fIwcharStr\fR)
|
||||
\fBTcl_WCharLen\fR(\fIuniStr\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_UniCharLen\fR(\fIuniStr\fR)
|
||||
@@ -70,10 +70,10 @@ int
|
||||
\fBTcl_UtfNcasecmp\fR(\fIcs, ct, length\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_UtfCharComplete\fR(\fIsrc, numBytes\fR)
|
||||
\fBTcl_UtfCharComplete\fR(\fIsrc, length\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_NumUtfChars\fR(\fIsrc, numBytes\fR)
|
||||
\fBTcl_NumUtfChars\fR(\fIsrc, length\fR)
|
||||
.sp
|
||||
const char *
|
||||
\fBTcl_UtfFindFirst\fR(\fIsrc, ch\fR)
|
||||
@@ -115,32 +115,28 @@ Pointer to a UTF-8 string.
|
||||
.AP "const char" *ct in
|
||||
Pointer to a UTF-8 string.
|
||||
.AP "const Tcl_UniChar" *uniStr in
|
||||
A sequence of \fBTcl_UniChar\fR units with null-termination optional
|
||||
depending on function.
|
||||
A null-terminated Unicode string.
|
||||
.AP "const Tcl_UniChar" *ucs in
|
||||
A null-terminated sequence of \fBTcl_UniChar\fR.
|
||||
A null-terminated Unicode string.
|
||||
.AP "const Tcl_UniChar" *uct in
|
||||
A null-terminated sequence of \fBTcl_UniChar\fR.
|
||||
A null-terminated Unicode string.
|
||||
.AP "const Tcl_UniChar" *uniPattern in
|
||||
A null-terminated sequence of \fBTcl_UniChar\fR.
|
||||
.AP "const unsigned short" *utf16 in
|
||||
A sequence of UTF-16 units with null-termination optional
|
||||
depending on function.
|
||||
.AP "const wchar_t" *wcharStr in
|
||||
A sequence of \fBwchar_t\fR units with null-termination optional
|
||||
depending on function.
|
||||
.AP int numBytes in
|
||||
The length of the UTF-8 input in bytes. If
|
||||
negative, the length includes all bytes until the first null byte.
|
||||
.AP int numUtf16 in
|
||||
The length of the input in UTF-16 units.
|
||||
If negative, the length includes all bytes until the first null.
|
||||
.AP int numUniChars in
|
||||
The length of the input in Tcl_UniChar units.
|
||||
If negative, the length includes all bytes until the first null.
|
||||
.AP int numWChars in
|
||||
The length of the input in wchar_t units.
|
||||
If negative, the length includes all bytes until the first null.
|
||||
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 Tcl_Size 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 Tcl_Size 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.
|
||||
.AP "const char" *start in
|
||||
@@ -190,32 +186,30 @@ not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first
|
||||
byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x00A0 and
|
||||
0x00FF and return 1.
|
||||
.PP
|
||||
\fBTcl_UniCharToUtfDString\fR converts the input in the form of a
|
||||
sequence of \fBTcl_UniChar\fR code points to UTF-8, appending the result to the
|
||||
previously initialized output \fBTcl_DString\fR. The return value is a pointer
|
||||
to the UTF-8 representation of the \fBappended\fR string.
|
||||
\fBTcl_UniCharToUtfDString\fR converts the given Unicode string
|
||||
to UTF-8, storing the result in a previously initialized \fBTcl_DString\fR.
|
||||
The return value is a pointer to the UTF-8 representation of the
|
||||
Unicode string. Storage for the return value is appended to the
|
||||
end of the \fBTcl_DString\fR.
|
||||
.PP
|
||||
\fBTcl_UtfToUniCharDString\fR converts the input in the form of
|
||||
a UTF-8 encoded string to a \fBTcl_UniChar\fR sequence
|
||||
appending the result in the previously initialized \fBTcl_DString\fR.
|
||||
The return value is a pointer to the appended result which is also
|
||||
terminated with a \fBTcl_UniChar\fR null character.
|
||||
.PP
|
||||
\fBTcl_WCharToUtfDString\fR and \fBTcl_UtfToWCharDString\fR are similar to
|
||||
\fBTcl_UniCharToUtfDString\fR and \fBTcl_UtfToUniCharDString\fR except they
|
||||
operate on sequences of \fBwchar_t\fR instead of \fBTcl_UniChar\fR.
|
||||
.PP
|
||||
\fBTcl_Char16ToUtfDString\fR and \fBTcl_UtfToChar16DString\fR are similar to
|
||||
\fBTcl_UniCharToUtfDString\fR and \fBTcl_UtfToUniCharDString\fR except they
|
||||
operate on sequences of \fBUTF-16\fR units instead of \fBTcl_UniChar\fR.
|
||||
\fBTcl_UtfToUniCharDString\fR converts the given UTF-8 string to Unicode,
|
||||
storing the result in the previously initialized \fBTcl_DString\fR.
|
||||
In the argument \fIlength\fR, you may either specify the length of
|
||||
the given UTF-8 string in bytes or
|
||||
.QW \-1 ,
|
||||
in which case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to
|
||||
calculate the length. The return value is a pointer to the Unicode
|
||||
representation of the UTF-8 string. Storage for the return value
|
||||
is appended to the end of the \fBTcl_DString\fR. The Unicode string
|
||||
is terminated with a Unicode null character.
|
||||
.PP
|
||||
\fBTcl_Char16Len\fR corresponds to \fBstrlen\fR for UTF-16
|
||||
characters. It accepts a null-terminated UTF-16 sequence and returns
|
||||
the number of UTF-16 units until the null.
|
||||
characters. It accepts a null-terminated Unicode string and returns
|
||||
the number of Unicode characters (not bytes) in that string.
|
||||
.PP
|
||||
\fBTcl_WCharLen\fR corresponds to \fBstrlen\fR for wchar_t
|
||||
characters. It accepts a null-terminated \fBwchar_t\fR sequence and returns
|
||||
the number of \fBwchar_t\fR units until the null.
|
||||
characters. It accepts a null-terminated Unicode string and returns
|
||||
the number of Unicode characters (not bytes) in that string.
|
||||
.PP
|
||||
\fBTcl_UniCharLen\fR corresponds to \fBstrlen\fR for Unicode
|
||||
characters. It accepts a null-terminated Unicode string and returns
|
||||
@@ -251,7 +245,7 @@ differences in case when comparing upper, lower or title case
|
||||
characters.
|
||||
.PP
|
||||
\fBTcl_UtfCharComplete\fR returns 1 if the source UTF-8 string \fIsrc\fR
|
||||
of \fInumBytes\fR bytes is long enough to be decoded by
|
||||
of \fIlength\fR bytes is long enough to be decoded by
|
||||
\fBTcl_UtfToUniChar\fR/\fBTcl_UtfNext\fR, or 0 otherwise. This function
|
||||
does not guarantee that the UTF-8 string is properly formed. This routine
|
||||
is used by procedures that are operating on a byte at a time and need to
|
||||
|
||||
+20
-20
@@ -241,7 +241,7 @@ which returns a binary string equivalent to:
|
||||
\fB\e254\fR
|
||||
.CE
|
||||
.PP
|
||||
(i.e. \fB\exAC\fR) by
|
||||
(i.e. \fB\exac\fR) by
|
||||
truncating the high-bits of the character, and which is probably not
|
||||
what is desired.
|
||||
.RE
|
||||
@@ -299,7 +299,7 @@ high-to-low order within each byte. For example,
|
||||
will return a binary string equivalent to:
|
||||
.PP
|
||||
.CS
|
||||
\fB\exE0\exE1\exA0\fR
|
||||
\fB\exe0\exe1\exa0\fR
|
||||
.CE
|
||||
.RE
|
||||
.IP \fBH\fR 5
|
||||
@@ -326,7 +326,7 @@ remaining bits of the last byte will be zeros. For example,
|
||||
will return a binary string equivalent to:
|
||||
.PP
|
||||
.CS
|
||||
\fB\exAB\ex00\exDE\exF0\ex98\fR
|
||||
\fB\exab\ex00\exde\exf0\ex98\fR
|
||||
.CE
|
||||
.RE
|
||||
.IP \fBh\fR 5
|
||||
@@ -341,7 +341,7 @@ low-to-high order within each byte. This is seldom required. For example,
|
||||
will return a binary string equivalent to:
|
||||
.PP
|
||||
.CS
|
||||
\fB\exBA\ex00\exED\ex0F\ex89\fR
|
||||
\fB\exba\ex00\exed\ex0f\ex89\fR
|
||||
.CE
|
||||
.RE
|
||||
.IP \fBc\fR 5
|
||||
@@ -363,7 +363,7 @@ than \fIcount\fR, then the extra elements are ignored. For example,
|
||||
will return a binary string equivalent to:
|
||||
.PP
|
||||
.CS
|
||||
\fB\ex03\exFD\ex80\ex04\ex02\ex05\fR
|
||||
\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR
|
||||
.CE
|
||||
.PP
|
||||
whereas:
|
||||
@@ -389,7 +389,7 @@ example,
|
||||
will return a binary string equivalent to:
|
||||
.PP
|
||||
.CS
|
||||
\fB\ex03\ex00\exFD\exFF\ex02\ex01\fR
|
||||
\fB\ex03\ex00\exfd\exff\ex02\ex01\fR
|
||||
.CE
|
||||
.RE
|
||||
.IP \fBS\fR 5
|
||||
@@ -405,7 +405,7 @@ example,
|
||||
will return a binary string equivalent to:
|
||||
.PP
|
||||
.CS
|
||||
\fB\ex00\ex03\exFF\exFD\ex01\ex02\fR
|
||||
\fB\ex00\ex03\exff\exfd\ex01\ex02\fR
|
||||
.CE
|
||||
.RE
|
||||
.IP \fBt\fR 5
|
||||
@@ -429,7 +429,7 @@ example,
|
||||
will return a binary string equivalent to:
|
||||
.PP
|
||||
.CS
|
||||
\fB\ex03\ex00\ex00\ex00\exFD\exFF\exFF\exFF\ex00\ex00\ex01\ex00\fR
|
||||
\fB\ex03\ex00\ex00\ex00\exfd\exff\exff\exff\ex00\ex00\ex01\ex00\fR
|
||||
.CE
|
||||
.RE
|
||||
.IP \fBI\fR 5
|
||||
@@ -445,7 +445,7 @@ For example,
|
||||
will return a binary string equivalent to:
|
||||
.PP
|
||||
.CS
|
||||
\fB\ex00\ex00\ex00\ex03\exFF\exFF\exFF\exFD\ex00\ex01\ex00\ex00\fR
|
||||
\fB\ex00\ex00\ex00\ex03\exff\exff\exff\exfd\ex00\ex01\ex00\ex00\fR
|
||||
.CE
|
||||
.RE
|
||||
.IP \fBn\fR 5
|
||||
@@ -510,7 +510,7 @@ on a Windows system running on an Intel Pentium processor,
|
||||
will return a binary string equivalent to:
|
||||
.PP
|
||||
.CS
|
||||
\fB\exCD\exCC\exCC\ex3F\ex9A\ex99\ex59\ex40\fR
|
||||
\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR
|
||||
.CE
|
||||
.RE
|
||||
.IP \fBr\fR 5
|
||||
@@ -536,7 +536,7 @@ Windows system running on an Intel Pentium processor,
|
||||
will return a binary string equivalent to:
|
||||
.PP
|
||||
.CS
|
||||
\fB\ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F\fR
|
||||
\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR
|
||||
.CE
|
||||
.RE
|
||||
.IP \fBq\fR 5
|
||||
@@ -788,7 +788,7 @@ scanned. For example,
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
\fBbinary scan\fR \ex07\exC6\ex05\ex1F\ex34 H3H* var1 var2
|
||||
\fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2
|
||||
.CE
|
||||
.PP
|
||||
will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and
|
||||
@@ -839,7 +839,7 @@ example,
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exF0\exFF s2s* var1 var2
|
||||
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exf0\exff s2s* var1 var2
|
||||
.CE
|
||||
.PP
|
||||
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
|
||||
@@ -853,7 +853,7 @@ order. For example,
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exFF\exF0 S2S* var1 var2
|
||||
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
|
||||
.CE
|
||||
.PP
|
||||
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
|
||||
@@ -878,7 +878,7 @@ example,
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
|
||||
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
|
||||
\fBbinary scan\fR $str i2i* var1 var2
|
||||
.CE
|
||||
.PP
|
||||
@@ -894,7 +894,7 @@ immediately after the \fBI\fR. For example,
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
|
||||
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
|
||||
\fBbinary scan\fR $str I2I* var1 var2
|
||||
.CE
|
||||
.PP
|
||||
@@ -920,7 +920,7 @@ example,
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
|
||||
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
|
||||
\fBbinary scan\fR $str wi* var1 var2
|
||||
.CE
|
||||
.PP
|
||||
@@ -935,7 +935,7 @@ immediately after the \fBW\fR. For example,
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
|
||||
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
|
||||
\fBbinary scan\fR $str WI* var1 var2
|
||||
.CE
|
||||
.PP
|
||||
@@ -966,7 +966,7 @@ Intel Pentium processor,
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
\fBbinary scan\fR \ex3F\exCC\exCC\exCD f var1
|
||||
\fBbinary scan\fR \ex3f\excc\excc\excd f var1
|
||||
.CE
|
||||
.PP
|
||||
will return \fB1\fR with \fB1.6000000238418579\fR stored in
|
||||
@@ -990,7 +990,7 @@ running on an Intel Pentium processor,
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
\fBbinary scan\fR \ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F d var1
|
||||
\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1
|
||||
.CE
|
||||
.PP
|
||||
will return \fB1\fR with \fB1.6000000000000001\fR
|
||||
|
||||
+3
-3
@@ -152,7 +152,7 @@ If \fIchar\fR is the empty string, there is no special character that marks
|
||||
the end of the data.
|
||||
|
||||
The default value is the empty string. The acceptable range is \ex01 -
|
||||
\ex7F. A value outside this range results in an error.
|
||||
\ex7f. A value outside this range results in an error.
|
||||
.VS "TCL8.7 TIP656"
|
||||
.TP
|
||||
\fB\-profile\fR \fIprofile\fR
|
||||
@@ -245,10 +245,10 @@ files to slow destinations like network sockets.
|
||||
.PP
|
||||
\fB\-size\fR limits the number of characters copied.
|
||||
.PP
|
||||
If \fB\-command\fR is given, \fBchan copy\fR returns immediately, works in the
|
||||
If \fB\-command\fR is gviven, \fBchan copy\fR returns immediately, works in the
|
||||
background, and calls \fIcallback\fR when the copy completes, providing as an
|
||||
additional argument the number of characters written to \fIoutputChan\fR. If
|
||||
an error occurs during the background copy, another argument provides message
|
||||
an error occurres during the background copy, another argument provides message
|
||||
for the error. \fIinputChan\fR and \fIoutputChan\fR are automatically
|
||||
configured for non-blocking mode if needed. Background copying only works
|
||||
correctly if events are being processed, e.g. via \fBvwait\fR or Tk.
|
||||
|
||||
@@ -119,22 +119,6 @@ Volume-relative path to a file \fBfoo\fR in the root directory of the current
|
||||
volume. This is not a valid UNC path, so the assumption is that the
|
||||
extra backslashes are superfluous.
|
||||
.RE
|
||||
.SH "TILDE SUBSTITUTION"
|
||||
.PP
|
||||
Unlike earlier versions of Tcl, Tcl 9 does not do implicit tilde substitution
|
||||
on file paths with the exception noted below. The commands \fBfile home\fR and
|
||||
\fBfile tildeexpand\fR may be used to explicitly accomplish the same.
|
||||
.PP
|
||||
The exception to the above is initialization of the \fBauto_path\fR variable
|
||||
and the Tcl module search paths as documented in the manpages for
|
||||
\fBtclvars\fR and \fBtm\fR. When any path in an environment variable used to
|
||||
initialize these starts with a tilde, it will be interpreted as if the first
|
||||
element is replaced with the location of the home directory for the given
|
||||
user. If the tilde is followed immediately by a separator, the
|
||||
\fB$HOME\fR environment variable is substituted. Otherwise the characters
|
||||
between the tilde and the next separator are taken as a user name, which is
|
||||
used to retrieve the user's home directory for substitution. This works on
|
||||
POSIX, MacOS X and Windows platforms.
|
||||
.SH "PORTABILITY ISSUES"
|
||||
.PP
|
||||
Not all file systems are case sensitive, so scripts should avoid code
|
||||
|
||||
@@ -248,9 +248,6 @@ For example, to print the contents of the \fBtcl_platform\fR array, do:
|
||||
\fBparray\fR tcl_platform
|
||||
.CE
|
||||
.RE
|
||||
.SS "WORD BOUNDARY HELPERS"
|
||||
.PP
|
||||
These procedures are mainly used internally by Tk.
|
||||
.TP
|
||||
\fBtcl_endOfWord \fIstr start\fR
|
||||
.
|
||||
|
||||
+33
-62
@@ -20,47 +20,18 @@ lseq \- Build a numeric sequence returned as a list
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
The \fBlseq\fR command creates a sequence of numeric values using the given
|
||||
parameters \fIstart\fR, \fIend\fR, and \fIstep\fR. The \fIoperation\fR
|
||||
argument "\fB..\fR" or "\fBto\fR" defines the range. The "\fBcount\fR" option
|
||||
is used to define a count of the number of elements in the list. A short form
|
||||
use of the command, with a single count value, will create a range from 0 to
|
||||
count-1.
|
||||
|
||||
The \fBlseq\fR command can produce both increasing and decreasing
|
||||
sequences. When both \fIstart\fR and \fIend\fR are provided without a
|
||||
\fIstep\fR value, then if \fIstart\fR <= \fIend\fR, the sequence will be
|
||||
increasing and if \fIstart\fR > \fIend\fR it will be decreasing. If a
|
||||
\fIstep\fR vale is included, it's sign should agree with the direction of the
|
||||
sequence (descending -> negative and ascending -> positive), otherwise an
|
||||
empty list is returned. For example:
|
||||
|
||||
.CS \"
|
||||
% \fBlseq\fR 1 to 5 ;# increasing
|
||||
\fI\(-> 1 2 3 4 5
|
||||
|
||||
% \fBlseq\fR 5 to 1 ;# decreasing
|
||||
\fI\(-> 5 4 3 2 1
|
||||
|
||||
% \fBlseq\fR 6 to 1 by 2 ;# decreasing, step wrong sign, empty list
|
||||
|
||||
% \fBlseq\fR 1 to 5 by 0 ;# all step sizes of 0 produce an empty list
|
||||
.\"
|
||||
.CE
|
||||
|
||||
The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
|
||||
may also be a valid expression. The expression will be evaluated and the
|
||||
numeric result will be used. An expression that does not evaluate to a number
|
||||
will produce an invalid argument error.
|
||||
.PP
|
||||
\fIStart\fR defines the initial value and \fIend\fR defines the limit, not
|
||||
necessarily the last value. \fBlseq\fR produces a list with \fIcount\fR
|
||||
elements, and if \fIcount\fR is not supplied, it is computed as
|
||||
|
||||
.CS \"
|
||||
\fIcount\fR = int( (\fIend\fR - \fIstart\fR + \fIstep\fR) / \fIstep\fR )
|
||||
.\"
|
||||
.CE
|
||||
|
||||
parameters \fIstart\fR, \fIend\fR, and \fIstep\fR.
|
||||
The \fIoperation\fR argument
|
||||
.QW \fB..\fR
|
||||
or
|
||||
.QW \fBto\fR
|
||||
defines an inclusive range; if it is omitted, the range is exclusive.
|
||||
The \fBcount\fR option is used to define a count of the number of elements in
|
||||
the list.
|
||||
The \fIstep\fR (which may be preceded by \fBby\fR) is 1 if not provided.
|
||||
The short form with a
|
||||
single \fIcount\fR value will create a range from 0 to \fIcount\fR-1 (i.e.,
|
||||
\fIcount\fR values).
|
||||
.PP
|
||||
The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
|
||||
can also be a valid expression. the \fBlseq\fR command will evaluate the
|
||||
@@ -72,53 +43,53 @@ value; a non-numeric expression result will result in an error.
|
||||
.CS
|
||||
.\"
|
||||
\fBlseq\fR 3
|
||||
\fI\(-> 0 1 2\fR
|
||||
\fI\(-> 0 1 2\fR
|
||||
|
||||
\fBlseq\fR 3 0
|
||||
\fI\(-> 3 2 1 0\fR
|
||||
\fI\(-> 3 2 1 0\fR
|
||||
|
||||
\fBlseq\fR 10 .. 1 by -2
|
||||
\fI\(-> 10 8 6 4 2\fR
|
||||
\fI\(-> 10 8 6 4 2\fR
|
||||
|
||||
set l [\fBlseq\fR 0 -5]
|
||||
\fI\(-> 0 -1 -2 -3 -4 -5\fR
|
||||
\fI\(-> 0 -1 -2 -3 -4 -5\fR
|
||||
|
||||
foreach i [\fBlseq\fR [llength $l]] {
|
||||
puts l($i)=[lindex $l $i]
|
||||
}
|
||||
\fI\(-> l(0)=0\fR
|
||||
\fI\(-> l(1)=-1\fR
|
||||
\fI\(-> l(2)=-2\fR
|
||||
\fI\(-> l(3)=-3\fR
|
||||
\fI\(-> l(4)=-4\fR
|
||||
\fI\(-> l(5)=-5\fR
|
||||
\fI\(-> l(0)=0\fR
|
||||
\fI\(-> l(1)=-1\fR
|
||||
\fI\(-> l(2)=-2\fR
|
||||
\fI\(-> l(3)=-3\fR
|
||||
\fI\(-> l(4)=-4\fR
|
||||
\fI\(-> l(5)=-5\fR
|
||||
|
||||
foreach i [\fBlseq\fR {[llength $l]-1} 0] {
|
||||
puts l($i)=[lindex $l $i]
|
||||
}
|
||||
\fI\(-> l(5)=-5\fR
|
||||
\fI\(-> l(4)=-4\fR
|
||||
\fI\(-> l(3)=-3\fR
|
||||
\fI\(-> l(2)=-2\fR
|
||||
\fI\(-> l(1)=-1\fR
|
||||
\fI\(-> l(0)=0\fR
|
||||
\fI\(-> l(5)=-5\fR
|
||||
\fI\(-> l(4)=-4\fR
|
||||
\fI\(-> l(3)=-3\fR
|
||||
\fI\(-> l(2)=-2\fR
|
||||
\fI\(-> l(1)=-1\fR
|
||||
\fI\(-> l(0)=0\fR
|
||||
|
||||
set i 17
|
||||
\fI\(-> 17\fR
|
||||
if {$i in [\fBlseq\fR 0 50]} { # equivalent to: (0 <= $i && $i <= 50)
|
||||
if {$i in [\fBlseq\fR 0 50]} { # equivalent to: (0 <= $i && $i < 50)
|
||||
puts "Ok"
|
||||
} else {
|
||||
puts "outside :("
|
||||
}
|
||||
\fI\(-> Ok\fR
|
||||
\fI\(-> Ok\fR
|
||||
|
||||
set sqrs [lmap i [\fBlseq\fR 1 10] { expr {$i*$i} }]
|
||||
\fI\(-> 1 4 9 16 25 36 49 64 81 100\fR
|
||||
\fI\(-> 1 4 9 16 25 36 49 64 81 100\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), lreplace(n),
|
||||
foreach(n), list(n), lappend(n), lassign(n), ledit(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
|
||||
|
||||
@@ -30,10 +30,6 @@ the parent directory of \fBtcl_library\fR,
|
||||
the directories listed in the \fBtcl_pkgPath\fR variable.
|
||||
Additional locations to look for files and package indices should
|
||||
normally be added to this variable using \fBlappend\fR.
|
||||
Initialization of auto_path from the TCLLIBPATH environment
|
||||
variable undergoes tilde substitution (see \fBfilename\fR) on each
|
||||
path. Any tilde substitution that fails because the user is unknown
|
||||
will be omitted from auto_path.
|
||||
.RS
|
||||
.PP
|
||||
Additional variables relating to package management exist. More
|
||||
|
||||
@@ -295,10 +295,6 @@ environment variables:
|
||||
\fB$::env(TCL8.1_TM_PATH)\fR \fB$::env(TCL8_1_TM_PATH)\fR
|
||||
\fB$::env(TCL8.0_TM_PATH)\fR \fB$::env(TCL8_0_TM_PATH)\fR
|
||||
.CE
|
||||
.PP
|
||||
Paths initialized from the environment variables undergo tilde
|
||||
substitution (see \fBfilename\fR). Any path whose tilde substitution
|
||||
fails because the user is unknown will be omitted from search paths.
|
||||
.SH "SEE ALSO"
|
||||
package(n), Tcl Improvement Proposal #189
|
||||
.QW "\fITcl Modules\fR"
|
||||
|
||||
+1
-1
@@ -231,7 +231,7 @@ When the trace triggers, three arguments are appended to
|
||||
.PP
|
||||
\fIName1\fR gives the name for the variable being accessed.
|
||||
This is not necessarily the same as the name used in the
|
||||
\fBtrace add variable\fR command: the \fBupvar\fR command allows a
|
||||
\fBtrace variable\fR command: the \fBupvar\fR command allows a
|
||||
procedure to reference a variable under a different name.
|
||||
If the trace was originally set on an array or array element,
|
||||
\fIname2\fR provides which index into the array was affected.
|
||||
|
||||
+1
-1
@@ -94,7 +94,7 @@ proc \fIsetByUpvar\fR { name value } {
|
||||
set localVar $value
|
||||
}
|
||||
set originalVar 1
|
||||
trace add variable originalVar write \fItraceproc\fR
|
||||
trace variable originalVar w \fItraceproc\fR
|
||||
\fIsetByUpvar\fR originalVar 2
|
||||
.CE
|
||||
.PP
|
||||
|
||||
@@ -84,15 +84,9 @@ 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 */
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Functions operating on chr.
|
||||
|
||||
+39
-202
@@ -9,6 +9,7 @@
|
||||
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
|
||||
* Copyright (c) 1998-2000 by Scriptics Corporation.
|
||||
* Copyright (c) 2002 by Kevin B. Kenny. All rights reserved.
|
||||
* Copyright (c) 2021 by Nathan Coulter. All rights reserved.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -105,6 +106,9 @@ extern "C" {
|
||||
#include <stdio.h>
|
||||
#include <stddef.h>
|
||||
|
||||
|
||||
#define TCL_COMMENT(x)
|
||||
|
||||
#if defined(__GNUC__) && (__GNUC__ > 2)
|
||||
# if defined(_WIN32) && defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO
|
||||
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__MINGW_PRINTF_FORMAT, a, b)))
|
||||
@@ -208,10 +212,6 @@ extern "C" {
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)
|
||||
# define CONST86 const
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Make sure EXTERN isn't defined elsewhere.
|
||||
*/
|
||||
@@ -321,24 +321,12 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
|
||||
#define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val)))
|
||||
#define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
|
||||
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
typedef int Tcl_Size;
|
||||
# define TCL_SIZE_MODIFIER ""
|
||||
# define TCL_SIZE_MAX INT_MAX
|
||||
#else
|
||||
typedef ptrdiff_t Tcl_Size;
|
||||
# define TCL_SIZE_MAX PTRDIFF_MAX
|
||||
# define TCL_SIZE_MODIFIER TCL_T_MODIFIER
|
||||
#endif /* TCL_MAJOR_VERSION */
|
||||
typedef ptrdiff_t Tcl_Size;
|
||||
#define TCL_SIZE_MAX PTRDIFF_MAX
|
||||
#define TCL_SIZE_MODIFIER TCL_T_MODIFIER
|
||||
|
||||
#ifdef _WIN32
|
||||
# if TCL_MAJOR_VERSION > 8 || defined(_WIN64) || defined(_USE_64BIT_TIME_T)
|
||||
typedef struct __stat64 Tcl_StatBuf;
|
||||
# elif defined(_USE_32BIT_TIME_T)
|
||||
typedef struct _stati64 Tcl_StatBuf;
|
||||
# else
|
||||
typedef struct _stat32i64 Tcl_StatBuf;
|
||||
# endif
|
||||
typedef struct __stat64 Tcl_StatBuf;
|
||||
#elif defined(__CYGWIN__)
|
||||
typedef struct {
|
||||
unsigned st_dev;
|
||||
@@ -355,6 +343,8 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
|
||||
struct {long tv_sec;} st_mtim;
|
||||
struct {long tv_sec;} st_ctim;
|
||||
} Tcl_StatBuf;
|
||||
#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
|
||||
typedef struct stat64 Tcl_StatBuf;
|
||||
#else
|
||||
typedef struct stat Tcl_StatBuf;
|
||||
#endif
|
||||
@@ -463,28 +453,18 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData);
|
||||
*/
|
||||
|
||||
typedef struct Tcl_RegExpIndices {
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
Tcl_Size start; /* Character offset of first character in
|
||||
* match. */
|
||||
Tcl_Size end; /* Character offset of first character after
|
||||
* the match. */
|
||||
#else
|
||||
long start;
|
||||
long end;
|
||||
#endif
|
||||
} Tcl_RegExpIndices;
|
||||
|
||||
typedef struct Tcl_RegExpInfo {
|
||||
Tcl_Size nsubs; /* Number of subexpressions in the compiled
|
||||
* expression. */
|
||||
Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
Tcl_Size extendStart; /* The offset at which a subsequent match
|
||||
* might begin. */
|
||||
#else
|
||||
long extendStart;
|
||||
long reserved; /* Reserved for later use. */
|
||||
#endif
|
||||
} Tcl_RegExpInfo;
|
||||
|
||||
/*
|
||||
@@ -606,32 +586,6 @@ typedef void *(Tcl_InitNotifierProc) (void);
|
||||
typedef void (Tcl_FinalizeNotifierProc) (void *clientData);
|
||||
typedef void (Tcl_MainLoopProc) (void);
|
||||
|
||||
/* Abstract List functions */
|
||||
typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr);
|
||||
typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
|
||||
Tcl_Size index, struct Tcl_Obj** elemObj);
|
||||
typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
|
||||
Tcl_Size fromIdx, Tcl_Size toIdx,
|
||||
struct Tcl_Obj **newObjPtr);
|
||||
typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
|
||||
struct Tcl_Obj **newObjPtr);
|
||||
typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
|
||||
Tcl_Size *objcptr, struct Tcl_Obj ***objvptr);
|
||||
typedef struct Tcl_Obj* (Tcl_ObjTypeSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
|
||||
Tcl_Size indexCount,
|
||||
struct Tcl_Obj *const indexArray[],
|
||||
struct Tcl_Obj *valueObj);
|
||||
typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj,
|
||||
Tcl_Size first, Tcl_Size numToDelete,
|
||||
Tcl_Size numToInsert,
|
||||
struct Tcl_Obj *const insertObjs[]);
|
||||
typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj,
|
||||
struct Tcl_Obj *listObj, int *boolResult);
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# define Tcl_PackageInitProc Tcl_LibraryInitProc
|
||||
# define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -640,6 +594,10 @@ typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct T
|
||||
* standard operations on objects of that type.
|
||||
*/
|
||||
|
||||
/* forward declaration */
|
||||
typedef struct Tcl_Obj Tcl_Obj;
|
||||
typedef struct Tcl_ObjInterface Tcl_ObjInterface;
|
||||
|
||||
typedef struct Tcl_ObjType {
|
||||
const char *name; /* Name of the type, e.g. "int". */
|
||||
Tcl_FreeInternalRepProc *freeIntRepProc;
|
||||
@@ -656,40 +614,12 @@ typedef struct Tcl_ObjType {
|
||||
/* Called to convert the object's internal rep
|
||||
* to this type. Frees the internal rep of the
|
||||
* old type. Returns TCL_ERROR on failure. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
size_t version;
|
||||
|
||||
/* List emulation functions - ObjType Version 1 */
|
||||
Tcl_ObjTypeLengthProc *lengthProc; /* Return the [llength] of the
|
||||
** AbstractList */
|
||||
Tcl_ObjTypeIndexProc *indexProc; /* Return a value (Tcl_Obj) for
|
||||
** [lindex $al $index] */
|
||||
Tcl_ObjTypeSliceProc *sliceProc; /* Return an AbstractList for
|
||||
** [lrange $al $start $end] */
|
||||
Tcl_ObjTypeReverseProc *reverseProc; /* Return an AbstractList for
|
||||
** [lreverse $al] */
|
||||
Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in
|
||||
** the list */
|
||||
Tcl_ObjTypeSetElement *setElementProc; /* Replace the element at the indicie
|
||||
** with the given valueObj. */
|
||||
Tcl_ObjTypeReplaceProc *replaceProc; /* Replace subset with subset */
|
||||
Tcl_ObjTypeInOperatorProc *inOperProc; /* "in" and "ni" expr list
|
||||
** operation Determine if the given
|
||||
** string value matches an element in
|
||||
** the list */
|
||||
#endif
|
||||
} Tcl_ObjType;
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_OBJTYPE_V0 0, \
|
||||
0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */
|
||||
# define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \
|
||||
a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */
|
||||
# define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType), \
|
||||
a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */
|
||||
#else
|
||||
# define TCL_OBJTYPE_V0 /* just empty */
|
||||
#endif
|
||||
#define TCL_OBJTYPE_V0 0 /* Pre-Tcl 9. Set to 0 so compiler will auto-init
|
||||
* when existing code that does not init this
|
||||
* field is compiled with Tcl9 headers */
|
||||
#define TCL_OBJTYPE_CURRENT TCL_OBJTYPE_V0
|
||||
|
||||
/*
|
||||
* The following structure stores an internal representation (internalrep) for
|
||||
@@ -720,7 +650,7 @@ typedef union Tcl_ObjInternalRep { /* The internal representation: */
|
||||
* or both.
|
||||
*/
|
||||
|
||||
typedef struct Tcl_Obj {
|
||||
struct Tcl_Obj {
|
||||
Tcl_Size refCount; /* When 0 the object will be freed. */
|
||||
char *bytes; /* This points to the first byte of the
|
||||
* object's string representation. The array
|
||||
@@ -740,8 +670,9 @@ typedef struct Tcl_Obj {
|
||||
* internal rep. NULL indicates the object has
|
||||
* no internal rep (has no type). */
|
||||
Tcl_ObjInternalRep internalRep; /* The internal representation: */
|
||||
} Tcl_Obj;
|
||||
};
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* The following definitions support Tcl's namespace facility. Note: the first
|
||||
@@ -930,11 +861,7 @@ typedef struct Tcl_DString {
|
||||
* TCL_COMBINE Combine surrogates
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_COMBINE 0x1000000
|
||||
#else
|
||||
# define TCL_COMBINE 0
|
||||
#endif
|
||||
#define TCL_COMBINE 0x1000000
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
|
||||
@@ -1048,11 +975,7 @@ typedef struct Tcl_DString {
|
||||
*/
|
||||
|
||||
#ifndef TCL_HASH_TYPE
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_HASH_TYPE size_t
|
||||
#else
|
||||
# define TCL_HASH_TYPE unsigned
|
||||
#endif
|
||||
#define TCL_HASH_TYPE size_t
|
||||
#endif
|
||||
|
||||
typedef struct Tcl_HashKeyType Tcl_HashKeyType;
|
||||
@@ -1169,15 +1092,10 @@ struct Tcl_HashTable {
|
||||
* table. */
|
||||
Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be
|
||||
* this large. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
size_t mask; /* Mask value used in hashing function. */
|
||||
#endif
|
||||
int downShift; /* Shift count used in hashing function.
|
||||
* Designed to use high-order bits of
|
||||
* randomized keys. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int mask; /* Mask value used in hashing function. */
|
||||
#endif
|
||||
int keyType; /* Type of keys used in this table. It's
|
||||
* either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
|
||||
* TCL_ONE_WORD_KEYS, or an integer giving the
|
||||
@@ -1343,11 +1261,7 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData);
|
||||
* interface.
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_CLOSE2PROC NULL
|
||||
#else
|
||||
# define TCL_CLOSE2PROC ((void *) 1)
|
||||
#endif
|
||||
#define TCL_CLOSE2PROC NULL
|
||||
|
||||
/*
|
||||
* Channel version tag. This was introduced in 8.3.2/8.4.
|
||||
@@ -1897,12 +1811,10 @@ typedef struct Tcl_Parse {
|
||||
* *tokenPtr. */
|
||||
int errorType; /* One of the parsing error types defined
|
||||
* above. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
int incomplete; /* This field is set to 1 by Tcl_ParseCommand
|
||||
* if the command appears to be incomplete.
|
||||
* This information is used by
|
||||
* Tcl_CommandComplete. */
|
||||
#endif
|
||||
|
||||
/*
|
||||
* The fields below are intended only for the private use of the parser.
|
||||
@@ -1921,9 +1833,6 @@ typedef struct Tcl_Parse {
|
||||
* beginning of region where the error
|
||||
* occurred (e.g. the open brace if the close
|
||||
* brace is missing). */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int incomplete;
|
||||
#endif
|
||||
Tcl_Token staticTokens[NUM_STATIC_TOKENS];
|
||||
/* Initial space for tokens for command. This
|
||||
* space should be large enough to accommodate
|
||||
@@ -1980,7 +1889,7 @@ typedef struct Tcl_EncodingType {
|
||||
* reset to an initial state. If the source
|
||||
* buffer contains the entire input stream to be
|
||||
* converted, this flag should be set.
|
||||
* TCL_ENCODING_STOPONERROR - Not used any more.
|
||||
* TCL_ENCODING_STOPONERROR - Obsolete.
|
||||
* TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf does not append a
|
||||
* terminating NUL byte. Since it does not need
|
||||
* an extra byte for a terminating NUL, it fills
|
||||
@@ -2005,11 +1914,7 @@ typedef struct Tcl_EncodingType {
|
||||
|
||||
#define TCL_ENCODING_START 0x01
|
||||
#define TCL_ENCODING_END 0x02
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_ENCODING_STOPONERROR 0x0 /* Not used any more */
|
||||
#else
|
||||
# define TCL_ENCODING_STOPONERROR 0x04
|
||||
#endif
|
||||
#define TCL_ENCODING_STOPONERROR 0x0 /* Not used any more */
|
||||
#define TCL_ENCODING_NO_TERMINATE 0x08
|
||||
#define TCL_ENCODING_CHAR_LIMIT 0x10
|
||||
/* Internal use bits, do not define bits in this space. See above comment */
|
||||
@@ -2022,11 +1927,7 @@ typedef struct Tcl_EncodingType {
|
||||
#define TCL_ENCODING_PROFILE_TCL8 0x01000000
|
||||
#define TCL_ENCODING_PROFILE_STRICT 0x02000000
|
||||
#define TCL_ENCODING_PROFILE_REPLACE 0x03000000
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8
|
||||
#else
|
||||
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8
|
||||
#endif
|
||||
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_STRICT
|
||||
|
||||
/*
|
||||
* The following definitions are the error codes returned by the conversion
|
||||
@@ -2060,18 +1961,15 @@ typedef struct Tcl_EncodingType {
|
||||
|
||||
/*
|
||||
* The maximum number of bytes that are necessary to represent a single
|
||||
* Unicode character in UTF-8. The valid values are 3 and 4. If > 3,
|
||||
* 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 4-bytes in size (UCS-4) (the default). If == 3,
|
||||
* then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
|
||||
* mode is the default and recommended mode.
|
||||
*/
|
||||
|
||||
#ifndef TCL_UTF_MAX
|
||||
# if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_UTF_MAX 4
|
||||
# else
|
||||
# define TCL_UTF_MAX 3
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -2079,16 +1977,12 @@ typedef struct Tcl_EncodingType {
|
||||
* reflected in regcustom.h.
|
||||
*/
|
||||
|
||||
#if TCL_UTF_MAX > 3
|
||||
/*
|
||||
* int isn't 100% accurate as it should be a strict 4-byte value
|
||||
* (perhaps int32_t). ILP64/SILP64 systems may have troubles. The
|
||||
* size of this value must be reflected correctly in regcustom.h.
|
||||
*/
|
||||
/*
|
||||
* int isn't 100% accurate as it should be a strict 4-byte value
|
||||
* (perhaps int32_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
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -2260,6 +2154,7 @@ typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp,
|
||||
#define TCL_IO_FAILURE ((Tcl_Size)-1)
|
||||
#define TCL_AUTO_LENGTH ((Tcl_Size)-1)
|
||||
#define TCL_INDEX_NONE ((Tcl_Size)-1)
|
||||
#define TCL_LENGTH_NONE ((Tcl_Size)-1)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -2275,11 +2170,7 @@ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,
|
||||
* stubs tables.
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *))
|
||||
#else
|
||||
# define TCL_STUB_MAGIC ((int) 0xFCA3BACF)
|
||||
#endif
|
||||
#define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *))
|
||||
|
||||
/*
|
||||
* The following function is required to be defined in all stubs aware
|
||||
@@ -2301,19 +2192,7 @@ void * TclStubCall(void *arg);
|
||||
#endif
|
||||
|
||||
#ifdef USE_TCL_STUBS
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
# if TCL_UTF_MAX < 4
|
||||
# define Tcl_InitStubs(interp, version, exact) \
|
||||
(Tcl_InitStubs)(interp, version, \
|
||||
(exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
|
||||
TCL_STUB_MAGIC)
|
||||
# else
|
||||
# define Tcl_InitStubs(interp, version, exact) \
|
||||
(Tcl_InitStubs)(interp, "8.7.0", \
|
||||
(exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
|
||||
TCL_STUB_MAGIC)
|
||||
# endif
|
||||
#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
|
||||
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
|
||||
# define Tcl_InitStubs(interp, version, exact) \
|
||||
(Tcl_InitStubs)(interp, version, \
|
||||
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
|
||||
@@ -2325,9 +2204,7 @@ void * TclStubCall(void *arg);
|
||||
TCL_STUB_MAGIC)
|
||||
#endif
|
||||
#else
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
# error "Please define -DUSE_TCL_STUBS"
|
||||
#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
|
||||
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
|
||||
# define Tcl_InitStubs(interp, version, exact) \
|
||||
Tcl_PkgInitStubsCheck(interp, version, \
|
||||
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
|
||||
@@ -2359,9 +2236,6 @@ EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp,
|
||||
const char *prefix,
|
||||
Tcl_LibraryInitProc *initProc,
|
||||
Tcl_LibraryInitProc *safeInitProc);
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# define Tcl_StaticPackage Tcl_StaticLibrary
|
||||
#endif
|
||||
EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
|
||||
#ifdef _WIN32
|
||||
EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv);
|
||||
@@ -2376,7 +2250,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
|
||||
EXTERN TCL_NORETURN void Tcl_MainExW(Tcl_Size argc, wchar_t **argv,
|
||||
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
|
||||
#endif
|
||||
#if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8)
|
||||
#if defined(USE_TCL_STUBS)
|
||||
#define Tcl_SetPanicProc(panicProc) \
|
||||
TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc))
|
||||
#define Tcl_InitSubsystems() \
|
||||
@@ -2473,25 +2347,6 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
|
||||
# undef Tcl_IsShared
|
||||
# define Tcl_IsShared(objPtr) \
|
||||
Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
|
||||
/*
|
||||
* Free the Obj by effectively doing:
|
||||
*
|
||||
* Tcl_IncrRefCount(objPtr);
|
||||
* Tcl_DecrRefCount(objPtr);
|
||||
*
|
||||
* This will free the obj if there are no references to the obj.
|
||||
*/
|
||||
# define Tcl_BounceRefCount(objPtr) \
|
||||
TclBounceRefCount(objPtr, __FILE__, __LINE__)
|
||||
|
||||
static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line)
|
||||
{
|
||||
if (objPtr) {
|
||||
if ((objPtr)->refCount == 0) {
|
||||
Tcl_DbDecrRefCount(objPtr, fn, line);
|
||||
}
|
||||
}
|
||||
}
|
||||
#else
|
||||
# undef Tcl_IncrRefCount
|
||||
# define Tcl_IncrRefCount(objPtr) \
|
||||
@@ -2511,24 +2366,6 @@ static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line)
|
||||
# undef Tcl_IsShared
|
||||
# define Tcl_IsShared(objPtr) \
|
||||
((objPtr)->refCount > 1)
|
||||
|
||||
/*
|
||||
* Declare that obj will no longer be used or referenced.
|
||||
* This will release the obj if there is no referece count,
|
||||
* otherwise let it be.
|
||||
*/
|
||||
# define Tcl_BounceRefCount(objPtr) \
|
||||
TclBounceRefCount(objPtr);
|
||||
|
||||
static inline void TclBounceRefCount(Tcl_Obj* objPtr)
|
||||
{
|
||||
if (objPtr) {
|
||||
if ((objPtr)->refCount == 0) {
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
|
||||
+352
-445
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,48 @@
|
||||
/*
|
||||
* tclArithSeries.h --
|
||||
*
|
||||
* This file contains the ArithSeries concrete abstract list
|
||||
* implementation. It implements the inner workings of the lseq command.
|
||||
*
|
||||
* Copyright © 2022 Brian S. Griffin.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
/*
|
||||
* The structure used for the ArithSeries internal representation.
|
||||
* Note that the len can in theory be always computed by start,end,step
|
||||
* but it's faster to cache it inside the internal representation.
|
||||
*/
|
||||
typedef struct {
|
||||
Tcl_WideInt len;
|
||||
Tcl_Obj **elements;
|
||||
int isDouble;
|
||||
Tcl_WideInt start;
|
||||
Tcl_WideInt end;
|
||||
Tcl_WideInt step;
|
||||
} ArithSeries;
|
||||
typedef struct {
|
||||
Tcl_WideInt len;
|
||||
Tcl_Obj **elements;
|
||||
int isDouble;
|
||||
double start;
|
||||
double end;
|
||||
double step;
|
||||
int precision;
|
||||
} ArithSeriesDbl;
|
||||
|
||||
|
||||
MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp,
|
||||
Tcl_Obj **arithSeriesObj, int useDoubles,
|
||||
Tcl_Obj *startObj, Tcl_Obj *endObj,
|
||||
Tcl_Obj *stepObj, Tcl_Obj *lenObj);
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
* c-basic-offset: 4
|
||||
* fill-column: 78
|
||||
* End:
|
||||
*/
|
||||
@@ -224,7 +224,7 @@ typedef struct AssemblyEnv {
|
||||
* offsets of the labels. */
|
||||
Tcl_Size cmdLine; /* Current line number within the assembly
|
||||
* code */
|
||||
Tcl_Size* clNext; /* Invisible continuation line for
|
||||
int* clNext; /* Invisible continuation line for
|
||||
* [info frame] */
|
||||
BasicBlock* head_bb; /* First basic block in the code */
|
||||
BasicBlock* curr_bb; /* Current basic block */
|
||||
|
||||
+25
-22
@@ -5147,7 +5147,7 @@ TclEvalEx(
|
||||
* evaluation of the script. Only
|
||||
* TCL_EVAL_GLOBAL is currently supported. */
|
||||
Tcl_Size line, /* The line the script starts on. */
|
||||
Tcl_Size *clNextOuter, /* Information about an outer context for */
|
||||
int *clNextOuter, /* Information about an outer context for */
|
||||
const char *outerScript) /* continuation line data. This is set only in
|
||||
* TclSubstTokens(), to properly handle
|
||||
* [...]-nested commands. The 'outerScript'
|
||||
@@ -5169,8 +5169,7 @@ TclEvalEx(
|
||||
const char *p, *next;
|
||||
const int minObjs = 20;
|
||||
Tcl_Obj **objv, **objvSpace;
|
||||
int *expand;
|
||||
Tcl_Size *lines, *lineSpace;
|
||||
int *expand, *lines, *lineSpace;
|
||||
Tcl_Token *tokenPtr;
|
||||
int expandRequested, code = TCL_OK;
|
||||
Tcl_Size bytesLeft, commandLength;
|
||||
@@ -5188,10 +5187,10 @@ TclEvalEx(
|
||||
Tcl_Obj **stackObjArray = (Tcl_Obj **)
|
||||
TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
|
||||
int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
|
||||
Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size));
|
||||
int *linesStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
|
||||
/* TIP #280 Structures for tracking of command
|
||||
* locations. */
|
||||
Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible
|
||||
int *clNext = NULL; /* Pointer for the tracking of invisible
|
||||
* continuation lines. Initialized only if the
|
||||
* caller gave us a table of locations to
|
||||
* track, via scriptCLLocPtr. It always refers
|
||||
@@ -5315,7 +5314,7 @@ TclEvalEx(
|
||||
|
||||
Tcl_Size wordLine = line;
|
||||
const char *wordStart = parsePtr->commandStart;
|
||||
Tcl_Size *wordCLNext = clNext;
|
||||
int *wordCLNext = clNext;
|
||||
Tcl_Size objectsNeeded = 0;
|
||||
Tcl_Size numWords = parsePtr->numWords;
|
||||
|
||||
@@ -5326,7 +5325,7 @@ TclEvalEx(
|
||||
if (numWords > minObjs) {
|
||||
expand = (int *)Tcl_Alloc(numWords * sizeof(int));
|
||||
objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *));
|
||||
lineSpace = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
|
||||
lineSpace = (int *)Tcl_Alloc(numWords * sizeof(int));
|
||||
}
|
||||
expandRequested = 0;
|
||||
objv = objvSpace;
|
||||
@@ -5352,7 +5351,7 @@ TclEvalEx(
|
||||
wordStart = tokenPtr->start;
|
||||
|
||||
lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
|
||||
? wordLine : -1;
|
||||
? (int)wordLine : -1;
|
||||
|
||||
if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
|
||||
iPtr->evalFlags |= TCL_EVAL_FILE;
|
||||
@@ -5418,14 +5417,14 @@ TclEvalEx(
|
||||
*/
|
||||
|
||||
Tcl_Obj **copy = objvSpace;
|
||||
Tcl_Size *lcopy = lineSpace;
|
||||
Tcl_Size wordIdx = numWords;
|
||||
Tcl_Size objIdx = objectsNeeded - 1;
|
||||
int *lcopy = lineSpace;
|
||||
int wordIdx = numWords;
|
||||
int objIdx = objectsNeeded - 1;
|
||||
|
||||
if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
|
||||
objv = objvSpace =
|
||||
(Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *));
|
||||
lines = lineSpace = (Tcl_Size *)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size));
|
||||
lines = lineSpace = (int *)Tcl_Alloc(objectsNeeded * sizeof(int));
|
||||
}
|
||||
|
||||
objectsUsed = 0;
|
||||
@@ -5660,7 +5659,7 @@ TclAdvanceLines(
|
||||
void
|
||||
TclAdvanceContinuations(
|
||||
Tcl_Size *line,
|
||||
Tcl_Size **clNextPtrPtr,
|
||||
int **clNextPtrPtr,
|
||||
int loc)
|
||||
{
|
||||
/*
|
||||
@@ -5838,7 +5837,7 @@ TclArgumentBCEnter(
|
||||
int objc,
|
||||
void *codePtr,
|
||||
CmdFrame *cfPtr,
|
||||
Tcl_Size cmd,
|
||||
int cmd,
|
||||
Tcl_Size pc)
|
||||
{
|
||||
ExtCmdLoc *eclPtr;
|
||||
@@ -6153,7 +6152,11 @@ TclNREvalObjEx(
|
||||
*/
|
||||
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
listPtr = TclListObjCopy(interp, objPtr);
|
||||
listPtr = TclDuplicatePureObj(interp, objPtr, tclListType);
|
||||
if (!listPtr) {
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_IncrRefCount(listPtr);
|
||||
|
||||
if (word != INT_MIN) {
|
||||
@@ -7047,7 +7050,7 @@ ExprCeilFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
@@ -7087,7 +7090,7 @@ ExprFloorFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
@@ -7233,7 +7236,7 @@ ExprSqrtFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
@@ -7287,7 +7290,7 @@ ExprUnaryFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
d = irPtr->doubleValue;
|
||||
@@ -7351,7 +7354,7 @@ ExprBinaryFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
d1 = irPtr->doubleValue;
|
||||
@@ -7366,7 +7369,7 @@ ExprBinaryFunc(
|
||||
code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
|
||||
#ifdef ACCEPT_NAN
|
||||
if (code != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
|
||||
|
||||
if (irPtr) {
|
||||
d2 = irPtr->doubleValue;
|
||||
@@ -7527,7 +7530,7 @@ ExprDoubleFunc(
|
||||
}
|
||||
if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
|
||||
#ifdef ACCEPT_NAN
|
||||
if (TclHasInternalRep(objv[1], &tclDoubleType)) {
|
||||
if (TclHasInternalRep(objv[1], tclDoubleType)) {
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
+7
-36
@@ -381,35 +381,6 @@ Tcl_GetBytesFromObj(
|
||||
return baPtr->bytes;
|
||||
}
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED)
|
||||
unsigned char *
|
||||
TclGetBytesFromObj(
|
||||
Tcl_Interp *interp, /* For error reporting */
|
||||
Tcl_Obj *objPtr, /* Value to extract from */
|
||||
void *numBytesPtr) /* If non-NULL, write the number of bytes
|
||||
* in the array here */
|
||||
{
|
||||
Tcl_Size numBytes = 0;
|
||||
unsigned char *bytes = Tcl_GetBytesFromObj(interp, objPtr, &numBytes);
|
||||
|
||||
if (bytes && numBytesPtr) {
|
||||
if (numBytes > INT_MAX) {
|
||||
/* Caller asked for numBytes to be written to an int, but the
|
||||
* value is outside the int range. */
|
||||
|
||||
if (interp) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"byte sequence length exceeds INT_MAX", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", NULL);
|
||||
}
|
||||
return NULL;
|
||||
} else {
|
||||
*(int *)numBytesPtr = (int) numBytes;
|
||||
}
|
||||
}
|
||||
return bytes;
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -509,7 +480,7 @@ MakeByteArray(
|
||||
|
||||
for (; src < srcEnd && dst < dstEnd; ) {
|
||||
int ch;
|
||||
int count = TclUtfToUCS4(src, &ch);
|
||||
int count = Tcl_UtfToUniChar(src, &ch);
|
||||
|
||||
if (ch > 255) {
|
||||
proper = 0;
|
||||
@@ -2001,7 +1972,7 @@ FormatNumber(
|
||||
*/
|
||||
|
||||
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleType);
|
||||
if (irPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -2021,7 +1992,7 @@ FormatNumber(
|
||||
*/
|
||||
|
||||
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
|
||||
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleType);
|
||||
|
||||
if (irPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
@@ -2561,7 +2532,7 @@ BinaryDecodeHex(
|
||||
if (pure) {
|
||||
ucs4 = c;
|
||||
} else {
|
||||
TclUtfToUCS4((const char *)(data - 1), &ucs4);
|
||||
Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
|
||||
}
|
||||
TclDecrRefCount(resultObj);
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
@@ -2629,7 +2600,7 @@ BinaryEncode64(
|
||||
}
|
||||
switch (index) {
|
||||
case OPT_MAXLEN:
|
||||
if (TclGetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
|
||||
if (Tcl_GetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (maxlen < 0) {
|
||||
@@ -3026,7 +2997,7 @@ BinaryDecodeUu(
|
||||
if (pure) {
|
||||
ucs4 = c;
|
||||
} else {
|
||||
TclUtfToUCS4((const char *)(data - 1), &ucs4);
|
||||
Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"invalid uuencode character \"%c\" (U+%06X) at position %"
|
||||
@@ -3201,7 +3172,7 @@ BinaryDecode64(
|
||||
* of a multi-byte character. */
|
||||
|
||||
/* Safe because we know data is NUL-terminated */
|
||||
TclUtfToUCS4((const char *)(data - 1), &ucs4);
|
||||
Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
|
||||
+1
-1
@@ -433,7 +433,7 @@ ClockGetdatefieldsObjCmd(
|
||||
* that it isn't.
|
||||
*/
|
||||
|
||||
if (TclHasInternalRep(objv[1], &tclBignumType)) {
|
||||
if (TclHasInternalRep(objv[1], tclBignumType)) {
|
||||
Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
+61
-51
@@ -434,7 +434,7 @@ EncodingConvertParseOptions (
|
||||
Tcl_Encoding encoding;
|
||||
Tcl_Obj *dataObj;
|
||||
Tcl_Obj *failVarObj;
|
||||
int profile = TCL_ENCODING_PROFILE_TCL8;
|
||||
int profile = TCL_ENCODING_PROFILE_STRICT;
|
||||
|
||||
/*
|
||||
* Possible combinations:
|
||||
@@ -551,11 +551,11 @@ EncodingConvertfromObjCmd(
|
||||
/* NOTE: ds must be freed beyond this point even on error */
|
||||
switch (result) {
|
||||
case TCL_OK:
|
||||
errorLocation = TCL_INDEX_NONE;
|
||||
break;
|
||||
errorLocation = TCL_INDEX_NONE;
|
||||
break;
|
||||
case TCL_ERROR:
|
||||
/* Error in parameters. Should not happen. interp will have error */
|
||||
Tcl_DStringFree(&ds);
|
||||
Tcl_DStringFree(&ds);
|
||||
return TCL_ERROR;
|
||||
default:
|
||||
/*
|
||||
@@ -565,10 +565,10 @@ EncodingConvertfromObjCmd(
|
||||
* what could be decoded and the returned error location.
|
||||
*/
|
||||
if (failVarObj == NULL) {
|
||||
Tcl_DStringFree(&ds);
|
||||
Tcl_DStringFree(&ds);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
break;
|
||||
break;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -653,7 +653,7 @@ EncodingConverttoObjCmd(
|
||||
break;
|
||||
case TCL_ERROR:
|
||||
/* Error in parameters. Should not happen. interp will have error */
|
||||
Tcl_DStringFree(&ds);
|
||||
Tcl_DStringFree(&ds);
|
||||
return TCL_ERROR;
|
||||
default:
|
||||
/*
|
||||
@@ -663,10 +663,10 @@ EncodingConverttoObjCmd(
|
||||
* what could be decoded and the returned error location.
|
||||
*/
|
||||
if (failVarObj == NULL) {
|
||||
Tcl_DStringFree(&ds);
|
||||
Tcl_DStringFree(&ds);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
break;
|
||||
break;
|
||||
}
|
||||
/*
|
||||
* TCL_OK or a TCL_CONVERT_* error where the caller wants back as much
|
||||
@@ -1199,10 +1199,10 @@ FileAttrAccessTimeCmd(
|
||||
#if defined(_WIN32)
|
||||
/* We use a value of 0 to indicate the access time not available */
|
||||
if (Tcl_GetAccessTimeFromStat(&buf) == 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"could not get access time for file \"%s\"",
|
||||
TclGetString(objv[1])));
|
||||
return TCL_ERROR;
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"could not get access time for file \"%s\"",
|
||||
TclGetString(objv[1])));
|
||||
return TCL_ERROR;
|
||||
}
|
||||
#endif
|
||||
|
||||
@@ -1281,10 +1281,10 @@ FileAttrModifyTimeCmd(
|
||||
#if defined(_WIN32)
|
||||
/* We use a value of 0 to indicate the modification time not available */
|
||||
if (Tcl_GetModificationTimeFromStat(&buf) == 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"could not get modification time for file \"%s\"",
|
||||
TclGetString(objv[1])));
|
||||
return TCL_ERROR;
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"could not get modification time for file \"%s\"",
|
||||
TclGetString(objv[1])));
|
||||
return TCL_ERROR;
|
||||
}
|
||||
#endif
|
||||
if (objc == 3) {
|
||||
@@ -2324,34 +2324,34 @@ StoreStatData(
|
||||
unsigned short mode;
|
||||
|
||||
if (varName == NULL) {
|
||||
TclNewObj(result);
|
||||
Tcl_IncrRefCount(result);
|
||||
TclNewObj(result);
|
||||
Tcl_IncrRefCount(result);
|
||||
#define DOBJPUT(key, objValue) \
|
||||
Tcl_DictObjPut(NULL, result, \
|
||||
Tcl_NewStringObj((key), -1), \
|
||||
(objValue));
|
||||
DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev));
|
||||
DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
|
||||
DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink));
|
||||
DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid));
|
||||
DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid));
|
||||
DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
|
||||
DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev));
|
||||
DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
|
||||
DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink));
|
||||
DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid));
|
||||
DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid));
|
||||
DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
|
||||
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
|
||||
DOBJPUT("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
|
||||
DOBJPUT("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
|
||||
#endif
|
||||
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
|
||||
DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
|
||||
DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
|
||||
#endif
|
||||
DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
|
||||
DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
|
||||
DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
|
||||
mode = (unsigned short) statPtr->st_mode;
|
||||
DOBJPUT("mode", Tcl_NewWideIntObj(mode));
|
||||
DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
|
||||
DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
|
||||
DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
|
||||
DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
|
||||
mode = (unsigned short) statPtr->st_mode;
|
||||
DOBJPUT("mode", Tcl_NewWideIntObj(mode));
|
||||
DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
|
||||
#undef DOBJPUT
|
||||
Tcl_SetObjResult(interp, result);
|
||||
Tcl_DecrRefCount(result);
|
||||
return TCL_OK;
|
||||
Tcl_SetObjResult(interp, result);
|
||||
Tcl_DecrRefCount(result);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2787,8 +2787,9 @@ EachloopCmd(
|
||||
for (i=0 ; i<numLists ; i++) {
|
||||
/* List */
|
||||
/* Variables */
|
||||
statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
|
||||
if (statePtr->vCopyList[i] == NULL) {
|
||||
statePtr->vCopyList[i] = TclDuplicatePureObj(
|
||||
interp, objv[1+i*2], tclListType);
|
||||
if (!statePtr->vCopyList[i]) {
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
@@ -2812,19 +2813,26 @@ EachloopCmd(
|
||||
&statePtr->varcList[i], &statePtr->varvList[i]);
|
||||
|
||||
/* Values */
|
||||
if (TclObjTypeHasProc(objv[2+i*2],indexProc)) {
|
||||
/* Special case for AbstractList */
|
||||
if (TclObjectHasInterface(objv[2+i*2], list, length)) {
|
||||
int status;
|
||||
statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
|
||||
Tcl_IncrRefCount(statePtr->aCopyList[i]);
|
||||
if (statePtr->aCopyList[i] == NULL) {
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
/* Don't compute values here, wait until the last moment */
|
||||
statePtr->argcList[i] = TclObjTypeLength(statePtr->aCopyList[i]);
|
||||
TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
|
||||
length, interp, statePtr->aCopyList[i], &statePtr->argcList[i]);
|
||||
if (status != TCL_OK) {
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
} else {
|
||||
/* List values */
|
||||
statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
|
||||
if (statePtr->aCopyList[i] == NULL) {
|
||||
statePtr->aCopyList[i] = TclDuplicatePureObj(
|
||||
interp, objv[2+i*2], tclListType);
|
||||
if (!statePtr->aCopyList[i]) {
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
@@ -2961,18 +2969,20 @@ ForeachAssignments(
|
||||
Tcl_Obj *valuePtr, *varValuePtr;
|
||||
|
||||
for (i=0 ; i<statePtr->numLists ; i++) {
|
||||
int isAbstractList =
|
||||
TclObjTypeHasProc(statePtr->aCopyList[i],indexProc) != NULL;
|
||||
|
||||
TCL_UNUSEDVAR(int status);
|
||||
int hasindexinterface = TclObjectHasInterface(
|
||||
statePtr->aCopyList[i], list, index);
|
||||
for (v=0 ; v<statePtr->varcList[i] ; v++) {
|
||||
k = statePtr->index[i]++;
|
||||
if (k < statePtr->argcList[i]) {
|
||||
if (isAbstractList) {
|
||||
if (TclObjTypeIndex(interp, statePtr->aCopyList[i], k, &valuePtr) != TCL_OK) {
|
||||
if (hasindexinterface) {
|
||||
TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
|
||||
index, interp, statePtr->aCopyList[i], k, &valuePtr);
|
||||
if (valuePtr == NULL) {
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (setting %s loop variable \"%s\")",
|
||||
(statePtr->resultList != NULL ? "lmap" : "foreach"),
|
||||
TclGetString(statePtr->varvList[i][v])));
|
||||
"\n (setting %s loop variable \"%s\")",
|
||||
(statePtr->resultList != NULL ? "lmap" : "foreach"),
|
||||
TclGetString(statePtr->varvList[i][v])));
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
|
||||
+407
-247
File diff suppressed because it is too large
Load Diff
+94
-56
@@ -24,6 +24,7 @@
|
||||
|
||||
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
|
||||
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
|
||||
|
||||
static Tcl_NRPostProc SwitchPostProc;
|
||||
static Tcl_NRPostProc TryPostBody;
|
||||
static Tcl_NRPostProc TryPostFinal;
|
||||
@@ -1192,11 +1193,6 @@ Tcl_SplitObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (splitCharLen == 0) {
|
||||
Tcl_SetObjResult(interp, TclNewStringListObj(interp, objv[1]));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen);
|
||||
end = stringPtr + stringLen;
|
||||
TclNewObj(listPtr);
|
||||
@@ -1205,6 +1201,40 @@ Tcl_SplitObjCmd(
|
||||
/*
|
||||
* Do nothing.
|
||||
*/
|
||||
} else if (splitCharLen == 0) {
|
||||
Tcl_HashTable charReuseTable;
|
||||
Tcl_HashEntry *hPtr;
|
||||
int isNew;
|
||||
|
||||
/*
|
||||
* Handle the special case of splitting on every character.
|
||||
*
|
||||
* Uses a hash table to ensure that each kind of character has only
|
||||
* one Tcl_Obj instance (multiply-referenced) in the final list. This
|
||||
* is a *major* win when splitting on a long string (especially in the
|
||||
* megabyte range!) - DKF
|
||||
*/
|
||||
|
||||
Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
|
||||
|
||||
for ( ; stringPtr < end; stringPtr += len) {
|
||||
len = Tcl_UtfToUniChar(stringPtr, &ch);
|
||||
hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(ch), &isNew);
|
||||
if (isNew) {
|
||||
TclNewStringObj(objPtr, stringPtr, len);
|
||||
|
||||
/*
|
||||
* Don't need to fiddle with refcount...
|
||||
*/
|
||||
|
||||
Tcl_SetHashValue(hPtr, objPtr);
|
||||
} else {
|
||||
objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
|
||||
}
|
||||
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
|
||||
}
|
||||
Tcl_DeleteHashTable(&charReuseTable);
|
||||
|
||||
} else if (splitCharLen == 1) {
|
||||
const char *p;
|
||||
|
||||
@@ -1234,9 +1264,9 @@ Tcl_SplitObjCmd(
|
||||
splitEnd = splitChars + splitCharLen;
|
||||
|
||||
for (element = stringPtr; stringPtr < end; stringPtr += len) {
|
||||
len = TclUtfToUCS4(stringPtr, &ch);
|
||||
len = Tcl_UtfToUniChar(stringPtr, &ch);
|
||||
for (p = splitChars; p < splitEnd; p += splitLen) {
|
||||
splitLen = TclUtfToUCS4(p, &splitChar);
|
||||
splitLen = Tcl_UtfToUniChar(p, &splitChar);
|
||||
if (ch == splitChar) {
|
||||
TclNewStringObj(objPtr, element, stringPtr - element);
|
||||
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
|
||||
@@ -1282,7 +1312,7 @@ StringFirstCmd(
|
||||
|
||||
if (objc < 3 || objc > 4) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
"needleString haystackString ?startIndex?");
|
||||
"needleString haystackString ?startIndex?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -1373,44 +1403,51 @@ StringIndexCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Get the char length to calculate what 'end' means.
|
||||
*/
|
||||
|
||||
end = Tcl_GetCharLength(objv[1]) - 1;
|
||||
if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if ((index >= 0) && (index <= end)) {
|
||||
int ch = Tcl_GetUniChar(objv[1], index);
|
||||
|
||||
if (ch == -1) {
|
||||
if (TclObjectHasInterface(objv[1], string, index)) {
|
||||
int status;
|
||||
Tcl_Obj *charPtr;
|
||||
status = TclStringIndexInterface(interp, objv[1], objv[2], &charPtr) ;
|
||||
if (status != TCL_OK) {
|
||||
return status;
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, charPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
} else {
|
||||
/*
|
||||
* If we have a ByteArray object, we're careful to generate a new
|
||||
* bytearray for a result.
|
||||
* Get the char length to calculate what 'end' means.
|
||||
*/
|
||||
|
||||
if (TclIsPureByteArray(objv[1])) {
|
||||
unsigned char uch = UCHAR(ch);
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
|
||||
} else {
|
||||
char buf[4] = "";
|
||||
|
||||
end = Tcl_UniCharToUtf(ch, buf);
|
||||
#if TCL_UTF_MAX < 4
|
||||
if ((ch >= 0xD800) && (end < 3)) {
|
||||
end += Tcl_UniCharToUtf(-1, buf + end);
|
||||
}
|
||||
#endif
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
|
||||
end = Tcl_GetCharLength(objv[1]) - 1;
|
||||
if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if ((index >= 0) && (index <= end)) {
|
||||
int ch = Tcl_GetUniChar(objv[1], index);
|
||||
|
||||
if (ch == -1) {
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* If we have a ByteArray object, we're careful to generate a new
|
||||
* bytearray for a result.
|
||||
*/
|
||||
|
||||
if (TclIsPureByteArray(objv[1])) {
|
||||
unsigned char uch = UCHAR(ch);
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
|
||||
} else {
|
||||
char buf[4] = "";
|
||||
|
||||
end = Tcl_UniCharToUtf(ch, buf);
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
|
||||
}
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1583,7 +1620,7 @@ StringIsCmd(
|
||||
case STR_IS_BOOL:
|
||||
case STR_IS_TRUE:
|
||||
case STR_IS_FALSE:
|
||||
if (!TclHasInternalRep(objPtr, &tclBooleanType)
|
||||
if (!TclHasInternalRep(objPtr, tclBooleanType)
|
||||
&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
|
||||
if (strict) {
|
||||
result = 0;
|
||||
@@ -1652,9 +1689,9 @@ StringIsCmd(
|
||||
chcomp = Tcl_UniCharIsDigit;
|
||||
break;
|
||||
case STR_IS_DOUBLE: {
|
||||
if (TclHasInternalRep(objPtr, &tclDoubleType) ||
|
||||
TclHasInternalRep(objPtr, &tclIntType) ||
|
||||
TclHasInternalRep(objPtr, &tclBignumType)) {
|
||||
if (TclHasInternalRep(objPtr, tclDoubleType) ||
|
||||
TclHasInternalRep(objPtr, tclIntType) ||
|
||||
TclHasInternalRep(objPtr, tclBignumType)) {
|
||||
break;
|
||||
}
|
||||
string1 = Tcl_GetStringFromObj(objPtr, &length1);
|
||||
@@ -1683,8 +1720,8 @@ StringIsCmd(
|
||||
break;
|
||||
case STR_IS_INT:
|
||||
case STR_IS_ENTIER:
|
||||
if (TclHasInternalRep(objPtr, &tclIntType) ||
|
||||
TclHasInternalRep(objPtr, &tclBignumType)) {
|
||||
if (TclHasInternalRep(objPtr, tclIntType) ||
|
||||
TclHasInternalRep(objPtr, tclBignumType)) {
|
||||
break;
|
||||
}
|
||||
string1 = Tcl_GetStringFromObj(objPtr, &length1);
|
||||
@@ -1867,7 +1904,7 @@ StringIsCmd(
|
||||
for (; string1 < end; string1 += length2, failat++) {
|
||||
int ucs4;
|
||||
|
||||
length2 = TclUtfToUCS4(string1, &ucs4);
|
||||
length2 = Tcl_UtfToUniChar(string1, &ucs4);
|
||||
if (!chcomp(ucs4)) {
|
||||
result = 0;
|
||||
break;
|
||||
@@ -2495,7 +2532,7 @@ StringStartCmd(
|
||||
if (index > 0) {
|
||||
p = &string[index];
|
||||
|
||||
(void)TclUniCharToUCS4(p, &ch);
|
||||
ch = *p;
|
||||
for (cur = index; cur != TCL_INDEX_NONE; cur--) {
|
||||
int delta = 0;
|
||||
const Tcl_UniChar *next;
|
||||
@@ -2504,10 +2541,11 @@ StringStartCmd(
|
||||
break;
|
||||
}
|
||||
|
||||
next = TclUCS4Prev(p, string);
|
||||
next = p > string ? p - 1 : p;
|
||||
do {
|
||||
next += delta;
|
||||
delta = TclUniCharToUCS4(next, &ch);
|
||||
delta = 1;
|
||||
ch = *next;
|
||||
} while (next + delta < p);
|
||||
p = next;
|
||||
}
|
||||
@@ -2565,7 +2603,7 @@ StringEndCmd(
|
||||
p = &string[index];
|
||||
end = string+length;
|
||||
for (cur = index; p < end; cur++) {
|
||||
p += TclUniCharToUCS4(p, &ch);
|
||||
ch = *p++;
|
||||
if (!Tcl_UniCharIsWordChar(ch)) {
|
||||
break;
|
||||
}
|
||||
@@ -3819,7 +3857,7 @@ TclNRSwitchObjCmd(
|
||||
if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
|
||||
int bline = ctxPtr->line[bidx];
|
||||
|
||||
ctxPtr->line = (Tcl_Size *)Tcl_Alloc(objc * sizeof(Tcl_Size));
|
||||
ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
|
||||
ctxPtr->nline = objc;
|
||||
TclListLines(blist, bline, objc, ctxPtr->line, objv);
|
||||
} else {
|
||||
@@ -3833,7 +3871,7 @@ TclNRSwitchObjCmd(
|
||||
|
||||
int k;
|
||||
|
||||
ctxPtr->line = (Tcl_Size *)Tcl_Alloc(objc * sizeof(Tcl_Size));
|
||||
ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
|
||||
ctxPtr->nline = objc;
|
||||
for (k=0; k < objc; k++) {
|
||||
ctxPtr->line[k] = -1;
|
||||
@@ -5273,17 +5311,17 @@ TclListLines(
|
||||
* structure. Assumed to be valid. Assumed to
|
||||
* contain n elements. */
|
||||
Tcl_Size line, /* Line the list as a whole starts on. */
|
||||
Tcl_Size n, /* #elements in lines */
|
||||
Tcl_Size *lines, /* Array of line numbers, to fill. */
|
||||
int n, /* #elements in lines */
|
||||
int *lines, /* Array of line numbers, to fill. */
|
||||
Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of
|
||||
* derived continuation data */
|
||||
{
|
||||
const char *listStr = TclGetString(listObj);
|
||||
const char *listHead = listStr;
|
||||
Tcl_Size i, length = strlen(listStr);
|
||||
int i, length = strlen(listStr);
|
||||
const char *element = NULL, *next = NULL;
|
||||
ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
|
||||
Tcl_Size *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
|
||||
int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
|
||||
|
||||
for (i = 0; i < n; i++) {
|
||||
TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
|
||||
|
||||
@@ -41,7 +41,7 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp,
|
||||
*
|
||||
* Side effects:
|
||||
* When TCL_OK is returned, the encoded index value is written
|
||||
* to *index.
|
||||
* to *indexPtr.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1411,6 +1411,13 @@ TclCompileLreplaceCmd(
|
||||
Tcl_Token *tokenPtr;
|
||||
int i;
|
||||
|
||||
/*
|
||||
* For now, disable compilation of lreplace. Figure out later if any
|
||||
* compilation can be done given that any Tcl_ObjType may implement
|
||||
* lreplace, and should return an object of the same type.
|
||||
*/
|
||||
return TCL_ERROR;
|
||||
|
||||
if (parsePtr->numWords < 4) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
+16
-16
@@ -41,12 +41,12 @@ static int CompileUnaryOpCmd(Tcl_Interp *interp,
|
||||
CompileEnv *envPtr);
|
||||
static void IssueSwitchChainedTests(Tcl_Interp *interp,
|
||||
CompileEnv *envPtr, int mode, int noCase,
|
||||
Tcl_Size numWords, Tcl_Token **bodyToken,
|
||||
Tcl_Size *bodyLines, Tcl_Size **bodyNext);
|
||||
int numWords, Tcl_Token **bodyToken,
|
||||
int *bodyLines, int **bodyNext);
|
||||
static void IssueSwitchJumpTable(Tcl_Interp *interp,
|
||||
CompileEnv *envPtr, int numWords,
|
||||
Tcl_Token **bodyToken, Tcl_Size *bodyLines,
|
||||
Tcl_Size **bodyContLines);
|
||||
Tcl_Token **bodyToken, int *bodyLines,
|
||||
int **bodyContLines);
|
||||
static int IssueTryClausesInstructions(Tcl_Interp *interp,
|
||||
CompileEnv *envPtr, Tcl_Token *bodyToken,
|
||||
int numHandlers, int *matchCodes,
|
||||
@@ -1800,14 +1800,14 @@ TclCompileSwitchCmd(
|
||||
|
||||
Tcl_Token *bodyTokenArray; /* Array of real pattern list items. */
|
||||
Tcl_Token **bodyToken; /* Array of pointers to pattern list items. */
|
||||
Tcl_Size *bodyLines; /* Array of line numbers for body list
|
||||
int *bodyLines; /* Array of line numbers for body list
|
||||
* items. */
|
||||
Tcl_Size **bodyContLines; /* Array of continuation line info. */
|
||||
int **bodyContLines; /* Array of continuation line info. */
|
||||
int noCase; /* Has the -nocase flag been given? */
|
||||
int foundMode = 0; /* Have we seen a mode flag yet? */
|
||||
int i, valueIndex;
|
||||
int result = TCL_ERROR;
|
||||
Tcl_Size *clNext = envPtr->clNext;
|
||||
int *clNext = envPtr->clNext;
|
||||
|
||||
/*
|
||||
* Only handle the following versions:
|
||||
@@ -1964,8 +1964,8 @@ TclCompileSwitchCmd(
|
||||
}
|
||||
bodyTokenArray = (Tcl_Token *)Tcl_Alloc(sizeof(Tcl_Token) * maxLen);
|
||||
bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * maxLen);
|
||||
bodyLines = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size) * maxLen);
|
||||
bodyContLines = (Tcl_Size **)Tcl_Alloc(sizeof(Tcl_Size*) * maxLen);
|
||||
bodyLines = (int *)Tcl_Alloc(sizeof(int) * maxLen);
|
||||
bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * maxLen);
|
||||
|
||||
bline = mapPtr->loc[eclIndex].line[valueIndex+1];
|
||||
numWords = 0;
|
||||
@@ -2025,8 +2025,8 @@ TclCompileSwitchCmd(
|
||||
*/
|
||||
|
||||
bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * numWords);
|
||||
bodyLines = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size) * numWords);
|
||||
bodyContLines = (Tcl_Size **)Tcl_Alloc(sizeof(Tcl_Size*) * numWords);
|
||||
bodyLines = (int *)Tcl_Alloc(sizeof(int) * numWords);
|
||||
bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * numWords);
|
||||
bodyTokenArray = NULL;
|
||||
for (i=0 ; i<numWords ; i++) {
|
||||
/*
|
||||
@@ -2116,13 +2116,13 @@ IssueSwitchChainedTests(
|
||||
CompileEnv *envPtr, /* Holds resulting instructions. */
|
||||
int mode, /* Exact, Glob or Regexp */
|
||||
int noCase, /* Case-insensitivity flag. */
|
||||
Tcl_Size numBodyTokens, /* Number of tokens describing things the
|
||||
int numBodyTokens, /* Number of tokens describing things the
|
||||
* switch can match against and bodies to
|
||||
* execute when the match succeeds. */
|
||||
Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */
|
||||
Tcl_Size *bodyLines, /* Array of line numbers for body list
|
||||
int *bodyLines, /* Array of line numbers for body list
|
||||
* items. */
|
||||
Tcl_Size **bodyContLines) /* Array of continuation line info. */
|
||||
int **bodyContLines) /* Array of continuation line info. */
|
||||
{
|
||||
enum {Switch_Exact, Switch_Glob, Switch_Regexp};
|
||||
int foundDefault; /* Flag to indicate whether a "default" clause
|
||||
@@ -2368,9 +2368,9 @@ IssueSwitchJumpTable(
|
||||
* switch can match against and bodies to
|
||||
* execute when the match succeeds. */
|
||||
Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */
|
||||
Tcl_Size *bodyLines, /* Array of line numbers for body list
|
||||
int *bodyLines, /* Array of line numbers for body list
|
||||
* items. */
|
||||
Tcl_Size **bodyContLines) /* Array of continuation line info. */
|
||||
int **bodyContLines) /* Array of continuation line info. */
|
||||
{
|
||||
JumptableInfo *jtPtr;
|
||||
int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
|
||||
|
||||
@@ -2111,7 +2111,7 @@ ParseLexeme(
|
||||
* Example: Inf + luence + () becomes a valid function call.
|
||||
* [Bug 3401704]
|
||||
*/
|
||||
if (TclHasInternalRep(literal, &tclDoubleType)) {
|
||||
if (TclHasInternalRep(literal, tclDoubleType)) {
|
||||
const char *p = start;
|
||||
|
||||
while (p < end) {
|
||||
@@ -2149,13 +2149,13 @@ ParseLexeme(
|
||||
if (!TclIsBareword(*start) || *start == '_') {
|
||||
Tcl_Size scanned;
|
||||
if (Tcl_UtfCharComplete(start, numBytes)) {
|
||||
scanned = TclUtfToUCS4(start, &ch);
|
||||
scanned = Tcl_UtfToUniChar(start, &ch);
|
||||
} else {
|
||||
char utfBytes[8];
|
||||
|
||||
memcpy(utfBytes, start, numBytes);
|
||||
utfBytes[numBytes] = '\0';
|
||||
scanned = TclUtfToUCS4(utfBytes, &ch);
|
||||
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
|
||||
}
|
||||
*lexemePtr = INVALID;
|
||||
Tcl_DecrRefCount(literal);
|
||||
|
||||
+22
-25
@@ -701,8 +701,7 @@ static void StartExpanding(CompileEnv *envPtr);
|
||||
*/
|
||||
static void EnterCmdWordData(ExtCmdLoc *eclPtr, Tcl_Size srcOffset,
|
||||
Tcl_Token *tokenPtr, const char *cmd,
|
||||
Tcl_Size numWords, Tcl_Size line,
|
||||
Tcl_Size *clNext, Tcl_Size **lines,
|
||||
Tcl_Size numWords, Tcl_Size line, int *clNext, int **lines,
|
||||
CompileEnv *envPtr);
|
||||
static void ReleaseCmdWordData(ExtCmdLoc *eclPtr);
|
||||
|
||||
@@ -1954,8 +1953,7 @@ CompileCmdCompileProc(
|
||||
CompileEnv *envPtr)
|
||||
{
|
||||
DefineLineInformation;
|
||||
int unwind = 0;
|
||||
Tcl_Size incrOffset = -1;
|
||||
int unwind = 0, incrOffset = -1;
|
||||
int depth = TclGetStackDepth(envPtr);
|
||||
|
||||
/*
|
||||
@@ -2042,11 +2040,11 @@ CompileCommandTokens(
|
||||
Command *cmdPtr = NULL;
|
||||
int code = TCL_ERROR;
|
||||
int cmdKnown, expand = -1;
|
||||
Tcl_Size *wlines, wlineat;
|
||||
Tcl_Size cmdLine = envPtr->line;
|
||||
Tcl_Size *clNext = envPtr->clNext;
|
||||
Tcl_Size cmdIdx = envPtr->numCommands;
|
||||
Tcl_Size startCodeOffset = envPtr->codeNext - envPtr->codeStart;
|
||||
int *wlines, wlineat;
|
||||
int cmdLine = envPtr->line;
|
||||
int *clNext = envPtr->clNext;
|
||||
int cmdIdx = envPtr->numCommands;
|
||||
int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
|
||||
int depth = TclGetStackDepth(envPtr);
|
||||
|
||||
assert ((int)parsePtr->numWords > 0);
|
||||
@@ -2196,7 +2194,7 @@ TclCompileScript(
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_ObjPrintf("Script length %" TCL_SIZE_MODIFIER
|
||||
"d exceeds max permitted length %d.",
|
||||
numBytes, INT_MAX-1));
|
||||
numBytes, (int)INT_MAX-1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", NULL);
|
||||
TclCompileSyntaxError(interp, envPtr);
|
||||
return;
|
||||
@@ -2423,20 +2421,19 @@ TclCompileTokens(
|
||||
Tcl_Interp *interp, /* Used for error and status reporting. */
|
||||
Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
|
||||
* compile. */
|
||||
size_t count1, /* Number of tokens to consider at tokenPtr.
|
||||
size_t count1, /* Number of tokens to consider at tokenPtr.
|
||||
* Must be at least 1. */
|
||||
CompileEnv *envPtr) /* Holds the resulting instructions. */
|
||||
{
|
||||
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
|
||||
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
|
||||
char buffer[4] = "";
|
||||
Tcl_Size i, numObjsToConcat, adjust;
|
||||
int i, numObjsToConcat, adjust;
|
||||
size_t length;
|
||||
unsigned char *entryCodeNext = envPtr->codeNext;
|
||||
#define NUM_STATIC_POS 20
|
||||
int isLiteral;
|
||||
Tcl_Size maxNumCL, numCL;
|
||||
Tcl_Size *clPosition = NULL;
|
||||
int isLiteral, maxNumCL, numCL;
|
||||
int *clPosition = NULL;
|
||||
int depth = TclGetStackDepth(envPtr);
|
||||
int count = count1;
|
||||
|
||||
@@ -2466,7 +2463,7 @@ TclCompileTokens(
|
||||
|
||||
if (isLiteral) {
|
||||
maxNumCL = NUM_STATIC_POS;
|
||||
clPosition = (Tcl_Size *)Tcl_Alloc(maxNumCL * sizeof(Tcl_Size));
|
||||
clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
|
||||
}
|
||||
|
||||
adjust = 0;
|
||||
@@ -2506,8 +2503,8 @@ TclCompileTokens(
|
||||
|
||||
if (numCL >= maxNumCL) {
|
||||
maxNumCL *= 2;
|
||||
clPosition = (Tcl_Size *)Tcl_Realloc(clPosition,
|
||||
maxNumCL * sizeof(Tcl_Size));
|
||||
clPosition = (int *)Tcl_Realloc(clPosition,
|
||||
maxNumCL * sizeof(int));
|
||||
}
|
||||
clPosition[numCL] = clPos;
|
||||
numCL ++;
|
||||
@@ -3333,14 +3330,14 @@ EnterCmdWordData(
|
||||
const char *cmd,
|
||||
Tcl_Size numWords,
|
||||
Tcl_Size line,
|
||||
Tcl_Size *clNext,
|
||||
Tcl_Size **wlines,
|
||||
int *clNext,
|
||||
int **wlines,
|
||||
CompileEnv *envPtr)
|
||||
{
|
||||
ECL *ePtr;
|
||||
const char *last;
|
||||
Tcl_Size wordIdx, wordLine;
|
||||
Tcl_Size *wwlines, *wordNext;
|
||||
int *wwlines, *wordNext;
|
||||
|
||||
if (eclPtr->nuloc >= eclPtr->nloc) {
|
||||
/*
|
||||
@@ -3359,10 +3356,10 @@ EnterCmdWordData(
|
||||
|
||||
ePtr = &eclPtr->loc[eclPtr->nuloc];
|
||||
ePtr->srcOffset = srcOffset;
|
||||
ePtr->line = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
|
||||
ePtr->next = (Tcl_Size **)Tcl_Alloc(numWords * sizeof(Tcl_Size *));
|
||||
ePtr->line = (int *)Tcl_Alloc(numWords * sizeof(int));
|
||||
ePtr->next = (int **)Tcl_Alloc(numWords * sizeof(int *));
|
||||
ePtr->nline = numWords;
|
||||
wwlines = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
|
||||
wwlines = (int *)Tcl_Alloc(numWords * sizeof(int));
|
||||
|
||||
last = cmd;
|
||||
wordLine = line;
|
||||
@@ -3375,7 +3372,7 @@ EnterCmdWordData(
|
||||
/* See Ticket 4b61afd660 */
|
||||
wwlines[wordIdx] =
|
||||
((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL))
|
||||
? wordLine : -1;
|
||||
? (int)wordLine : -1;
|
||||
ePtr->line[wordIdx] = wordLine;
|
||||
ePtr->next[wordIdx] = wordNext;
|
||||
last = tokenPtr->start;
|
||||
|
||||
+4
-16
@@ -183,16 +183,16 @@ typedef struct {
|
||||
typedef struct {
|
||||
Tcl_Size srcOffset; /* Command location to find the entry. */
|
||||
Tcl_Size nline; /* Number of words in the command */
|
||||
Tcl_Size *line; /* Line information for all words in the
|
||||
int *line; /* Line information for all words in the
|
||||
* command. */
|
||||
Tcl_Size **next; /* Transient information used by the compiler
|
||||
int **next; /* Transient information used by the compiler
|
||||
* for tracking of hidden continuation
|
||||
* lines. */
|
||||
} ECL;
|
||||
|
||||
typedef struct {
|
||||
int type; /* Context type. */
|
||||
Tcl_Size start; /* Starting line for compiled script. Needed
|
||||
int start; /* Starting line for compiled script. Needed
|
||||
* for the extended recompile check in
|
||||
* tclCompileObj. */
|
||||
Tcl_Obj *path; /* Path of the sourced file the command is
|
||||
@@ -316,10 +316,8 @@ typedef struct CompileEnv {
|
||||
* array byte. */
|
||||
int mallocedCodeArray; /* Set 1 if code array was expanded and
|
||||
* codeStart points into the heap.*/
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and
|
||||
* exceptArrayPtr points in heap, else 0. */
|
||||
#endif
|
||||
LiteralEntry *literalArrayPtr;
|
||||
/* Points to start of LiteralEntry array. */
|
||||
Tcl_Size literalArrayNext; /* Index of next free object array entry. */
|
||||
@@ -335,9 +333,6 @@ typedef struct CompileEnv {
|
||||
* current range's array entry. */
|
||||
Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array
|
||||
* entry. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int mallocedExceptArray;
|
||||
#endif
|
||||
ExceptionAux *exceptAuxArrayPtr;
|
||||
/* Array of information used to restore the
|
||||
* state when processing BREAK/CONTINUE
|
||||
@@ -350,19 +345,14 @@ typedef struct CompileEnv {
|
||||
Tcl_Size cmdMapEnd; /* Index after last CmdLocation entry. */
|
||||
int mallocedCmdMap; /* 1 if command map array was expanded and
|
||||
* cmdMapPtr points in the heap, else 0. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
int mallocedAuxDataArray; /* 1 if aux data array was expanded and
|
||||
* auxDataArrayPtr points in heap else 0. */
|
||||
#endif
|
||||
AuxData *auxDataArrayPtr; /* Points to auxiliary data array start. */
|
||||
Tcl_Size auxDataArrayNext; /* Next free compile aux data array index.
|
||||
* auxDataArrayNext is the number of aux data
|
||||
* items and (auxDataArrayNext-1) is index of
|
||||
* current aux data array entry. */
|
||||
Tcl_Size auxDataArrayEnd; /* Index after last aux data array entry. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int mallocedAuxDataArray;
|
||||
#endif
|
||||
unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
|
||||
/* Initial storage for code. */
|
||||
LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
|
||||
@@ -392,7 +382,7 @@ typedef struct CompileEnv {
|
||||
* encountered that have not yet been paired
|
||||
* with a corresponding
|
||||
* INST_INVOKE_EXPANDED. */
|
||||
Tcl_Size *clNext; /* If not NULL, it refers to the next slot in
|
||||
int *clNext; /* If not NULL, it refers to the next slot in
|
||||
* clLoc to check for an invisible
|
||||
* continuation line. */
|
||||
} CompileEnv;
|
||||
@@ -1064,7 +1054,6 @@ typedef struct {
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine;
|
||||
|
||||
/*
|
||||
@@ -1203,7 +1192,6 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
|
||||
MODULE_SCOPE int TclPushProcCallFrame(void *clientData,
|
||||
Tcl_Interp *interp, Tcl_Size objc,
|
||||
Tcl_Obj *const objv[], int isLambda);
|
||||
#endif /* TCL_MAJOR_VERSION > 8 */
|
||||
|
||||
|
||||
/*
|
||||
|
||||
+13
-164
@@ -27,10 +27,8 @@
|
||||
|
||||
#if !defined(BUILD_tcl)
|
||||
# define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg)
|
||||
#elif defined(TCL_NO_DEPRECATED)
|
||||
# define TCL_DEPRECATED(msg) MODULE_SCOPE
|
||||
#else
|
||||
# define TCL_DEPRECATED(msg) EXTERN
|
||||
# define TCL_DEPRECATED(msg) MODULE_SCOPE
|
||||
#endif
|
||||
|
||||
|
||||
@@ -4027,82 +4025,29 @@ extern const TclStubs *tclStubsPtr;
|
||||
Tcl_GetStringFromObj(objPtr, (Tcl_Size *)NULL)
|
||||
#define Tcl_GetUnicode(objPtr) \
|
||||
Tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)NULL)
|
||||
#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
|
||||
# undef Tcl_GetBytesFromObj
|
||||
# undef Tcl_GetStringFromObj
|
||||
# undef Tcl_GetUnicodeFromObj
|
||||
#endif
|
||||
#undef Tcl_GetIndexFromObjStruct
|
||||
#undef Tcl_GetBooleanFromObj
|
||||
#undef Tcl_GetBoolean
|
||||
#undef TclGetByteArrayFromObj
|
||||
#undef Tcl_GetByteArrayFromObj
|
||||
#if defined(USE_TCL_STUBS)
|
||||
# if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
|
||||
# define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
|
||||
tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
# define Tcl_GetStringFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
tclStubsPtr->tclGetStringFromObj(objPtr, (sizePtr)) : \
|
||||
tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
# define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
tclStubsPtr->tclGetUnicodeFromObj(objPtr, (sizePtr)) : \
|
||||
tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
# endif
|
||||
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
|
||||
(tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \
|
||||
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg,\
|
||||
flags, indexPtr) \
|
||||
(tclStubsPtr->tcl_GetIndexFromObjStruct(\
|
||||
(interp), (objPtr), (tablePtr), (offset), (msg), \
|
||||
(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
|
||||
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
|
||||
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
|
||||
Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
|
||||
(Tcl_GetBoolFromObj(interp, objPtr,\
|
||||
(TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
|
||||
#define Tcl_GetBoolean(interp, src, boolPtr) \
|
||||
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
|
||||
Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
(Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof(\
|
||||
(*(boolPtr))), (char *)(boolPtr)))
|
||||
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
|
||||
tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
(tclStubsPtr->tcl_GetBytesFromObj(\
|
||||
NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
#else
|
||||
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
tclStubsPtr->tclGetByteArrayFromObj(objPtr, (sizePtr)) : \
|
||||
tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
#endif
|
||||
#else
|
||||
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
|
||||
((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \
|
||||
(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
|
||||
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
|
||||
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
|
||||
Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
|
||||
#define Tcl_GetBoolean(interp, src, boolPtr) \
|
||||
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
|
||||
Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
|
||||
#if defined(TCL_NO_DEPRECATED)
|
||||
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
|
||||
(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))
|
||||
#else
|
||||
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
TclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
|
||||
(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
TclGetUnicodeFromObj(objPtr, (sizePtr)) : \
|
||||
(Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
TclGetStringFromObj(objPtr, (sizePtr)) : \
|
||||
(Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
|
||||
(sizeof(*(sizePtr)) <= sizeof(int) ? \
|
||||
TclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
|
||||
(Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
@@ -4131,36 +4076,6 @@ extern const TclStubs *tclStubsPtr;
|
||||
#define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR)
|
||||
#define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0)
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
# undef Tcl_UniCharToUtfDString
|
||||
# define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString
|
||||
# undef Tcl_UtfToUniCharDString
|
||||
# define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString
|
||||
# undef Tcl_UtfToUniChar
|
||||
# define Tcl_UtfToUniChar Tcl_UtfToChar16
|
||||
# undef Tcl_UniCharLen
|
||||
# define Tcl_UniCharLen Tcl_Char16Len
|
||||
# undef Tcl_UniCharToUtf
|
||||
# if defined(USE_TCL_STUBS)
|
||||
# define Tcl_UniCharToUtf(c, p) \
|
||||
(tclStubsPtr->tcl_UniCharToUtf((c)|TCL_COMBINE, (p)))
|
||||
# else
|
||||
# define Tcl_UniCharToUtf(c, p) \
|
||||
((Tcl_UniCharToUtf)((c)|TCL_COMBINE, (p)))
|
||||
# endif
|
||||
#if !defined(BUILD_tcl)
|
||||
# undef Tcl_NumUtfChars
|
||||
# define Tcl_NumUtfChars TclNumUtfChars
|
||||
# undef Tcl_GetCharLength
|
||||
# define Tcl_GetCharLength TclGetCharLength
|
||||
# undef Tcl_UtfAtIndex
|
||||
# define Tcl_UtfAtIndex TclUtfAtIndex
|
||||
# undef Tcl_GetRange
|
||||
# define Tcl_GetRange TclGetRange
|
||||
# undef Tcl_GetUniChar
|
||||
# define Tcl_GetUniChar TclGetUniChar
|
||||
#endif
|
||||
#endif
|
||||
#if defined(USE_TCL_STUBS)
|
||||
# define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
|
||||
? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \
|
||||
@@ -4174,36 +4089,6 @@ extern const TclStubs *tclStubsPtr;
|
||||
# define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \
|
||||
? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \
|
||||
: (Tcl_Size (*)(wchar_t *))Tcl_Char16Len)
|
||||
#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
|
||||
# undef Tcl_ListObjGetElements
|
||||
# define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
|
||||
? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \
|
||||
: tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
|
||||
# undef Tcl_ListObjLength
|
||||
# define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
|
||||
? tclStubsPtr->tclListObjLength((interp), (listPtr), (lengthPtr)) \
|
||||
: tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
|
||||
# undef Tcl_DictObjSize
|
||||
# define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
|
||||
? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (sizePtr)) \
|
||||
: tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
|
||||
# undef Tcl_SplitList
|
||||
# define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
|
||||
? tclStubsPtr->tclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \
|
||||
: tclStubsPtr->tcl_SplitList((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
|
||||
# undef Tcl_SplitPath
|
||||
# define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
|
||||
? tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr)) \
|
||||
: tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
|
||||
# undef Tcl_FSSplitPath
|
||||
# define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
|
||||
? tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) \
|
||||
: tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
|
||||
# undef Tcl_ParseArgsObjv
|
||||
# define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
|
||||
? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \
|
||||
: tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
|
||||
#endif /* TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) */
|
||||
#else
|
||||
# define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
|
||||
? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \
|
||||
@@ -4217,29 +4102,6 @@ extern const TclStubs *tclStubsPtr;
|
||||
# define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \
|
||||
? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \
|
||||
: (Tcl_Size (*)(wchar_t *))Tcl_Char16Len)
|
||||
#if !defined(BUILD_tcl) && !defined(TCL_NO_DEPRECATED)
|
||||
# define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
|
||||
? TclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \
|
||||
: (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
|
||||
# define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
|
||||
? TclListObjLength((interp), (listPtr), (lengthPtr)) \
|
||||
: (Tcl_ListObjLength)((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
|
||||
# define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
|
||||
? TclDictObjSize((interp), (dictPtr), (sizePtr)) \
|
||||
: (Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
|
||||
# define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
|
||||
? TclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \
|
||||
: (Tcl_SplitList)((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
|
||||
# define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
|
||||
? TclSplitPath((path), (argcPtr), (argvPtr)) \
|
||||
: (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
|
||||
# define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
|
||||
? TclFSSplitPath((pathPtr), (lenPtr)) \
|
||||
: (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
|
||||
# define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
|
||||
? TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \
|
||||
: (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
|
||||
#endif /* !defined(BUILD_tcl) */
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -4251,24 +4113,11 @@ extern const TclStubs *tclStubsPtr;
|
||||
#define Tcl_GlobalEvalObj(interp, objPtr) \
|
||||
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
# undef Tcl_Close
|
||||
# define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
|
||||
#endif
|
||||
# undef Tcl_Close
|
||||
# define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
|
||||
|
||||
#undef TclUtfCharComplete
|
||||
#undef TclUtfNext
|
||||
#undef TclUtfPrev
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# define Tcl_CreateSlave Tcl_CreateChild
|
||||
# define Tcl_GetSlave Tcl_GetChild
|
||||
# define Tcl_GetMaster Tcl_GetParent
|
||||
#endif
|
||||
|
||||
/* TIP #660 for 8.7 */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
# undef Tcl_GetSizeIntFromObj
|
||||
# define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj
|
||||
#endif
|
||||
|
||||
#endif /* _TCLDECLS */
|
||||
|
||||
+34
-200
@@ -61,8 +61,6 @@ static Tcl_ObjCmdProc DictForNRCmd;
|
||||
static Tcl_ObjCmdProc DictMapNRCmd;
|
||||
static Tcl_NRPostProc DictForLoopCallback;
|
||||
static Tcl_NRPostProc DictMapLoopCallback;
|
||||
static Tcl_ObjTypeLengthProc DictAsListLength;
|
||||
/* static Tcl_ObjTypeIndexProc DictAsListIndex; Needs rewrite */
|
||||
|
||||
/*
|
||||
* Table of dict subcommand names and implementations.
|
||||
@@ -145,25 +143,14 @@ typedef struct Dict {
|
||||
|
||||
const Tcl_ObjType tclDictType = {
|
||||
"dict",
|
||||
FreeDictInternalRep, /* freeIntRepProc */
|
||||
DupDictInternalRep, /* dupIntRepProc */
|
||||
UpdateStringOfDict, /* updateStringProc */
|
||||
SetDictFromAny, /* setFromAnyProc */
|
||||
TCL_OBJTYPE_V2( /* Extended type for AbstractLists */
|
||||
DictAsListLength, /* return "list" length of dict value w/o
|
||||
* shimmering */
|
||||
NULL, /* return key or value at "list" index
|
||||
* location. (keysare at even indicies,
|
||||
* values at odd indicies) */
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL)
|
||||
FreeDictInternalRep, /* freeIntRepProc */
|
||||
DupDictInternalRep, /* dupIntRepProc */
|
||||
UpdateStringOfDict, /* updateStringProc */
|
||||
SetDictFromAny, /* setFromAnyProc */
|
||||
TCL_OBJTYPE_V0
|
||||
};
|
||||
|
||||
#define DictSetInternalRep(objPtr, dictRepPtr) \
|
||||
#define DictSetIntRep(objPtr, dictRepPtr) \
|
||||
do { \
|
||||
Tcl_ObjInternalRep ir; \
|
||||
ir.twoPtrValue.ptr1 = (dictRepPtr); \
|
||||
@@ -409,7 +396,7 @@ DupDictInternalRep(
|
||||
* Store in the object.
|
||||
*/
|
||||
|
||||
DictSetInternalRep(copyPtr, newDict);
|
||||
DictSetIntRep(copyPtr, newDict);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -616,7 +603,7 @@ SetDictFromAny(
|
||||
* the conversion from lists to dictionaries.
|
||||
*/
|
||||
|
||||
if (TclHasInternalRep(objPtr, &tclListType)) {
|
||||
if (TclHasInternalRep(objPtr, tclListType)) {
|
||||
Tcl_Size objc, i;
|
||||
Tcl_Obj **objv;
|
||||
|
||||
@@ -724,7 +711,7 @@ SetDictFromAny(
|
||||
dict->epoch = 1;
|
||||
dict->chain = NULL;
|
||||
dict->refCount = 1;
|
||||
DictSetInternalRep(objPtr, dict);
|
||||
DictSetIntRep(objPtr, dict);
|
||||
return TCL_OK;
|
||||
|
||||
missingValue:
|
||||
@@ -903,7 +890,7 @@ InvalidateDictChain(
|
||||
dict->refCount++;
|
||||
TclInvalidateStringRep(dictObj);
|
||||
TclFreeInternalRep(dictObj);
|
||||
DictSetInternalRep(dictObj, dict);
|
||||
DictSetIntRep(dictObj, dict);
|
||||
|
||||
dict->epoch++;
|
||||
dictObj = dict->chain;
|
||||
@@ -958,7 +945,7 @@ Tcl_DictObjPut(
|
||||
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
|
||||
dict->refCount++;
|
||||
TclFreeInternalRep(dictPtr)
|
||||
DictSetInternalRep(dictPtr, dict);
|
||||
DictSetIntRep(dictPtr, dict);
|
||||
Tcl_IncrRefCount(valuePtr);
|
||||
if (!isNew) {
|
||||
Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
|
||||
@@ -1439,7 +1426,7 @@ Tcl_NewDictObj(void)
|
||||
dict->epoch = 1;
|
||||
dict->chain = NULL;
|
||||
dict->refCount = 1;
|
||||
DictSetInternalRep(dictPtr, dict);
|
||||
DictSetIntRep(dictPtr, dict);
|
||||
return dictPtr;
|
||||
#endif
|
||||
}
|
||||
@@ -1487,7 +1474,7 @@ Tcl_DbNewDictObj(
|
||||
dict->epoch = 1;
|
||||
dict->chain = NULL;
|
||||
dict->refCount = 1;
|
||||
DictSetInternalRep(dictPtr, dict);
|
||||
DictSetIntRep(dictPtr, dict);
|
||||
return dictPtr;
|
||||
}
|
||||
#else /* !TCL_MEM_DEBUG */
|
||||
@@ -1522,7 +1509,7 @@ Tcl_DbNewDictObj(
|
||||
|
||||
static int
|
||||
DictCreateCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1572,7 +1559,7 @@ DictCreateCmd(
|
||||
|
||||
static int
|
||||
DictGetCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1665,7 +1652,7 @@ DictGetCmd(
|
||||
|
||||
static int
|
||||
DictGetDefCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1730,7 +1717,7 @@ DictGetDefCmd(
|
||||
|
||||
static int
|
||||
DictReplaceCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1778,7 +1765,7 @@ DictReplaceCmd(
|
||||
|
||||
static int
|
||||
DictRemoveCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1826,7 +1813,7 @@ DictRemoveCmd(
|
||||
|
||||
static int
|
||||
DictMergeCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1913,7 +1900,7 @@ DictMergeCmd(
|
||||
|
||||
static int
|
||||
DictKeysCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -1992,7 +1979,7 @@ DictKeysCmd(
|
||||
|
||||
static int
|
||||
DictValuesCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2052,7 +2039,7 @@ DictValuesCmd(
|
||||
|
||||
static int
|
||||
DictSizeCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2091,7 +2078,7 @@ DictSizeCmd(
|
||||
|
||||
static int
|
||||
DictExistsCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2133,7 +2120,7 @@ DictExistsCmd(
|
||||
|
||||
static int
|
||||
DictInfoCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2177,7 +2164,7 @@ DictInfoCmd(
|
||||
|
||||
static int
|
||||
DictIncrCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2298,7 +2285,7 @@ DictIncrCmd(
|
||||
|
||||
static int
|
||||
DictLappendCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2385,7 +2372,7 @@ DictLappendCmd(
|
||||
|
||||
static int
|
||||
DictAppendCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2487,7 +2474,7 @@ DictAppendCmd(
|
||||
|
||||
static int
|
||||
DictForNRCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2683,7 +2670,7 @@ DictForLoopCallback(
|
||||
|
||||
static int
|
||||
DictMapNRCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2896,7 +2883,7 @@ DictMapLoopCallback(
|
||||
|
||||
static int
|
||||
DictSetCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -2956,7 +2943,7 @@ DictSetCmd(
|
||||
|
||||
static int
|
||||
DictUnsetCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -3015,7 +3002,7 @@ DictUnsetCmd(
|
||||
|
||||
static int
|
||||
DictFilterCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -3301,7 +3288,7 @@ DictFilterCmd(
|
||||
|
||||
static int
|
||||
DictUpdateCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -3460,7 +3447,7 @@ FinalizeDictUpdate(
|
||||
|
||||
static int
|
||||
DictWithCmd(
|
||||
TCL_UNUSED(void *),
|
||||
TCL_UNUSED(ClientData),
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
@@ -3801,159 +3788,6 @@ TclInitDictCmd(
|
||||
return TclMakeEnsemble(interp, "dict", implementationMap);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* DictAsListLength --
|
||||
*
|
||||
* Compute the length of a list as if the dict value were converted to a
|
||||
* list.
|
||||
*
|
||||
* Note: the list length may not match the dict size * 2. This occurs when
|
||||
* there are duplicate keys in the original string representation.
|
||||
*
|
||||
* Side Effects --
|
||||
*
|
||||
* The intent is to have no side effects.
|
||||
*/
|
||||
|
||||
static Tcl_Size
|
||||
DictAsListLength(
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
Tcl_Size estCount, length, llen;
|
||||
const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
|
||||
Tcl_Obj *elemPtr;
|
||||
|
||||
/*
|
||||
* Allocate enough space to hold a (Tcl_Obj *) for each
|
||||
* (possible) list element.
|
||||
*/
|
||||
|
||||
estCount = TclMaxListLength(nextElem, length, &limit);
|
||||
estCount += (estCount == 0); /* Smallest list struct holds 1
|
||||
* element. */
|
||||
elemPtr = Tcl_NewObj();
|
||||
|
||||
llen = 0;
|
||||
|
||||
while (nextElem < limit) {
|
||||
const char *elemStart;
|
||||
char *check;
|
||||
Tcl_Size elemSize;
|
||||
int literal;
|
||||
|
||||
if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
|
||||
&elemStart, &nextElem, &elemSize, &literal)) {
|
||||
Tcl_DecrRefCount(elemPtr);
|
||||
return 0;
|
||||
}
|
||||
if (elemStart == limit) {
|
||||
break;
|
||||
}
|
||||
|
||||
TclInvalidateStringRep(elemPtr);
|
||||
check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
|
||||
elemSize);
|
||||
if (elemSize && check == NULL) {
|
||||
Tcl_DecrRefCount(elemPtr);
|
||||
return 0;
|
||||
}
|
||||
if (!literal) {
|
||||
Tcl_InitStringRep(elemPtr, NULL,
|
||||
TclCopyAndCollapse(elemSize, elemStart, check));
|
||||
}
|
||||
llen++;
|
||||
}
|
||||
Tcl_DecrRefCount(elemPtr);
|
||||
return llen;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* DictAsListIndex --
|
||||
*
|
||||
* Return the key or value at the given "list" index, i.e., as if the string
|
||||
* value where treated as a list. The intent is to support this list
|
||||
* operation w/o causing the Obj value to shimmer into a List.
|
||||
*
|
||||
* Side Effects --
|
||||
*
|
||||
* The intent is to have no side effects.
|
||||
*
|
||||
*/
|
||||
#if 0 /* Needs rewrite */
|
||||
static int
|
||||
DictAsListIndex(
|
||||
Tcl_Interp *interp,
|
||||
struct Tcl_Obj *objPtr,
|
||||
Tcl_Size index,
|
||||
Tcl_Obj** elemObjPtr)
|
||||
{
|
||||
Tcl_Size /*estCount,*/ length, llen;
|
||||
const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
|
||||
Tcl_Obj *elemPtr;
|
||||
|
||||
/*
|
||||
* Compute limit of the list string
|
||||
*/
|
||||
|
||||
TclMaxListLength(nextElem, length, &limit);
|
||||
elemPtr = Tcl_NewObj();
|
||||
|
||||
llen = 0;
|
||||
|
||||
/*
|
||||
* parse out each element until reaching the "index"th element.
|
||||
* Sure this is slow, but shimmering is slower.
|
||||
*/
|
||||
while (nextElem < limit) {
|
||||
const char *elemStart;
|
||||
char *check;
|
||||
Tcl_Size elemSize;
|
||||
int literal;
|
||||
|
||||
if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
|
||||
&elemStart, &nextElem, &elemSize, &literal)) {
|
||||
Tcl_DecrRefCount(elemPtr);
|
||||
return 0;
|
||||
}
|
||||
if (elemStart == limit) {
|
||||
break;
|
||||
}
|
||||
|
||||
TclInvalidateStringRep(elemPtr);
|
||||
check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
|
||||
elemSize);
|
||||
if (elemSize && check == NULL) {
|
||||
Tcl_DecrRefCount(elemPtr);
|
||||
if (interp) {
|
||||
// Need error message here
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (!literal) {
|
||||
Tcl_InitStringRep(elemPtr, NULL,
|
||||
TclCopyAndCollapse(elemSize, elemStart, check));
|
||||
}
|
||||
if (llen == index) {
|
||||
*elemObjPtr = elemPtr;
|
||||
return TCL_OK;
|
||||
}
|
||||
llen++;
|
||||
}
|
||||
|
||||
/*
|
||||
* Index is beyond end of list - return empty
|
||||
*/
|
||||
Tcl_InitStringRep(elemPtr, NULL, 0);
|
||||
*elemObjPtr = elemPtr;
|
||||
return TCL_OK;
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
|
||||
+23
-24
@@ -256,8 +256,7 @@ DisassembleByteCodeObj(
|
||||
unsigned char *codeStart, *codeLimit, *pc;
|
||||
unsigned char *codeDeltaNext, *codeLengthNext;
|
||||
unsigned char *srcDeltaNext, *srcLengthNext;
|
||||
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, line;
|
||||
Tcl_Size i;
|
||||
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
|
||||
Interp *iPtr;
|
||||
Tcl_Obj *bufferObj, *fileObj;
|
||||
|
||||
@@ -279,7 +278,7 @@ DisassembleByteCodeObj(
|
||||
*/
|
||||
|
||||
Tcl_AppendPrintfToObj(bufferObj,
|
||||
"ByteCode %p, refCt %" TCL_SIZE_MODIFIER "u, epoch %" TCL_SIZE_MODIFIER "u, interp %p (epoch %" TCL_SIZE_MODIFIER "u)\n",
|
||||
"ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n",
|
||||
codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch);
|
||||
Tcl_AppendToObj(bufferObj, " Source ", -1);
|
||||
PrintSourceToObj(bufferObj, codePtr->source,
|
||||
@@ -290,7 +289,7 @@ DisassembleByteCodeObj(
|
||||
TclGetString(fileObj), line);
|
||||
}
|
||||
Tcl_AppendPrintfToObj(bufferObj,
|
||||
"\n Cmds %d, src %" TCL_SIZE_MODIFIER "u, inst %" TCL_SIZE_MODIFIER "u, litObjs %" TCL_SIZE_MODIFIER "u, aux %" TCL_SIZE_MODIFIER "u, stkDepth %" TCL_SIZE_MODIFIER "u, code/src %.2f\n",
|
||||
"\n Cmds %d, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n",
|
||||
numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
|
||||
codePtr->numLitObjects, codePtr->numAuxDataItems,
|
||||
codePtr->maxStackDepth,
|
||||
@@ -302,8 +301,8 @@ DisassembleByteCodeObj(
|
||||
|
||||
#ifdef TCL_COMPILE_STATS
|
||||
Tcl_AppendPrintfToObj(bufferObj,
|
||||
" Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_SIZE_MODIFIER "u+litObj %"
|
||||
TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_SIZE_MODIFIER "u\n",
|
||||
" Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER "u+litObj %"
|
||||
TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",
|
||||
codePtr->structureSize,
|
||||
offsetof(ByteCode, localCachePtr),
|
||||
codePtr->numCodeBytes,
|
||||
@@ -321,10 +320,10 @@ DisassembleByteCodeObj(
|
||||
|
||||
if (codePtr->procPtr != NULL) {
|
||||
Proc *procPtr = codePtr->procPtr;
|
||||
Tcl_Size numCompiledLocals = procPtr->numCompiledLocals;
|
||||
int numCompiledLocals = procPtr->numCompiledLocals;
|
||||
|
||||
Tcl_AppendPrintfToObj(bufferObj,
|
||||
" Proc %p, refCt %" TCL_SIZE_MODIFIER "u, args %" TCL_SIZE_MODIFIER "u, compiled locals %" TCL_SIZE_MODIFIER "u\n",
|
||||
" Proc %p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %d\n",
|
||||
procPtr, procPtr->refCount, procPtr->numArgs,
|
||||
numCompiledLocals);
|
||||
if (numCompiledLocals > 0) {
|
||||
@@ -332,7 +331,7 @@ DisassembleByteCodeObj(
|
||||
|
||||
for (i = 0; i < numCompiledLocals; i++) {
|
||||
Tcl_AppendPrintfToObj(bufferObj,
|
||||
" slot %" TCL_SIZE_MODIFIER "u%s%s%s%s%s%s", i,
|
||||
" slot %d%s%s%s%s%s%s", i,
|
||||
(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
|
||||
(localPtr->flags & VAR_ARRAY) ? ", array" : "",
|
||||
(localPtr->flags & VAR_LINK) ? ", link" : "",
|
||||
@@ -355,24 +354,24 @@ DisassembleByteCodeObj(
|
||||
*/
|
||||
|
||||
if ((int)codePtr->numExceptRanges > 0) {
|
||||
Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %" TCL_SIZE_MODIFIER "u, depth %" TCL_SIZE_MODIFIER "u:\n",
|
||||
Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %" TCL_Z_MODIFIER "u, depth %" TCL_Z_MODIFIER "u:\n",
|
||||
codePtr->numExceptRanges, codePtr->maxExceptDepth);
|
||||
for (i = 0; i < (int)codePtr->numExceptRanges; i++) {
|
||||
ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
|
||||
|
||||
Tcl_AppendPrintfToObj(bufferObj,
|
||||
" %" TCL_SIZE_MODIFIER "u: level %" TCL_SIZE_MODIFIER "u, %s, pc %" TCL_SIZE_MODIFIER "u-%" TCL_SIZE_MODIFIER "u, ",
|
||||
" %d: level %" TCL_Z_MODIFIER "u, %s, pc %" TCL_Z_MODIFIER "u-%" TCL_Z_MODIFIER "u, ",
|
||||
i, rangePtr->nestingLevel,
|
||||
(rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
|
||||
rangePtr->codeOffset,
|
||||
(rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
|
||||
switch (rangePtr->type) {
|
||||
case LOOP_EXCEPTION_RANGE:
|
||||
Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_SIZE_MODIFIER "u, break %" TCL_SIZE_MODIFIER "u\n",
|
||||
Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_Z_MODIFIER "u, break %" TCL_Z_MODIFIER "u\n",
|
||||
rangePtr->continueOffset, rangePtr->breakOffset);
|
||||
break;
|
||||
case CATCH_EXCEPTION_RANGE:
|
||||
Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_SIZE_MODIFIER "u\n",
|
||||
Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_Z_MODIFIER "u\n",
|
||||
rangePtr->catchOffset);
|
||||
break;
|
||||
default:
|
||||
@@ -446,7 +445,7 @@ DisassembleByteCodeObj(
|
||||
srcLengthNext++;
|
||||
}
|
||||
|
||||
Tcl_AppendPrintfToObj(bufferObj, "%s%4" TCL_SIZE_MODIFIER "u: pc %d-%d, src %d-%d",
|
||||
Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
|
||||
((i % 2)? " " : "\n "),
|
||||
(i+1), codeOffset, (codeOffset + codeLen - 1),
|
||||
srcOffset, (srcOffset + srcLen - 1));
|
||||
@@ -505,7 +504,7 @@ DisassembleByteCodeObj(
|
||||
pc += FormatInstruction(codePtr, pc, bufferObj);
|
||||
}
|
||||
|
||||
Tcl_AppendPrintfToObj(bufferObj, " Command %" TCL_SIZE_MODIFIER "u: ", i+1);
|
||||
Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1);
|
||||
PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
|
||||
TclMin(srcLen, 55));
|
||||
Tcl_AppendToObj(bufferObj, "\n", -1);
|
||||
@@ -545,7 +544,7 @@ FormatInstruction(
|
||||
unsigned char *codeStart = codePtr->codeStart;
|
||||
unsigned pcOffset = pc - codeStart;
|
||||
int opnd = 0, i, j, numBytes = 1;
|
||||
Tcl_Size localCt = procPtr ? procPtr->numCompiledLocals : 0;
|
||||
int localCt = procPtr ? (int)procPtr->numCompiledLocals : 0;
|
||||
CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
|
||||
char suffixBuffer[128]; /* Additional info to print after main opcode
|
||||
* and immediates. */
|
||||
@@ -626,7 +625,7 @@ FormatInstruction(
|
||||
printLVTindex:
|
||||
if (localPtr != NULL) {
|
||||
if (opnd >= localCt) {
|
||||
Tcl_Panic("FormatInstruction: bad local var index %u (%" TCL_SIZE_MODIFIER "u locals)",
|
||||
Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
|
||||
opnd, localCt);
|
||||
}
|
||||
for (j = 0; j < opnd; j++) {
|
||||
@@ -876,7 +875,7 @@ PrintSourceToObj(
|
||||
for (; (*p != '\0') && (i < maxChars); p+=len) {
|
||||
int ucs4;
|
||||
|
||||
len = TclUtfToUCS4(p, &ucs4);
|
||||
len = Tcl_UtfToUniChar(p, &ucs4);
|
||||
switch (ucs4) {
|
||||
case '"':
|
||||
Tcl_AppendToObj(appendObj, "\\\"", -1);
|
||||
@@ -944,8 +943,8 @@ DisassembleByteCodeAsDicts(
|
||||
Tcl_Obj *description, *literals, *variables, *instructions, *inst;
|
||||
Tcl_Obj *aux, *exn, *commands, *file;
|
||||
unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
|
||||
int codeOffset, codeLength, sourceOffset, sourceLength, val, line;
|
||||
Tcl_Size i;
|
||||
int codeOffset, codeLength, sourceOffset, sourceLength;
|
||||
int i, val, line;
|
||||
|
||||
ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
|
||||
|
||||
@@ -954,7 +953,7 @@ DisassembleByteCodeAsDicts(
|
||||
*/
|
||||
|
||||
TclNewObj(literals);
|
||||
for (i=0 ; i<codePtr->numLitObjects ; i++) {
|
||||
for (i=0 ; i<(int)codePtr->numLitObjects ; i++) {
|
||||
Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
|
||||
}
|
||||
|
||||
@@ -964,7 +963,7 @@ DisassembleByteCodeAsDicts(
|
||||
|
||||
TclNewObj(variables);
|
||||
if (codePtr->procPtr) {
|
||||
Tcl_Size localCount = codePtr->procPtr->numCompiledLocals;
|
||||
int localCount = codePtr->procPtr->numCompiledLocals;
|
||||
CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;
|
||||
|
||||
for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
|
||||
@@ -1147,14 +1146,14 @@ DisassembleByteCodeAsDicts(
|
||||
switch (rangePtr->type) {
|
||||
case LOOP_EXCEPTION_RANGE:
|
||||
Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
|
||||
"type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u break %" TCL_SIZE_MODIFIER "u continue %" TCL_SIZE_MODIFIER "u",
|
||||
"type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u break %" TCL_Z_MODIFIER "u continue %" TCL_Z_MODIFIER "u",
|
||||
"loop", rangePtr->nestingLevel, rangePtr->codeOffset,
|
||||
rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
|
||||
rangePtr->breakOffset, rangePtr->continueOffset));
|
||||
break;
|
||||
case CATCH_EXCEPTION_RANGE:
|
||||
Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
|
||||
"type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u catch %" TCL_SIZE_MODIFIER "u",
|
||||
"type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u catch %" TCL_Z_MODIFIER "u",
|
||||
"catch", rangePtr->nestingLevel, rangePtr->codeOffset,
|
||||
rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
|
||||
rangePtr->catchOffset));
|
||||
|
||||
+38
-207
@@ -10,7 +10,6 @@
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
#include <assert.h>
|
||||
|
||||
typedef size_t (LengthProc)(const char *src);
|
||||
|
||||
@@ -186,7 +185,6 @@ TCL_DECLARE_MUTEX(encodingMutex)
|
||||
static Tcl_Encoding defaultEncoding = NULL;
|
||||
static Tcl_Encoding systemEncoding = NULL;
|
||||
Tcl_Encoding tclIdentityEncoding = NULL;
|
||||
Tcl_Encoding tclUtf8Encoding = NULL;
|
||||
|
||||
/*
|
||||
* Names of encoding profiles and corresponding integer values.
|
||||
@@ -573,8 +571,8 @@ TclInitEncodingSubsystem(void)
|
||||
unsigned size;
|
||||
unsigned short i;
|
||||
union {
|
||||
char c;
|
||||
short s;
|
||||
char c;
|
||||
short s;
|
||||
} isLe;
|
||||
int leFlags;
|
||||
|
||||
@@ -610,7 +608,7 @@ TclInitEncodingSubsystem(void)
|
||||
type.freeProc = NULL;
|
||||
type.nullSize = 1;
|
||||
type.clientData = INT2PTR(ENCODING_UTF);
|
||||
tclUtf8Encoding = Tcl_CreateEncoding(&type);
|
||||
Tcl_CreateEncoding(&type);
|
||||
type.clientData = NULL;
|
||||
type.encodingName = "cesu-8";
|
||||
Tcl_CreateEncoding(&type);
|
||||
@@ -657,11 +655,6 @@ TclInitEncodingSubsystem(void)
|
||||
type.clientData = INT2PTR(leFlags);
|
||||
Tcl_CreateEncoding(&type);
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
type.encodingName = "unicode";
|
||||
Tcl_CreateEncoding(&type);
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Need the iso8859-1 encoding in order to process binary data, so force
|
||||
* it to always be embedded. Note that this encoding *must* be a proper
|
||||
@@ -732,8 +725,6 @@ TclFinalizeEncodingSubsystem(void)
|
||||
defaultEncoding = NULL;
|
||||
FreeEncoding(tclIdentityEncoding);
|
||||
tclIdentityEncoding = NULL;
|
||||
FreeEncoding(tclUtf8Encoding);
|
||||
tclUtf8Encoding = NULL;
|
||||
|
||||
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
|
||||
while (hPtr != NULL) {
|
||||
@@ -1158,7 +1149,7 @@ Tcl_ExternalToUtfDString(
|
||||
* converted string is stored. */
|
||||
{
|
||||
Tcl_ExternalToUtfDStringEx(
|
||||
NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL);
|
||||
NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_STRICT, dstPtr, NULL);
|
||||
return Tcl_DStringValue(dstPtr);
|
||||
}
|
||||
|
||||
@@ -1238,7 +1229,6 @@ Tcl_ExternalToUtfDStringEx(
|
||||
"Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.",
|
||||
TCL_INDEX_NONE));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL);
|
||||
errno = EINVAL;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -1303,20 +1293,17 @@ Tcl_ExternalToUtfDStringEx(
|
||||
/* Caller wants error message on failure */
|
||||
if (result != TCL_OK && interp != NULL) {
|
||||
char buf[TCL_INTEGER_SPACE];
|
||||
snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "u", nBytesProcessed);
|
||||
snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
|
||||
Tcl_SetObjResult(
|
||||
interp,
|
||||
Tcl_ObjPrintf("unexpected byte sequence starting at index %"
|
||||
TCL_SIZE_MODIFIER "u: '\\x%02X'",
|
||||
TCL_Z_MODIFIER "u: '\\x%02X'",
|
||||
nBytesProcessed,
|
||||
UCHAR(srcStart[nBytesProcessed])));
|
||||
Tcl_SetErrorCode(
|
||||
interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, NULL);
|
||||
}
|
||||
}
|
||||
if (result != TCL_OK) {
|
||||
errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
@@ -1507,7 +1494,7 @@ Tcl_UtfToExternalDString(
|
||||
* The parameter flags controls the behavior, if any of the bytes in
|
||||
* the source buffer are invalid or cannot be represented in the
|
||||
* target encoding. It should be composed by OR-ing the following:
|
||||
* - *At most one* of TCL_ENCODING_PROFILE_*
|
||||
* - *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT}
|
||||
* - TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile
|
||||
* to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags
|
||||
*
|
||||
@@ -1570,7 +1557,6 @@ Tcl_UtfToExternalDStringEx(
|
||||
"Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.",
|
||||
TCL_INDEX_NONE));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL);
|
||||
errno = EINVAL;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -1637,12 +1623,12 @@ Tcl_UtfToExternalDStringEx(
|
||||
Tcl_Size pos = Tcl_NumUtfChars(srcStart, nBytesProcessed);
|
||||
int ucs4;
|
||||
char buf[TCL_INTEGER_SPACE];
|
||||
TclUtfToUCS4(&srcStart[nBytesProcessed], &ucs4);
|
||||
snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "u", nBytesProcessed);
|
||||
Tcl_UtfToUniChar(&srcStart[nBytesProcessed], &ucs4);
|
||||
snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
|
||||
Tcl_SetObjResult(
|
||||
interp,
|
||||
Tcl_ObjPrintf(
|
||||
"unexpected character at index %" TCL_SIZE_MODIFIER
|
||||
"unexpected character at index %" TCL_Z_MODIFIER
|
||||
"u: 'U+%06X'",
|
||||
pos,
|
||||
ucs4));
|
||||
@@ -1650,9 +1636,6 @@ Tcl_UtfToExternalDStringEx(
|
||||
buf, NULL);
|
||||
}
|
||||
}
|
||||
if (result != TCL_OK) {
|
||||
errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
@@ -2543,16 +2526,6 @@ UtfToUtfProc(
|
||||
flags |= PTR2INT(clientData);
|
||||
dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6);
|
||||
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Initialize the buffer so that some random data doesn't trick
|
||||
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
|
||||
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
|
||||
* prior non-stateful nature, this call to memset can also be removed.
|
||||
*/
|
||||
memset(dst, 0xff, dstLen);
|
||||
#endif
|
||||
|
||||
profile = ENCODING_PROFILE_GET(flags);
|
||||
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
|
||||
|
||||
@@ -2600,10 +2573,10 @@ UtfToUtfProc(
|
||||
} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
|
||||
/*
|
||||
* Incomplete byte sequence.
|
||||
* Always check before using TclUtfToUCS4. Not doing so can cause it
|
||||
* run beyond the end of the buffer! If we happen on such an incomplete
|
||||
* char its bytes are made to represent themselves unless the user has
|
||||
* explicitly asked to be told.
|
||||
* Always check before using Tcl_UtfToUniChar. Not doing can so cause
|
||||
* it to run beyond the end of the buffer! If we happen such an
|
||||
* incomplete char its bytes are made to represent themselves
|
||||
* unless the user has explicitly asked to be told.
|
||||
*/
|
||||
|
||||
if (flags & ENCODING_INPUT) {
|
||||
@@ -2622,12 +2595,12 @@ UtfToUtfProc(
|
||||
/* TCL_ENCODING_PROFILE_TCL8 */
|
||||
char chbuf[2];
|
||||
chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
|
||||
TclUtfToUCS4(chbuf, &ch);
|
||||
Tcl_UtfToUniChar(chbuf, &ch);
|
||||
}
|
||||
dst += Tcl_UniCharToUtf(ch, dst);
|
||||
} else {
|
||||
int isInvalid = 0;
|
||||
size_t len = TclUtfToUCS4(src, &ch);
|
||||
size_t len = Tcl_UtfToUniChar(src, &ch);
|
||||
if (flags & ENCODING_INPUT) {
|
||||
if ((len < 2) && (ch != 0)) {
|
||||
isInvalid = 1;
|
||||
@@ -2655,44 +2628,10 @@ UtfToUtfProc(
|
||||
*dst++ = (char) (((ch >> 10) & 0x3F) | 0x80);
|
||||
ch = (ch & 0x0CFF) | 0xDC00;
|
||||
}
|
||||
#if TCL_UTF_MAX < 4
|
||||
cesu8:
|
||||
#endif
|
||||
*dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
|
||||
*dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
|
||||
*dst++ = (char) ((ch | 0x80) & 0xBF);
|
||||
continue;
|
||||
#if TCL_UTF_MAX < 4
|
||||
} else if (SURROGATE(ch)) {
|
||||
/*
|
||||
* A surrogate character is detected, handle especially.
|
||||
*/
|
||||
if (PROFILE_STRICT(profile) && (flags & ENCODING_UTF)) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
src = saveSrc;
|
||||
break;
|
||||
}
|
||||
if (PROFILE_REPLACE(profile)) {
|
||||
/* TODO - is this right for cesu8 or should we fall through below? */
|
||||
ch = UNICODE_REPLACE_CHAR;
|
||||
} else {
|
||||
int low = ch;
|
||||
len = (src <= srcEnd - 3) ? TclUtfToUCS4(src, &low) : 0;
|
||||
|
||||
if ((!LOW_SURROGATE(low)) || (ch & 0x400)) {
|
||||
|
||||
if (PROFILE_STRICT(profile)) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
src = saveSrc;
|
||||
break;
|
||||
}
|
||||
goto cesu8;
|
||||
}
|
||||
src += len;
|
||||
dst += Tcl_UniCharToUtf(ch, dst);
|
||||
ch = low;
|
||||
}
|
||||
#endif
|
||||
} else if (PROFILE_STRICT(profile) &&
|
||||
(!(flags & ENCODING_INPUT)) &&
|
||||
SURROGATE(ch)) {
|
||||
@@ -2767,15 +2706,6 @@ Utf32ToUtfProc(
|
||||
}
|
||||
result = TCL_OK;
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Initialize the buffer so that some random data doesn't trick
|
||||
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
|
||||
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
|
||||
* prior non-stateful nature, this call to memset can also be removed.
|
||||
*/
|
||||
memset(dst, 0xff, dstLen);
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Check alignment with utf-32 (4 == sizeof(UTF-32))
|
||||
*/
|
||||
@@ -2785,21 +2715,6 @@ Utf32ToUtfProc(
|
||||
srcLen -= bytesLeft;
|
||||
}
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
/*
|
||||
* If last code point is a high surrogate, we cannot handle that yet,
|
||||
* unless we are at the end.
|
||||
*/
|
||||
|
||||
if (!(flags & TCL_ENCODING_END) && (srcLen >= 4) &&
|
||||
((src[srcLen - ((flags & TCL_ENCODING_LE)?3:2)] & 0xFC) == 0xD8) &&
|
||||
((src[srcLen - ((flags & TCL_ENCODING_LE)?2:3)]) == 0) &&
|
||||
((src[srcLen - ((flags & TCL_ENCODING_LE)?1:4)]) == 0)) {
|
||||
result = TCL_CONVERT_MULTIBYTE;
|
||||
srcLen-= 4;
|
||||
}
|
||||
#endif
|
||||
|
||||
srcStart = src;
|
||||
srcEnd = src + srcLen;
|
||||
|
||||
@@ -2812,20 +2727,11 @@ Utf32ToUtfProc(
|
||||
break;
|
||||
}
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
int prev = ch;
|
||||
#endif
|
||||
if (flags & TCL_ENCODING_LE) {
|
||||
ch = (unsigned int)(src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
|
||||
} else {
|
||||
ch = (unsigned int)(src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);
|
||||
}
|
||||
#if TCL_UTF_MAX < 4
|
||||
if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) {
|
||||
/* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */
|
||||
dst += Tcl_UniCharToUtf(-1, dst);
|
||||
}
|
||||
#endif
|
||||
|
||||
if ((unsigned)ch > 0x10FFFF) {
|
||||
ch = UNICODE_REPLACE_CHAR;
|
||||
@@ -2835,9 +2741,6 @@ Utf32ToUtfProc(
|
||||
}
|
||||
} else if (PROFILE_STRICT(flags) && SURROGATE(ch)) {
|
||||
result = TCL_CONVERT_SYNTAX;
|
||||
#if TCL_UTF_MAX < 4
|
||||
ch = 0;
|
||||
#endif
|
||||
break;
|
||||
} else if (PROFILE_REPLACE(flags) && SURROGATE(ch)) {
|
||||
ch = UNICODE_REPLACE_CHAR;
|
||||
@@ -2851,11 +2754,6 @@ Utf32ToUtfProc(
|
||||
if ((unsigned)ch - 1 < 0x7F) {
|
||||
*dst++ = (ch & 0xFF);
|
||||
} else {
|
||||
#if TCL_UTF_MAX < 4
|
||||
if (!HIGH_SURROGATE(prev) && LOW_SURROGATE(ch)) {
|
||||
*dst = 0; /* In case of lower surrogate, don't try to combine */
|
||||
}
|
||||
#endif
|
||||
dst += Tcl_UniCharToUtf(ch, dst);
|
||||
}
|
||||
src += 4;
|
||||
@@ -2865,13 +2763,6 @@ Utf32ToUtfProc(
|
||||
* If we had a truncated code unit at the end AND this is the last
|
||||
* fragment AND profile is not "strict", stick FFFD in its place.
|
||||
*/
|
||||
#if TCL_UTF_MAX < 4
|
||||
if (HIGH_SURROGATE(ch)) {
|
||||
/* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */
|
||||
dst += Tcl_UniCharToUtf(-1, dst);
|
||||
}
|
||||
#endif
|
||||
|
||||
if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) {
|
||||
if (dst > dstEnd) {
|
||||
result = TCL_CONVERT_NOSPACE;
|
||||
@@ -2964,7 +2855,7 @@ UtfToUtf32Proc(
|
||||
result = TCL_CONVERT_NOSPACE;
|
||||
break;
|
||||
}
|
||||
len = TclUtfToUCS4(src, &ch);
|
||||
len = Tcl_UtfToUniChar(src, &ch);
|
||||
if (SURROGATE(ch)) {
|
||||
if (PROFILE_STRICT(flags)) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
@@ -3045,15 +2936,6 @@ Utf16ToUtfProc(
|
||||
}
|
||||
result = TCL_OK;
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Initialize the buffer so that some random data doesn't trick
|
||||
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
|
||||
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
|
||||
* prior non-stateful nature, this call to memset can also be removed.
|
||||
*/
|
||||
memset(dst, 0xff, dstLen);
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Check alignment with utf-16 (2 == sizeof(UTF-16))
|
||||
*/
|
||||
@@ -3234,7 +3116,7 @@ UtfToUtf16Proc(
|
||||
}
|
||||
|
||||
dstStart = dst;
|
||||
dstEnd = dst + dstLen - 2; /* 2 -> sizeof a UTF-16 code unit */
|
||||
dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
|
||||
flags |= PTR2INT(clientData);
|
||||
|
||||
result = TCL_OK;
|
||||
@@ -3252,7 +3134,7 @@ UtfToUtf16Proc(
|
||||
result = TCL_CONVERT_NOSPACE;
|
||||
break;
|
||||
}
|
||||
len = TclUtfToUCS4(src, &ch);
|
||||
len = Tcl_UtfToUniChar(src, &ch);
|
||||
if (SURROGATE(ch)) {
|
||||
if (PROFILE_STRICT(flags)) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
@@ -3344,7 +3226,7 @@ UtfToUcs2Proc(
|
||||
}
|
||||
|
||||
dstStart = dst;
|
||||
dstEnd = dst + dstLen - 2; /* 2 - size of UCS code unit */
|
||||
dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
|
||||
|
||||
result = TCL_OK;
|
||||
for (numChars = 0; src < srcEnd; numChars++) {
|
||||
@@ -3361,18 +3243,7 @@ UtfToUcs2Proc(
|
||||
result = TCL_CONVERT_NOSPACE;
|
||||
break;
|
||||
}
|
||||
#if TCL_UTF_MAX < 4
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
if ((ch >= 0xD800) && (len < 3)) {
|
||||
if (PROFILE_STRICT(flags)) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
break;
|
||||
}
|
||||
src += len;
|
||||
src += TclUtfToUniChar(src, &ch);
|
||||
ch = UNICODE_REPLACE_CHAR;
|
||||
}
|
||||
#else
|
||||
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
if (ch > 0xFFFF) {
|
||||
if (PROFILE_STRICT(flags)) {
|
||||
@@ -3381,7 +3252,6 @@ UtfToUcs2Proc(
|
||||
}
|
||||
ch = UNICODE_REPLACE_CHAR;
|
||||
}
|
||||
#endif
|
||||
if (PROFILE_STRICT(flags) && SURROGATE(ch)) {
|
||||
result = TCL_CONVERT_SYNTAX;
|
||||
break;
|
||||
@@ -3467,15 +3337,6 @@ TableToUtfProc(
|
||||
dstStart = dst;
|
||||
dstEnd = dst + dstLen - TCL_UTF_MAX;
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Initialize the buffer so that some random data doesn't trick
|
||||
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
|
||||
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
|
||||
* prior non-stateful nature, this call to memset can also be removed.
|
||||
*/
|
||||
memset(dst, 0xff, dstLen);
|
||||
#endif
|
||||
|
||||
toUnicode = (const unsigned short *const *) dataPtr->toUnicode;
|
||||
prefixBytes = dataPtr->prefixBytes;
|
||||
pageZero = toUnicode[0];
|
||||
@@ -3488,28 +3349,30 @@ TableToUtfProc(
|
||||
}
|
||||
byte = *((unsigned char *) src);
|
||||
if (prefixBytes[byte]) {
|
||||
if (src >= srcEnd-1) {
|
||||
/* Prefix byte but nothing after it */
|
||||
src++;
|
||||
if (src >= srcEnd) {
|
||||
if (!(flags & TCL_ENCODING_END)) {
|
||||
/* More data to come */
|
||||
src--;
|
||||
result = TCL_CONVERT_MULTIBYTE;
|
||||
break;
|
||||
} else if (PROFILE_STRICT(flags)) {
|
||||
src--;
|
||||
result = TCL_CONVERT_SYNTAX;
|
||||
break;
|
||||
} else if (PROFILE_REPLACE(flags)) {
|
||||
ch = UNICODE_REPLACE_CHAR;
|
||||
} else {
|
||||
ch = (Tcl_UniChar)byte;
|
||||
src--; /* See bug [bdcb5126c0] */
|
||||
result = TCL_CONVERT_MULTIBYTE;
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
ch = toUnicode[byte][*((unsigned char *)++src)];
|
||||
ch = toUnicode[byte][*((unsigned char *)src)];
|
||||
}
|
||||
} else {
|
||||
ch = pageZero[byte];
|
||||
}
|
||||
if ((ch == 0) && (byte != 0)) {
|
||||
/* Prefix+suffix pair is invalid */
|
||||
if (PROFILE_STRICT(flags)) {
|
||||
result = TCL_CONVERT_SYNTAX;
|
||||
break;
|
||||
@@ -3536,7 +3399,6 @@ TableToUtfProc(
|
||||
src++;
|
||||
}
|
||||
|
||||
assert(src <= srcEnd);
|
||||
*srcReadPtr = src - srcStart;
|
||||
*dstWrotePtr = dst - dstStart;
|
||||
*dstCharsPtr = numChars;
|
||||
@@ -3619,17 +3481,12 @@ TableFromUtfProc(
|
||||
}
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
|
||||
#if TCL_UTF_MAX > 3
|
||||
/* Unicode chars > +U0FFFF cannot be represented in any table encoding */
|
||||
if (ch & 0xFFFF0000) {
|
||||
word = 0;
|
||||
} else
|
||||
#else
|
||||
if (!len) {
|
||||
word = 0;
|
||||
} else
|
||||
#endif
|
||||
} else {
|
||||
word = fromUnicode[(ch >> 8)][ch & 0xFF];
|
||||
}
|
||||
|
||||
if ((word == 0) && (ch != 0)) {
|
||||
if (PROFILE_STRICT(flags)) {
|
||||
@@ -3716,15 +3573,6 @@ Iso88591ToUtfProc(
|
||||
dstStart = dst;
|
||||
dstEnd = dst + dstLen - TCL_UTF_MAX;
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Initialize the buffer so that some random data doesn't trick
|
||||
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
|
||||
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
|
||||
* prior non-stateful nature, this call to memset can also be removed.
|
||||
*/
|
||||
memset(dst, 0xff, dstLen);
|
||||
#endif
|
||||
|
||||
result = TCL_OK;
|
||||
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
|
||||
Tcl_UniChar ch = 0;
|
||||
@@ -3826,24 +3674,14 @@ Iso88591FromUtfProc(
|
||||
* Check for illegal characters.
|
||||
*/
|
||||
|
||||
if (ch > 0xFF
|
||||
#if TCL_UTF_MAX < 4
|
||||
|| ((ch >= 0xD800) && (len < 3))
|
||||
#endif
|
||||
) {
|
||||
if (ch > 0xFF) {
|
||||
if (PROFILE_STRICT(flags)) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
break;
|
||||
}
|
||||
#if TCL_UTF_MAX < 4
|
||||
if ((ch >= 0xD800) && (len < 3)) {
|
||||
len = 4;
|
||||
}
|
||||
#endif
|
||||
/*
|
||||
* Plunge on, using '?' as a fallback character.
|
||||
*/
|
||||
|
||||
ch = (Tcl_UniChar) '?'; /* Profiles TCL8 and REPLACE */
|
||||
}
|
||||
|
||||
@@ -3964,15 +3802,6 @@ EscapeToUtfProc(
|
||||
dstStart = dst;
|
||||
dstEnd = dst + dstLen - TCL_UTF_MAX;
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Initialize the buffer so that some random data doesn't trick
|
||||
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
|
||||
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
|
||||
* prior non-stateful nature, this call to memset can also be removed.
|
||||
*/
|
||||
memset(dst, 0xff, dstLen);
|
||||
#endif
|
||||
|
||||
state = PTR2INT(*statePtr);
|
||||
if (flags & TCL_ENCODING_START) {
|
||||
state = 0;
|
||||
@@ -4069,10 +3898,12 @@ EscapeToUtfProc(
|
||||
if ((checked == dataPtr->numSubTables + 2)
|
||||
|| (flags & TCL_ENCODING_END)) {
|
||||
if (!PROFILE_STRICT(flags)) {
|
||||
unsigned skip = longest > left ? left : longest;
|
||||
/* Unknown escape sequence */
|
||||
dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
|
||||
src += skip;
|
||||
/*
|
||||
* Skip the unknown escape sequence. TODO - bug?
|
||||
* May be replace with UNICODE_REPLACE_CHAR?
|
||||
*/
|
||||
|
||||
src += longest;
|
||||
continue;
|
||||
}
|
||||
result = TCL_CONVERT_SYNTAX;
|
||||
|
||||
+39
-10
@@ -312,7 +312,17 @@ TclNamespaceEnsembleCmd(
|
||||
Tcl_AppendObjToObj(newCmd, listv[0]);
|
||||
Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
|
||||
if (patchedDict == NULL) {
|
||||
patchedDict = Tcl_DuplicateObj(objv[1]);
|
||||
patchedDict = TclDuplicatePureObj(
|
||||
interp, objv[1], &tclDictType);
|
||||
if (!patchedDict) {
|
||||
if (allocatedMapFlag) {
|
||||
Tcl_DecrRefCount(mapObj);
|
||||
}
|
||||
Tcl_DecrRefCount(newList);
|
||||
Tcl_DecrRefCount(newCmd);
|
||||
Tcl_DecrRefCount(patchedDict);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
|
||||
newList);
|
||||
@@ -596,7 +606,14 @@ TclNamespaceEnsembleCmd(
|
||||
}
|
||||
cmd = TclGetString(listv[0]);
|
||||
if (!(cmd[0] == ':' && cmd[1] == ':')) {
|
||||
Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
|
||||
Tcl_Obj *newList = TclDuplicatePureObj(
|
||||
interp, listObj, tclListType);
|
||||
if (!newList) {
|
||||
if (patchedDict) {
|
||||
Tcl_DecrRefCount(patchedDict);
|
||||
}
|
||||
goto freeMapAndError;
|
||||
}
|
||||
Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);
|
||||
|
||||
if (nsPtr->parentPtr) {
|
||||
@@ -606,7 +623,11 @@ TclNamespaceEnsembleCmd(
|
||||
Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
|
||||
&newCmd);
|
||||
if (patchedDict == NULL) {
|
||||
patchedDict = Tcl_DuplicateObj(objv[1]);
|
||||
patchedDict = TclDuplicatePureObj(
|
||||
interp, objv[1], tclListType);
|
||||
if (!patchedDict) {
|
||||
goto freeMapAndError;
|
||||
}
|
||||
}
|
||||
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
|
||||
newList);
|
||||
@@ -1904,7 +1925,11 @@ NsEnsembleImplementationCmdNR(
|
||||
TclListObjLengthM(NULL, prefixObj, &prefixObjc);
|
||||
|
||||
if (objc == 2) {
|
||||
copyPtr = TclListObjCopy(NULL, prefixObj);
|
||||
copyPtr = TclDuplicatePureObj(
|
||||
interp, prefixObj, tclListType);
|
||||
if (!copyPtr) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
|
||||
Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
|
||||
@@ -2304,7 +2329,11 @@ EnsembleUnknownCallback(
|
||||
* Create the "unknown" command callback to determine what to do.
|
||||
*/
|
||||
|
||||
unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
|
||||
unknownCmd = TclDuplicatePureObj(
|
||||
interp, ensemblePtr->unknownHandler, tclListType);
|
||||
if (!unknownCmd) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
TclNewObj(ensObj);
|
||||
Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
|
||||
Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
|
||||
@@ -3264,7 +3293,7 @@ TclAttemptCompileProc(
|
||||
Tcl_Size i;
|
||||
Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
|
||||
Tcl_Size savedStackDepth = envPtr->currStackDepth;
|
||||
Tcl_Size savedCodeNext = envPtr->codeNext - envPtr->codeStart;
|
||||
unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
|
||||
Tcl_Size savedAuxDataArrayNext = envPtr->auxDataArrayNext;
|
||||
Tcl_Size savedExceptArrayNext = envPtr->exceptArrayNext;
|
||||
#ifdef TCL_COMPILE_DEBUG
|
||||
@@ -3327,13 +3356,13 @@ TclAttemptCompileProc(
|
||||
ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr;
|
||||
|
||||
for (i = 0; i < savedExceptArrayNext; i++) {
|
||||
while (auxPtr->numBreakTargets > 0
|
||||
&& (Tcl_Size) auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
|
||||
while ((int)auxPtr->numBreakTargets > 0
|
||||
&& auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
|
||||
>= savedCodeNext) {
|
||||
auxPtr->numBreakTargets--;
|
||||
}
|
||||
while (auxPtr->numContinueTargets > 0
|
||||
&& (Tcl_Size) auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
|
||||
while ((int)auxPtr->numContinueTargets > 0
|
||||
&& auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
|
||||
>= savedCodeNext) {
|
||||
auxPtr->numContinueTargets--;
|
||||
}
|
||||
|
||||
+27
-43
@@ -19,20 +19,20 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
|
||||
|
||||
#if defined(_WIN32)
|
||||
# define tenviron _wenviron
|
||||
# define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
|
||||
(char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr)))
|
||||
# define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
|
||||
(const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr)))
|
||||
# define tenviron2utfdstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
|
||||
(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)))
|
||||
# define utf2tenvirondstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
|
||||
(const WCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr)))
|
||||
# define techar WCHAR
|
||||
# ifdef USE_PUTENV
|
||||
# define putenv(env) _wputenv((const wchar_t *)env)
|
||||
# endif
|
||||
#else
|
||||
# define tenviron environ
|
||||
# define tenviron2utfdstr(str, dsPtr) \
|
||||
Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr)
|
||||
# define utf2tenvirondstr(str, dsPtr) \
|
||||
Tcl_UtfToExternalDString(NULL, str, -1, dsPtr)
|
||||
# define tenviron2utfdstr(tenvstr, len, dstr) \
|
||||
Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr)
|
||||
# define utf2tenvirondstr(str, len, dstr) \
|
||||
Tcl_UtfToExternalDString(NULL, str, len, dstr)
|
||||
# define techar char
|
||||
#endif
|
||||
|
||||
@@ -42,7 +42,7 @@ size_t TclEnvEpoch = 0; /* Epoch of the tcl environment
|
||||
* (if changed with tcl-env). */
|
||||
|
||||
static struct {
|
||||
Tcl_Size cacheSize; /* Number of env strings in cache. */
|
||||
size_t cacheSize; /* Number of env strings in cache. */
|
||||
char **cache; /* Array containing all of the environment
|
||||
* strings that Tcl has allocated. */
|
||||
#ifndef USE_PUTENV
|
||||
@@ -159,11 +159,7 @@ TclSetupEnv(
|
||||
const char *p1;
|
||||
char *p2;
|
||||
|
||||
p1 = tenviron2utfdstr(tenviron[i], &envString);
|
||||
if (p1 == NULL) {
|
||||
/* Ignore what cannot be decoded (should not happen) */
|
||||
continue;
|
||||
}
|
||||
p1 = tenviron2utfdstr(tenviron[i], -1, &envString);
|
||||
p2 = (char *)strchr(p1, '=');
|
||||
if (p2 == NULL) {
|
||||
/*
|
||||
@@ -305,9 +301,9 @@ TclSetEnv(
|
||||
* interpreters.
|
||||
*/
|
||||
|
||||
oldEnv = tenviron2utfdstr(tenviron[index], &envString);
|
||||
if (oldEnv == NULL || strcmp(value, oldEnv + (length + 1)) == 0) {
|
||||
Tcl_DStringFree(&envString); /* OK even if oldEnv is NULL */
|
||||
oldEnv = tenviron2utfdstr(tenviron[index], -1, &envString);
|
||||
if (strcmp(value, oldEnv + (length + 1)) == 0) {
|
||||
Tcl_DStringFree(&envString);
|
||||
Tcl_MutexUnlock(&envMutex);
|
||||
return;
|
||||
}
|
||||
@@ -328,13 +324,7 @@ TclSetEnv(
|
||||
memcpy(p, name, nameLength);
|
||||
p[nameLength] = '=';
|
||||
memcpy(p+nameLength+1, value, valueLength+1);
|
||||
p2 = utf2tenvirondstr(p, &envString);
|
||||
if (p2 == NULL) {
|
||||
/* No way to signal error from here :-( but should not happen */
|
||||
Tcl_Free(p);
|
||||
Tcl_MutexUnlock(&envMutex);
|
||||
return;
|
||||
}
|
||||
p2 = utf2tenvirondstr(p, -1, &envString);
|
||||
|
||||
/*
|
||||
* Copy the native string to heap memory.
|
||||
@@ -512,11 +502,7 @@ TclUnsetEnv(
|
||||
string[length] = '\0';
|
||||
#endif /* _WIN32 */
|
||||
|
||||
if (utf2tenvirondstr(string, &envString) == NULL) {
|
||||
/* Should not happen except memory alloc fail. */
|
||||
Tcl_MutexUnlock(&envMutex);
|
||||
return;
|
||||
}
|
||||
utf2tenvirondstr(string, -1, &envString);
|
||||
string = (char *)Tcl_Realloc(string, Tcl_DStringLength(&envString) + tNTL);
|
||||
memcpy(string, Tcl_DStringValue(&envString),
|
||||
Tcl_DStringLength(&envString) + tNTL);
|
||||
@@ -591,19 +577,17 @@ TclGetEnv(
|
||||
if (index != -1) {
|
||||
Tcl_DString envStr;
|
||||
|
||||
result = tenviron2utfdstr(tenviron[index], &envStr);
|
||||
if (result) {
|
||||
result += length;
|
||||
if (*result == '=') {
|
||||
result++;
|
||||
Tcl_DStringInit(valuePtr);
|
||||
Tcl_DStringAppend(valuePtr, result, -1);
|
||||
result = Tcl_DStringValue(valuePtr);
|
||||
} else {
|
||||
result = NULL;
|
||||
}
|
||||
Tcl_DStringFree(&envStr);
|
||||
result = tenviron2utfdstr(tenviron[index], -1, &envStr);
|
||||
result += length;
|
||||
if (*result == '=') {
|
||||
result++;
|
||||
Tcl_DStringInit(valuePtr);
|
||||
Tcl_DStringAppend(valuePtr, result, -1);
|
||||
result = Tcl_DStringValue(valuePtr);
|
||||
} else {
|
||||
result = NULL;
|
||||
}
|
||||
Tcl_DStringFree(&envStr);
|
||||
}
|
||||
Tcl_MutexUnlock(&envMutex);
|
||||
return result;
|
||||
@@ -719,7 +703,7 @@ ReplaceString(
|
||||
const char *oldStr, /* Old environment string. */
|
||||
char *newStr) /* New environment string. */
|
||||
{
|
||||
Tcl_Size i;
|
||||
size_t i;
|
||||
|
||||
/*
|
||||
* Check to see if the old value was allocated by Tcl. If so, it needs to
|
||||
@@ -798,7 +782,7 @@ TclFinalizeEnvironment(void)
|
||||
|
||||
if (env.cache) {
|
||||
#ifdef PURIFY
|
||||
Tcl_Size i;
|
||||
size_t i;
|
||||
for (i = 0; i < env.cacheSize; i++) {
|
||||
Tcl_Free(env.cache[i]);
|
||||
}
|
||||
|
||||
+5
-7
@@ -232,7 +232,11 @@ HandleBgErrors(
|
||||
* support one handler setting another handler.
|
||||
*/
|
||||
|
||||
Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
|
||||
Tcl_Obj *copyObj = TclDuplicatePureObj(
|
||||
interp, assocPtr->cmdPrefix, tclListType);
|
||||
if (!copyObj) {
|
||||
return;
|
||||
}
|
||||
|
||||
errPtr = assocPtr->firstBgPtr;
|
||||
|
||||
@@ -1084,9 +1088,6 @@ static const struct {
|
||||
#ifdef USE_NMAKE
|
||||
".nmake"
|
||||
#endif
|
||||
#ifdef TCL_NO_DEPRECATED
|
||||
".no-deprecate"
|
||||
#endif
|
||||
#if !TCL_THREADS
|
||||
".no-thread"
|
||||
#endif
|
||||
@@ -1108,9 +1109,6 @@ static const struct {
|
||||
#ifdef STATIC_BUILD
|
||||
".static"
|
||||
#endif
|
||||
#if TCL_UTF_MAX < 4
|
||||
".utf-16"
|
||||
#endif
|
||||
}};
|
||||
|
||||
const char *
|
||||
|
||||
+351
-283
@@ -10,6 +10,7 @@
|
||||
* Copyright © 2005-2007 Donal K. Fellows.
|
||||
* Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
|
||||
* Copyright © 2006-2008 Joe Mistachkin. All rights reserved.
|
||||
* Copyright © 2021 Nathan Coulter. All rights reserved.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -450,11 +451,11 @@ VarHashCreateVar(
|
||||
*/
|
||||
|
||||
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
|
||||
((TclHasInternalRep((objPtr), &tclIntType)) \
|
||||
((TclHasInternalRep((objPtr), tclIntType)) \
|
||||
? (*(tPtr) = TCL_NUMBER_INT, \
|
||||
*(ptrPtr) = (void *) \
|
||||
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
|
||||
TclHasInternalRep((objPtr), &tclDoubleType) \
|
||||
TclHasInternalRep((objPtr), tclDoubleType) \
|
||||
? (((isnan((objPtr)->internalRep.doubleValue)) \
|
||||
? (*(tPtr) = TCL_NUMBER_NAN) \
|
||||
: (*(tPtr) = TCL_NUMBER_DOUBLE)), \
|
||||
@@ -634,7 +635,7 @@ static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc,
|
||||
int searchMode, ByteCode *codePtr);
|
||||
static const char * GetSrcInfoForPc(const unsigned char *pc,
|
||||
ByteCode *codePtr, Tcl_Size *lengthPtr,
|
||||
const unsigned char **pcBeg, Tcl_Size *cmdIdxPtr);
|
||||
const unsigned char **pcBeg, int *cmdIdxPtr);
|
||||
static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, TCL_HASH_TYPE growth,
|
||||
int move);
|
||||
static void IllegalExprOperandType(Tcl_Interp *interp,
|
||||
@@ -673,8 +674,7 @@ static const Tcl_ObjType exprCodeType = {
|
||||
static const Tcl_ObjType dictIteratorType = {
|
||||
"dictIterator",
|
||||
ReleaseDictIterator,
|
||||
NULL, NULL, NULL,
|
||||
TCL_OBJTYPE_V0
|
||||
NULL, NULL, NULL, TCL_OBJTYPE_V0
|
||||
};
|
||||
|
||||
/*
|
||||
@@ -1481,7 +1481,7 @@ CompileExprObj(
|
||||
* DupExprCodeInternalRep --
|
||||
*
|
||||
* Part of the Tcl object type implementation for Tcl expression
|
||||
* bytecode. We do not copy the bytecode internalrep. Instead, we return
|
||||
* bytecode. We do not copy the bytecode intrep. Instead, we return
|
||||
* without setting copyPtr->typePtr, so the copy is a plain string copy
|
||||
* of the expression value, and if it is to be used as a compiled
|
||||
* expression, it will just need a recompile.
|
||||
@@ -1490,7 +1490,7 @@ CompileExprObj(
|
||||
* usual (only?) time Tcl_DuplicateObj() will be called is when the copy
|
||||
* is about to be modified, which would invalidate any copied bytecode
|
||||
* anyway. The only reason it might make sense to copy the bytecode is if
|
||||
* we had some modifying routines that operated directly on the internalrep,
|
||||
* we had some modifying routines that operated directly on the intrep,
|
||||
* like we do for lists and dicts.
|
||||
*
|
||||
* Results:
|
||||
@@ -1850,7 +1850,7 @@ ArgumentBCEnter(
|
||||
int objc,
|
||||
Tcl_Obj **objv)
|
||||
{
|
||||
Tcl_Size cmd;
|
||||
int cmd;
|
||||
|
||||
if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
|
||||
TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd,
|
||||
@@ -2598,16 +2598,13 @@ TEBCresume(
|
||||
case INST_STR_CONCAT1:
|
||||
|
||||
opnd = TclGetUInt1AtPtr(pc+1);
|
||||
DECACHE_STACK_INFO();
|
||||
objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
|
||||
TCL_STRING_IN_PLACE);
|
||||
if (objResultPtr == NULL) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
|
||||
NEXT_INST_V(2, opnd, 1);
|
||||
break;
|
||||
@@ -3377,7 +3374,12 @@ TEBCresume(
|
||||
goto gotError;
|
||||
}
|
||||
if (Tcl_IsShared(objResultPtr)) {
|
||||
Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
|
||||
Tcl_Obj *newValue = TclDuplicatePureObj(
|
||||
interp, objResultPtr, tclListType);
|
||||
if (!newValue) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
|
||||
TclDecrRefCount(objResultPtr);
|
||||
varPtr->value.objPtr = objResultPtr = newValue;
|
||||
@@ -3436,7 +3438,11 @@ TEBCresume(
|
||||
goto gotError;
|
||||
} else {
|
||||
if (Tcl_IsShared(objResultPtr)) {
|
||||
valueToAssign = Tcl_DuplicateObj(objResultPtr);
|
||||
valueToAssign = TclDuplicatePureObj(
|
||||
interp, objResultPtr, tclListType);
|
||||
if (!valueToAssign) {
|
||||
goto errorInLappendListPtr;
|
||||
}
|
||||
createdNewObj = 1;
|
||||
} else {
|
||||
valueToAssign = objResultPtr;
|
||||
@@ -4632,7 +4638,8 @@ TEBCresume(
|
||||
*/
|
||||
|
||||
{
|
||||
int numIndices, nocase, match, cflags;
|
||||
int dstatus, numIndices, nocase, match, cflags,
|
||||
toIdxAnchor, fromIdxAnchor;
|
||||
Tcl_Size slength, length2, fromIdx, toIdx, index, s1len, s2len;
|
||||
const char *s1, *s2;
|
||||
|
||||
@@ -4661,70 +4668,79 @@ TEBCresume(
|
||||
value2Ptr = OBJ_AT_TOS;
|
||||
valuePtr = OBJ_UNDER_TOS;
|
||||
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
|
||||
if (
|
||||
TclHasInternalRep(value2Ptr, tclListType)
|
||||
||
|
||||
TclObjectHasInterface(value2Ptr, list, length)
|
||||
) {
|
||||
Tcl_Size value2Length;
|
||||
if (Tcl_ListObjLength(interp,value2Ptr,&value2Length),
|
||||
value2Length == 1) {
|
||||
if (TclHasInternalRep(value2Ptr, tclListType)) {
|
||||
value2Ptr = TclListObjGetElement(value2Ptr, 0);
|
||||
} else {
|
||||
Tcl_ListObjIndex(interp, value2Ptr, 0, &value2Ptr);
|
||||
}
|
||||
} else {
|
||||
goto TclLindexList;
|
||||
}
|
||||
}
|
||||
|
||||
/* special case for AbstractList */
|
||||
if (TclObjTypeHasProc(valuePtr,indexProc)) {
|
||||
if (TclObjectHasInterface(valuePtr, list, length)
|
||||
|| TclHasInternalRep(valuePtr, tclListType)) {
|
||||
int code, haveElements = 0, status;
|
||||
|
||||
if (TclHasInternalRep(valuePtr, tclListType)) {
|
||||
/* since the type is tclListtype, this can't fail */
|
||||
TclListObjGetElementsM(interp, valuePtr, &objc, &objv);
|
||||
haveElements = 1;
|
||||
} else {
|
||||
TclObjectDispatchNoDefault(interp, status, valuePtr, list,
|
||||
length, interp, valuePtr, &objc);
|
||||
if (status != TCL_OK) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
|
||||
if (objc < 0) {
|
||||
objc = TCL_SIZE_MAX;
|
||||
}
|
||||
}
|
||||
|
||||
Tcl_IncrRefCount(value2Ptr);
|
||||
DECACHE_STACK_INFO();
|
||||
length = TclObjTypeLength(valuePtr);
|
||||
if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index);
|
||||
CACHE_STACK_INFO();
|
||||
if (code != TCL_OK) {
|
||||
goto TclLindexList;
|
||||
}
|
||||
Tcl_DecrRefCount(value2Ptr);
|
||||
|
||||
if (haveElements && code == TCL_OK) {
|
||||
tosPtr--;
|
||||
pcAdjustment = 1;
|
||||
goto lindexFastPath;
|
||||
}
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
TclObjectDispatchNoDefault(interp, status, valuePtr, list,
|
||||
index, interp, valuePtr, index, &objResultPtr);
|
||||
if (status != TCL_OK) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
if (objResultPtr == NULL) {
|
||||
/* Index is out of range, return empty result. */
|
||||
TclNewObj(objResultPtr);
|
||||
}
|
||||
Tcl_IncrRefCount(objResultPtr); // reference held here
|
||||
goto lindexDone;
|
||||
}
|
||||
|
||||
}
|
||||
TclLindexList:
|
||||
/*
|
||||
* Extract the desired list element.
|
||||
*/
|
||||
|
||||
{
|
||||
Tcl_Size value2Length;
|
||||
Tcl_Obj *indexListPtr = value2Ptr;
|
||||
if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
|
||||
&& (
|
||||
!TclHasInternalRep(value2Ptr, &tclListType)
|
||||
||
|
||||
((Tcl_ListObjLength(interp,value2Ptr,&value2Length),
|
||||
value2Length == 1
|
||||
? (indexListPtr = TclListObjGetElement(value2Ptr, 0), 1)
|
||||
: 0
|
||||
))
|
||||
)
|
||||
) {
|
||||
int code;
|
||||
|
||||
/* increment the refCount of value2Ptr because TclListObjGetElement may
|
||||
* have just extracted it from a list in the condition for this block.
|
||||
*/
|
||||
Tcl_IncrRefCount(indexListPtr);
|
||||
|
||||
DECACHE_STACK_INFO();
|
||||
code = TclGetIntForIndexM(interp, indexListPtr, objc-1, &index);
|
||||
TclDecrRefCount(indexListPtr);
|
||||
CACHE_STACK_INFO();
|
||||
if (code == TCL_OK) {
|
||||
Tcl_DecrRefCount(value2Ptr);
|
||||
tosPtr--;
|
||||
pcAdjustment = 1;
|
||||
goto lindexFastPath;
|
||||
}
|
||||
Tcl_ResetResult(interp);
|
||||
}
|
||||
}
|
||||
|
||||
DECACHE_STACK_INFO();
|
||||
objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
|
||||
CACHE_STACK_INFO();
|
||||
|
||||
@@ -4752,45 +4768,82 @@ TEBCresume(
|
||||
opnd = TclGetInt4AtPtr(pc+1);
|
||||
TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
|
||||
|
||||
if (TclObjectHasInterface(valuePtr, list, length)) {
|
||||
TCL_UNUSEDVAR(int status);
|
||||
TclObjectDispatchNoDefault(interp, status, valuePtr, list,
|
||||
length, interp, valuePtr, &length);
|
||||
|
||||
/* Decode end-offset index values. */
|
||||
|
||||
index = TclIndexDecode(opnd, length-1);
|
||||
|
||||
/* Compute value @ index */
|
||||
if (index >= 0 && index < length) {
|
||||
TclObjectDispatchNoDefault(interp, status, valuePtr, list,
|
||||
index, interp, valuePtr, index, &objResultPtr);
|
||||
if (objResultPtr == NULL) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
} else {
|
||||
TclNewObj(objResultPtr);
|
||||
}
|
||||
pcAdjustment = 5;
|
||||
goto lindexFastPath2;
|
||||
}
|
||||
|
||||
/*
|
||||
* Get the contents of the list, making sure that it really is a list
|
||||
* in the process.
|
||||
*/
|
||||
|
||||
/* special case for AbstractList */
|
||||
if (TclObjTypeHasProc(valuePtr,indexProc)) {
|
||||
length = TclObjTypeLength(valuePtr);
|
||||
if (!TclHasInternalRep(valuePtr, tclListType)
|
||||
&& TclObjectHasInterface(valuePtr, list, index)) {
|
||||
if (Tcl_ListObjLength(interp, valuePtr, &objc) != TCL_OK) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
|
||||
/* Decode end-offset index values. */
|
||||
index = TclIndexDecode(opnd, length-1);
|
||||
|
||||
if (index >= 0 && index < length) {
|
||||
/* Compute value @ index */
|
||||
DECACHE_STACK_INFO();
|
||||
if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
|
||||
CACHE_STACK_INFO();
|
||||
if (TclIndexIsFromEnd(opnd) && !Tcl_LengthIsFinite(objc)) {
|
||||
/* end-relative index, and list end is indeterminate */
|
||||
if (TclObjectDispatchNoDefault(interp, dstatus, valuePtr, list, indexEnd,
|
||||
interp, valuePtr, index, &objResultPtr) != TCL_OK
|
||||
|| dstatus != TCL_OK) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
CACHE_STACK_INFO();
|
||||
} else {
|
||||
index = TclIndexDecode(opnd, TclIndexLast(objc));
|
||||
if (Tcl_ListObjIndex(interp, valuePtr, index, &objResultPtr)
|
||||
!= TCL_OK) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
}
|
||||
if (objResultPtr == NULL) {
|
||||
TclNewObj(objResultPtr);
|
||||
}
|
||||
Tcl_IncrRefCount(objResultPtr);
|
||||
|
||||
/*
|
||||
* Stash the list element on the stack.
|
||||
*/
|
||||
|
||||
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
|
||||
/* Already has the correct refCount */
|
||||
NEXT_INST_F(5, 1, -1);
|
||||
} else {
|
||||
if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
/* Decode end-offset index values. */
|
||||
|
||||
index = TclIndexDecode(opnd, TclIndexLast(objc));
|
||||
pcAdjustment = 5;
|
||||
goto lindexFastPath2;
|
||||
}
|
||||
|
||||
/* List case */
|
||||
if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
|
||||
/* Decode end-offset index values. */
|
||||
|
||||
index = TclIndexDecode(opnd, objc - 1);
|
||||
pcAdjustment = 5;
|
||||
|
||||
lindexFastPath:
|
||||
if (index >= 0 && index < objc) {
|
||||
@@ -4854,17 +4907,9 @@ TEBCresume(
|
||||
* Compute the new variable value.
|
||||
*/
|
||||
|
||||
DECACHE_STACK_INFO();
|
||||
if (TclObjTypeHasProc(valuePtr, setElementProc)) {
|
||||
objResultPtr = TclObjTypeSetElement(interp,
|
||||
valuePtr, numIndices,
|
||||
&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
|
||||
} else {
|
||||
objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
|
||||
objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
|
||||
&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
|
||||
}
|
||||
if (!objResultPtr) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
@@ -4872,7 +4917,7 @@ TEBCresume(
|
||||
/*
|
||||
* Set result.
|
||||
*/
|
||||
CACHE_STACK_INFO();
|
||||
|
||||
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
|
||||
NEXT_INST_V(5, numIndices+1, -1);
|
||||
|
||||
@@ -4965,40 +5010,44 @@ TEBCresume(
|
||||
TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
|
||||
NEXT_INST_F(9, 1, 1);
|
||||
}
|
||||
toIdx = TclIndexDecode(toIdx, objc - 1);
|
||||
if (toIdx == TCL_INDEX_NONE) {
|
||||
goto emptyList;
|
||||
} else if (toIdx >= objc) {
|
||||
toIdx = objc - 1;
|
||||
}
|
||||
|
||||
assert (toIdx >= 0 && toIdx < objc);
|
||||
/*
|
||||
assert ( fromIdx != TCL_INDEX_NONE );
|
||||
*
|
||||
* Extra safety for legacy bytecodes:
|
||||
*/
|
||||
if (fromIdx == TCL_INDEX_NONE) {
|
||||
fromIdx = TCL_INDEX_START;
|
||||
}
|
||||
toIdxAnchor = TclIndexIsFromEnd(toIdx);
|
||||
fromIdxAnchor = TclIndexIsFromEnd(fromIdx);
|
||||
|
||||
fromIdx = TclIndexDecode(fromIdx, objc - 1);
|
||||
if (!Tcl_LengthIsFinite(objc)
|
||||
&& (toIdxAnchor == 1 || fromIdxAnchor == 1)) {
|
||||
|
||||
DECACHE_STACK_INFO();
|
||||
if (TclObjTypeHasProc(valuePtr, sliceProc)) {
|
||||
if (TclObjTypeSlice(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) {
|
||||
objResultPtr = NULL;
|
||||
toIdx = TclIndexDecode(toIdx, SIZE_MAX);
|
||||
fromIdx = TclIndexDecode(fromIdx, SIZE_MAX);
|
||||
dstatus = TclObjectDispatchNoDefault(interp, objResultPtr,
|
||||
valuePtr, list, rangeEnd, interp, valuePtr, toIdxAnchor,
|
||||
toIdx, fromIdxAnchor, fromIdx);
|
||||
if (dstatus != TCL_OK || objResultPtr == NULL) {
|
||||
goto gotError;
|
||||
}
|
||||
} else {
|
||||
toIdx = TclIndexDecode(toIdx, TclIndexLast(objc));
|
||||
if (toIdx == TCL_INDEX_NONE) {
|
||||
goto emptyList;
|
||||
} else if (Tcl_LengthIsFinite(objc) && toIdx + 1 >= objc + 1) {
|
||||
toIdx = TclIndexLast(objc);
|
||||
}
|
||||
|
||||
assert (toIdx < objc);
|
||||
/*
|
||||
assert ( fromIdx != TCL_INDEX_NONE );
|
||||
*
|
||||
* Extra safety for legacy bytecodes:
|
||||
*/
|
||||
if (fromIdx == TCL_INDEX_NONE) {
|
||||
fromIdx = TCL_INDEX_START;
|
||||
}
|
||||
|
||||
fromIdx = TclIndexDecode(fromIdx, objc - 1);
|
||||
|
||||
objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx);
|
||||
}
|
||||
if (objResultPtr == NULL) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
|
||||
NEXT_INST_F(9, 1, 1);
|
||||
|
||||
@@ -5007,60 +5056,45 @@ TEBCresume(
|
||||
value2Ptr = OBJ_AT_TOS;
|
||||
valuePtr = OBJ_UNDER_TOS;
|
||||
|
||||
s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
|
||||
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
|
||||
s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
|
||||
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
|
||||
if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
match = 0;
|
||||
if (length > 0) {
|
||||
Tcl_Size i = 0;
|
||||
Tcl_Obj *o;
|
||||
/*
|
||||
* An empty list doesn't match anything.
|
||||
*/
|
||||
|
||||
if (TclObjTypeHasProc(value2Ptr,inOperProc) != NULL) {
|
||||
int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match);
|
||||
if (status != TCL_OK) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
} else {
|
||||
|
||||
if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
match = 0;
|
||||
if (length > 0) {
|
||||
Tcl_Size i = 0;
|
||||
Tcl_Obj *o;
|
||||
int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL;
|
||||
|
||||
/*
|
||||
* An empty list doesn't match anything.
|
||||
*/
|
||||
|
||||
do {
|
||||
if (isAbstractList) {
|
||||
DECACHE_STACK_INFO();
|
||||
if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
CACHE_STACK_INFO();
|
||||
} else {
|
||||
Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
|
||||
}
|
||||
if (o != NULL) {
|
||||
s2 = Tcl_GetStringFromObj(o, &s2len);
|
||||
} else {
|
||||
s2 = "";
|
||||
s2len = 0;
|
||||
}
|
||||
if (s1len == s2len) {
|
||||
match = (memcmp(s1, s2, s1len) == 0);
|
||||
}
|
||||
|
||||
/* Could be an ephemeral abstract obj */
|
||||
Tcl_BounceRefCount(o);
|
||||
|
||||
i++;
|
||||
} while (i < length && match == 0);
|
||||
}
|
||||
}
|
||||
do {
|
||||
if (TclObjectHasInterface(valuePtr, list, index)) {
|
||||
TCL_UNUSEDVAR(int status);
|
||||
TclObjectDispatchNoDefault(interp, status, value2Ptr, list,
|
||||
index, interp, value2Ptr, i, &o);
|
||||
if (!o) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
} else {
|
||||
Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
|
||||
}
|
||||
if (o != NULL) {
|
||||
s2 = Tcl_GetStringFromObj(o, &s2len);
|
||||
} else {
|
||||
s2 = "";
|
||||
s2len = 0;
|
||||
}
|
||||
if (s1len == s2len) {
|
||||
match = (memcmp(s1, s2, s1len) == 0);
|
||||
}
|
||||
TclBounceRefCount(o);
|
||||
i++;
|
||||
} while (i < length && match == 0);
|
||||
}
|
||||
|
||||
if (*pc == INST_LIST_NOT_IN) {
|
||||
match = !match;
|
||||
@@ -5324,44 +5358,46 @@ TEBCresume(
|
||||
*/
|
||||
|
||||
slength = Tcl_GetCharLength(valuePtr);
|
||||
DECACHE_STACK_INFO();
|
||||
if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
CACHE_STACK_INFO();
|
||||
|
||||
if (index < 0 || index >= slength) {
|
||||
TclNewObj(objResultPtr);
|
||||
} else if (TclIsPureByteArray(valuePtr)) {
|
||||
objResultPtr = Tcl_NewByteArrayObj(
|
||||
Tcl_GetByteArrayFromObj(valuePtr, (Tcl_Size *)NULL)+index, 1);
|
||||
} else if (valuePtr->bytes && slength == valuePtr->length) {
|
||||
objResultPtr = Tcl_NewStringObj((const char *)
|
||||
valuePtr->bytes+index, 1);
|
||||
if (TclObjectHasInterface(valuePtr, string, index)) {
|
||||
int status;
|
||||
status = TclStringIndexInterface(interp, valuePtr, value2Ptr, &objResultPtr);
|
||||
if (status != TCL_OK) {
|
||||
goto gotError;
|
||||
}
|
||||
} else {
|
||||
char buf[4] = "";
|
||||
int ch = Tcl_GetUniChar(valuePtr, index);
|
||||
DECACHE_STACK_INFO();
|
||||
if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
CACHE_STACK_INFO();
|
||||
|
||||
/*
|
||||
* This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
|
||||
* but creating the object as a string seems to be faster in
|
||||
* practical use.
|
||||
*/
|
||||
if (ch == -1) {
|
||||
if (index < 0 || index >= slength) {
|
||||
TclNewObj(objResultPtr);
|
||||
} else if (TclIsPureByteArray(valuePtr)) {
|
||||
objResultPtr = Tcl_NewByteArrayObj(
|
||||
Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
|
||||
} else if (valuePtr->bytes && slength == valuePtr->length) {
|
||||
objResultPtr = Tcl_NewStringObj((const char *)
|
||||
valuePtr->bytes+index, 1);
|
||||
} else {
|
||||
slength = Tcl_UniCharToUtf(ch, buf);
|
||||
#if TCL_UTF_MAX < 4
|
||||
if ((ch >= 0xD800) && (slength < 3)) {
|
||||
slength += Tcl_UniCharToUtf(-1, buf + slength);
|
||||
char buf[4] = "";
|
||||
int ch = Tcl_GetUniChar(valuePtr, index);
|
||||
|
||||
/*
|
||||
* This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
|
||||
* but creating the object as a string seems to be faster in
|
||||
* practical use.
|
||||
*/
|
||||
if (ch == -1) {
|
||||
TclNewObj(objResultPtr);
|
||||
} else {
|
||||
slength = Tcl_UniCharToUtf(ch, buf);
|
||||
objResultPtr = Tcl_NewStringObj(buf, slength);
|
||||
}
|
||||
#endif
|
||||
objResultPtr = Tcl_NewStringObj(buf, slength);
|
||||
}
|
||||
}
|
||||
|
||||
TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
|
||||
NEXT_INST_F(1, 2, 1);
|
||||
|
||||
@@ -5406,14 +5442,73 @@ TEBCresume(
|
||||
NEXT_INST_F(9, 0, 0);
|
||||
}
|
||||
|
||||
/* Decode index operands. */
|
||||
if (TclObjectHasInterface(valuePtr, list, index)) {
|
||||
if ((TclIndexIsFromEnd(toIdx) || TclIndexIsFromEnd(fromIdx))
|
||||
&& !Tcl_LengthIsFinite(slength)) {
|
||||
|
||||
toIdx = TclIndexDecode(toIdx, slength - 1);
|
||||
fromIdx = TclIndexDecode(fromIdx, slength - 1);
|
||||
if (toIdx == TCL_INDEX_NONE) {
|
||||
TclNewObj(objResultPtr);
|
||||
fromIdx = TclIndexDecode(fromIdx, TclIndexLast(slength));
|
||||
toIdx = TclIndexDecode(toIdx, TclIndexLast(slength));
|
||||
|
||||
if (TclObjectDispatchNoDefault(interp, objResultPtr, valuePtr,
|
||||
string, rangeEnd, valuePtr, fromIdx, toIdx) != TCL_OK
|
||||
|| objResultPtr == NULL) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
} else {
|
||||
fromIdx = TclIndexDecode(fromIdx, TclIndexLast(slength));
|
||||
toIdx = TclIndexDecode(toIdx, TclIndexLast(slength));
|
||||
if (TclObjectDispatchNoDefault(interp, objResultPtr, valuePtr,
|
||||
string, range, valuePtr, fromIdx, toIdx) != TCL_OK
|
||||
|| objResultPtr == NULL) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
|
||||
/* Decode index operands. */
|
||||
|
||||
/*
|
||||
assert ( toIdx != TCL_INDEX_NONE );
|
||||
*
|
||||
* Extra safety for legacy bytecodes:
|
||||
*/
|
||||
if (toIdx == TCL_INDEX_NONE) {
|
||||
goto emptyRange;
|
||||
}
|
||||
|
||||
toIdx = TclIndexDecode(toIdx, slength - 1);
|
||||
if (toIdx == TCL_INDEX_NONE) {
|
||||
goto emptyRange;
|
||||
} else if (toIdx >= slength) {
|
||||
toIdx = slength - 1;
|
||||
}
|
||||
|
||||
assert ( toIdx != TCL_INDEX_NONE && toIdx < slength );
|
||||
|
||||
/*
|
||||
assert ( fromIdx != TCL_INDEX_NONE );
|
||||
*
|
||||
* Extra safety for legacy bytecodes:
|
||||
*/
|
||||
if (fromIdx == TCL_INDEX_NONE) {
|
||||
fromIdx = TCL_INDEX_START;
|
||||
}
|
||||
|
||||
fromIdx = TclIndexDecode(fromIdx, slength - 1);
|
||||
if (fromIdx == TCL_INDEX_NONE) {
|
||||
fromIdx = TCL_INDEX_START;
|
||||
}
|
||||
|
||||
if (fromIdx + 1 <= toIdx + 1) {
|
||||
objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
|
||||
if (objResultPtr == NULL) {
|
||||
goto gotError;
|
||||
}
|
||||
} else {
|
||||
emptyRange:
|
||||
TclNewObj(objResultPtr);
|
||||
}
|
||||
}
|
||||
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
|
||||
NEXT_INST_F(9, 1, 1);
|
||||
@@ -5569,7 +5664,7 @@ TEBCresume(
|
||||
int ch;
|
||||
end = ustring1 + slength;
|
||||
for (p=ustring1 ; p<end ; ) {
|
||||
p += TclUniCharToUCS4(p, &ch);
|
||||
ch = *p++;
|
||||
if (!tclStringClassTable[opnd].comparator(ch)) {
|
||||
match = 0;
|
||||
break;
|
||||
@@ -5923,7 +6018,7 @@ TEBCresume(
|
||||
* Quickly force large right shifts to 0 or -1.
|
||||
*/
|
||||
|
||||
if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(w1))) {
|
||||
if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(long))) {
|
||||
/*
|
||||
* We assume that INT_MAX is much larger than the
|
||||
* number of bits in a long. This is a pretty safe
|
||||
@@ -5991,9 +6086,9 @@ TEBCresume(
|
||||
* Handle shifts within the native long range.
|
||||
*/
|
||||
|
||||
if (((size_t)shift < CHAR_BIT*sizeof(w1))
|
||||
if (((size_t)shift < CHAR_BIT*sizeof(long))
|
||||
&& !((w1>0 ? w1 : ~w1) &
|
||||
-(1UL<<(CHAR_BIT*sizeof(w1) - 1 - shift)))) {
|
||||
-(1UL<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
|
||||
wResult = (Tcl_WideUInt)w1 << shift;
|
||||
goto wideResultOfArithmetic;
|
||||
}
|
||||
@@ -6374,7 +6469,7 @@ TEBCresume(
|
||||
if (Tcl_IsShared(valuePtr)) {
|
||||
/*
|
||||
* Here we do some surgery within the Tcl_Obj internals. We want
|
||||
* to copy the internalrep, but not the string, so we temporarily hide
|
||||
* to copy the intrep, but not the string, so we temporarily hide
|
||||
* the string so we do not copy it.
|
||||
*/
|
||||
|
||||
@@ -6399,7 +6494,7 @@ TEBCresume(
|
||||
|
||||
case INST_TRY_CVT_TO_BOOLEAN:
|
||||
valuePtr = OBJ_AT_TOS;
|
||||
if (TclHasInternalRep(valuePtr, &tclBooleanType)) {
|
||||
if (TclHasInternalRep(valuePtr, tclBooleanType)) {
|
||||
objResultPtr = TCONST(1);
|
||||
} else {
|
||||
int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
|
||||
@@ -6460,15 +6555,17 @@ TEBCresume(
|
||||
varListPtr = infoPtr->varLists[i];
|
||||
numVars = varListPtr->numVars;
|
||||
listPtr = OBJ_AT_DEPTH(listTmpDepth);
|
||||
DECACHE_STACK_INFO();
|
||||
if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s",
|
||||
i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
|
||||
goto gotError;
|
||||
}
|
||||
if (Tcl_IsShared(listPtr)) {
|
||||
objPtr = TclListObjCopy(NULL, listPtr);
|
||||
objPtr = TclDuplicatePureObj(
|
||||
interp, listPtr, tclListType);
|
||||
if (!objPtr) {
|
||||
goto gotError;
|
||||
}
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
OBJ_AT_DEPTH(listTmpDepth) = objPtr;
|
||||
@@ -6509,7 +6606,7 @@ TEBCresume(
|
||||
|
||||
pc += 5 - infoPtr->loopCtTemp;
|
||||
|
||||
case INST_FOREACH_STEP: /* TODO: address abstract list indexing here! */
|
||||
case INST_FOREACH_STEP:
|
||||
/*
|
||||
* "Step" a foreach loop (i.e., begin its next iteration) by assigning
|
||||
* the next value list element to each loop var.
|
||||
@@ -6542,47 +6639,20 @@ TEBCresume(
|
||||
for (i = 0; i < numLists; i++) {
|
||||
varListPtr = infoPtr->varLists[i];
|
||||
numVars = varListPtr->numVars;
|
||||
int hasAbstractList;
|
||||
|
||||
listPtr = OBJ_AT_DEPTH(listTmpDepth);
|
||||
hasAbstractList = TclObjTypeHasProc(listPtr, indexProc) != 0;
|
||||
DECACHE_STACK_INFO();
|
||||
if (hasAbstractList) {
|
||||
status = Tcl_ListObjLength(interp, listPtr, &listLen);
|
||||
elements = NULL;
|
||||
} else {
|
||||
status = TclListObjGetElementsM(
|
||||
interp, listPtr, &listLen, &elements);
|
||||
}
|
||||
status = TclListObjGetElementsM(
|
||||
interp, listPtr, &listLen, &elements);
|
||||
if (status != TCL_OK) {
|
||||
CACHE_STACK_INFO();
|
||||
goto gotError;
|
||||
}
|
||||
CACHE_STACK_INFO();
|
||||
|
||||
|
||||
valIndex = (iterNum * numVars);
|
||||
for (j = 0; j < numVars; j++) {
|
||||
if (valIndex >= listLen) {
|
||||
TclNewObj(valuePtr);
|
||||
} else {
|
||||
DECACHE_STACK_INFO();
|
||||
if (elements) {
|
||||
valuePtr = elements[valIndex];
|
||||
} else {
|
||||
status = Tcl_ListObjIndex(
|
||||
interp, listPtr, valIndex, &valuePtr);
|
||||
if (status != TCL_OK) {
|
||||
/* Could happen for abstract lists */
|
||||
CACHE_STACK_INFO();
|
||||
goto gotError;
|
||||
}
|
||||
if (valuePtr == NULL) {
|
||||
/* Permitted for Tcl_LOI to return NULL */
|
||||
TclNewObj(valuePtr);
|
||||
}
|
||||
}
|
||||
CACHE_STACK_INFO();
|
||||
valuePtr = elements[valIndex];
|
||||
}
|
||||
|
||||
varIndex = varListPtr->varIndexes[j];
|
||||
@@ -7105,7 +7175,7 @@ TEBCresume(
|
||||
|
||||
/*
|
||||
* dictPtr is no longer on the stack, and we're not
|
||||
* moving it into the internalrep of an iterator. We need
|
||||
* moving it into the intrep of an iterator. We need
|
||||
* to drop the refcount [Tcl Bug 9b352768e6].
|
||||
*/
|
||||
|
||||
@@ -8453,7 +8523,7 @@ ExecuteExtendedBinaryMathOp(
|
||||
overflowExpon:
|
||||
|
||||
if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
|
||||
|| (value2Ptr->typePtr != &tclIntType)
|
||||
|| (value2Ptr->typePtr != tclIntType)
|
||||
|| (Tcl_WideUInt)w2 >= (1<<28)) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"exponent too large", -1));
|
||||
@@ -9013,7 +9083,7 @@ ValidatePcAndStackTop(
|
||||
}
|
||||
if (checkStack &&
|
||||
(stackTop > stackUpperBound)) {
|
||||
Tcl_Size numChars;
|
||||
size_t numChars;
|
||||
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
|
||||
|
||||
fprintf(stderr, "\nBad stack top %" TCL_Z_MODIFIER "u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %" TCL_Z_MODIFIER "u)",
|
||||
@@ -9163,7 +9233,7 @@ TclGetSrcInfoForPc(
|
||||
ExtCmdLoc *eclPtr;
|
||||
ECL *locPtr = NULL;
|
||||
Tcl_Size srcOffset;
|
||||
Tcl_Size i;
|
||||
int i;
|
||||
Interp *iPtr = (Interp *) *codePtr->interpHandle;
|
||||
Tcl_HashEntry *hePtr =
|
||||
Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
|
||||
@@ -9175,7 +9245,7 @@ TclGetSrcInfoForPc(
|
||||
srcOffset = cfPtr->cmd - codePtr->source;
|
||||
eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);
|
||||
|
||||
for (i=0; i < eclPtr->nuloc; i++) {
|
||||
for (i=0; i < (int)eclPtr->nuloc; i++) {
|
||||
if (eclPtr->loc[i].srcOffset == srcOffset) {
|
||||
locPtr = eclPtr->loc+i;
|
||||
break;
|
||||
@@ -9215,7 +9285,7 @@ GetSrcInfoForPc(
|
||||
const unsigned char **pcBeg,/* If non-NULL, the bytecode location
|
||||
* where the current instruction starts.
|
||||
* If NULL; no pointer is stored. */
|
||||
Tcl_Size *cmdIdxPtr) /* If non-NULL, the location where the index
|
||||
int *cmdIdxPtr) /* If non-NULL, the location where the index
|
||||
* of the command containing the pc should
|
||||
* be stored. */
|
||||
{
|
||||
@@ -9224,10 +9294,10 @@ GetSrcInfoForPc(
|
||||
unsigned char *codeDeltaNext, *codeLengthNext;
|
||||
unsigned char *srcDeltaNext, *srcLengthNext;
|
||||
Tcl_Size codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
|
||||
Tcl_Size bestDist = TCL_SIZE_MAX; /* Distance of pc to best cmd's start pc. */
|
||||
Tcl_Size bestSrcOffset = -1; /* Initialized to avoid compiler warning. */
|
||||
Tcl_Size bestSrcLength = -1; /* Initialized to avoid compiler warning. */
|
||||
Tcl_Size bestCmdIdx = -1;
|
||||
int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */
|
||||
int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */
|
||||
int bestSrcLength = -1; /* Initialized to avoid compiler warning. */
|
||||
int bestCmdIdx = -1;
|
||||
|
||||
/* The pc must point within the bytecode */
|
||||
assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));
|
||||
@@ -9306,7 +9376,7 @@ GetSrcInfoForPc(
|
||||
* instructions. Stop when crossing pc; keep previous.
|
||||
*/
|
||||
|
||||
curr = ((bestDist == TCL_SIZE_MAX) ? codePtr->codeStart : pc - bestDist);
|
||||
curr = ((bestDist == INT_MAX) ? codePtr->codeStart : pc - bestDist);
|
||||
prev = curr;
|
||||
while (curr <= pc) {
|
||||
prev = curr;
|
||||
@@ -9315,7 +9385,7 @@ GetSrcInfoForPc(
|
||||
*pcBeg = prev;
|
||||
}
|
||||
|
||||
if (bestDist == TCL_SIZE_MAX) {
|
||||
if (bestDist == INT_MAX) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
@@ -9553,9 +9623,7 @@ EvalStatsCmd(
|
||||
double numInstructions, currentHeaderBytes;
|
||||
size_t numCurrentByteCodes, numByteCodeLits;
|
||||
size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length;
|
||||
size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade;
|
||||
Tcl_Size i;
|
||||
size_t ui;
|
||||
size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i;
|
||||
char *litTableStats;
|
||||
LiteralEntry *entryPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
@@ -9691,7 +9759,7 @@ EvalStatsCmd(
|
||||
strBytesIfUnshared = 0.0;
|
||||
strBytesSharedMultX = 0.0;
|
||||
strBytesSharedOnce = 0.0;
|
||||
for (ui = 0; ui < globalTablePtr->numBuckets; ui++) {
|
||||
for (i = 0; i < globalTablePtr->numBuckets; i++) {
|
||||
for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
|
||||
entryPtr = entryPtr->nextPtr) {
|
||||
if (TclHasInternalRep(entryPtr->objPtr, &tclByteCodeType)) {
|
||||
@@ -9809,9 +9877,9 @@ EvalStatsCmd(
|
||||
}
|
||||
}
|
||||
sum = 0;
|
||||
for (ui = 0; ui <= maxSizeDecade; ui++) {
|
||||
decadeHigh = (1 << (ui+1)) - 1;
|
||||
sum += statsPtr->literalCount[ui];
|
||||
for (i = 0; i <= maxSizeDecade; i++) {
|
||||
decadeHigh = (1 << (i+1)) - 1;
|
||||
sum += statsPtr->literalCount[i];
|
||||
Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
|
||||
decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
|
||||
}
|
||||
@@ -9842,9 +9910,9 @@ EvalStatsCmd(
|
||||
}
|
||||
maxSizeDecade = i;
|
||||
sum = 0;
|
||||
for (ui = minSizeDecade; ui <= maxSizeDecade; ui++) {
|
||||
decadeHigh = (1 << (ui+1)) - 1;
|
||||
sum += statsPtr->srcCount[ui];
|
||||
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
|
||||
decadeHigh = (1 << (i+1)) - 1;
|
||||
sum += statsPtr->srcCount[i];
|
||||
Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
|
||||
decadeHigh, Percent(sum, statsPtr->numCompilations));
|
||||
}
|
||||
@@ -9866,9 +9934,9 @@ EvalStatsCmd(
|
||||
}
|
||||
maxSizeDecade = i;
|
||||
sum = 0;
|
||||
for (ui = minSizeDecade; ui <= maxSizeDecade; i++) {
|
||||
decadeHigh = (1 << (ui+1)) - 1;
|
||||
sum += statsPtr->byteCodeCount[ui];
|
||||
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
|
||||
decadeHigh = (1 << (i+1)) - 1;
|
||||
sum += statsPtr->byteCodeCount[i];
|
||||
Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
|
||||
decadeHigh, Percent(sum, statsPtr->numCompilations));
|
||||
}
|
||||
@@ -9890,9 +9958,9 @@ EvalStatsCmd(
|
||||
}
|
||||
maxSizeDecade = i;
|
||||
sum = 0;
|
||||
for (ui = minSizeDecade; ui <= maxSizeDecade; ui++) {
|
||||
decadeHigh = (1 << (ui+1)) - 1;
|
||||
sum += statsPtr->lifetimeCount[ui];
|
||||
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
|
||||
decadeHigh = (1 << (i+1)) - 1;
|
||||
sum += statsPtr->lifetimeCount[i];
|
||||
Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
|
||||
decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
|
||||
}
|
||||
|
||||
@@ -2339,8 +2339,8 @@ Tcl_AllocStatBuf(void)
|
||||
* Access functions for Tcl_StatBuf --
|
||||
*
|
||||
* These functions provide portable read-only access to the portable
|
||||
* fields of the Tcl_StatBuf structure (really a 'struct stat'
|
||||
* or something else related). [TIP #316]
|
||||
* fields of the Tcl_StatBuf structure (really a 'struct stat', 'struct
|
||||
* stat64' or something else related). [TIP #316]
|
||||
*
|
||||
* Results:
|
||||
* The value from the field being retrieved.
|
||||
|
||||
+9
-2
@@ -1664,6 +1664,10 @@ Tcl_CreateChannel(
|
||||
}
|
||||
statePtr->channelName = tmp;
|
||||
statePtr->flags = mask;
|
||||
/* uncomment this to make default encoding error handling strict */
|
||||
/*
|
||||
statePtr->flags |= CHANNEL_ENCODING_STRICT;
|
||||
*/
|
||||
statePtr->maxPerms = mask; /* Save max privileges for close callback */
|
||||
|
||||
/*
|
||||
@@ -5931,6 +5935,7 @@ DoReadChars(
|
||||
ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
|
||||
/* TODO: UpdateInterest not needed here? */
|
||||
UpdateInterest(chanPtr);
|
||||
|
||||
Tcl_SetErrno(EILSEQ);
|
||||
return -1;
|
||||
}
|
||||
@@ -6031,6 +6036,7 @@ DoReadChars(
|
||||
if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
|
||||
&& !GotFlag(statePtr, CHANNEL_STICKY_EOF)
|
||||
&& (!GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
|
||||
copied = -1;
|
||||
goto finish;
|
||||
}
|
||||
}
|
||||
@@ -6110,6 +6116,9 @@ finish:
|
||||
copied = -1;
|
||||
}
|
||||
TclChannelRelease((Tcl_Channel)chanPtr);
|
||||
if (copied == TCL_INDEX_NONE) {
|
||||
ResetFlag(statePtr, CHANNEL_ENCODING_ERROR|CHANNEL_EOF);
|
||||
}
|
||||
return copied;
|
||||
}
|
||||
|
||||
@@ -8205,9 +8214,7 @@ Tcl_SetChannelOption(
|
||||
return TCL_OK;
|
||||
} else if (HaveOpt(2, "-eofchar")) {
|
||||
if (!newValue[0] || (!(newValue[0] & 0x80) && (!newValue[1]
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
|| !strcmp(newValue+1, " {}")
|
||||
#endif
|
||||
))) {
|
||||
if (GotFlag(statePtr, TCL_READABLE)) {
|
||||
statePtr->inEofChar = newValue[0];
|
||||
|
||||
@@ -158,10 +158,6 @@ typedef struct ChannelState {
|
||||
* of line sequences in output? */
|
||||
int inEofChar; /* If nonzero, use this as a signal of EOF on
|
||||
* input. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int outEofChar; /* If nonzero, append this to the channel when
|
||||
* it is closed if it is open for writing. For Tcl 8.x only */
|
||||
#endif
|
||||
int unreportedError; /* Non-zero if an error report was deferred
|
||||
* because it happened in the background. The
|
||||
* value is the POSIX error code. */
|
||||
|
||||
+16
-4
@@ -283,7 +283,7 @@ Tcl_GetsObjCmd(
|
||||
Tcl_Channel chan; /* The channel to read from. */
|
||||
Tcl_Size lineLen; /* Length of line just read. */
|
||||
int mode; /* Mode in which channel is opened. */
|
||||
Tcl_Obj *linePtr, *chanObjPtr;
|
||||
Tcl_Obj *linePtr, *chanObjPtr, *resultDictPtr, *returnOptsPtr;
|
||||
int code = TCL_OK;
|
||||
|
||||
if ((objc != 2) && (objc != 3)) {
|
||||
@@ -306,7 +306,6 @@ Tcl_GetsObjCmd(
|
||||
lineLen = Tcl_GetsObj(chan, linePtr);
|
||||
if (lineLen == TCL_IO_FAILURE) {
|
||||
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
|
||||
Tcl_DecrRefCount(linePtr);
|
||||
|
||||
/*
|
||||
* TIP #219.
|
||||
@@ -320,7 +319,14 @@ Tcl_GetsObjCmd(
|
||||
"error reading \"%s\": %s",
|
||||
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
|
||||
}
|
||||
resultDictPtr = Tcl_NewDictObj();
|
||||
Tcl_DictObjPut(NULL, resultDictPtr, Tcl_NewStringObj("read", -1)
|
||||
, linePtr);
|
||||
returnOptsPtr = Tcl_NewDictObj();
|
||||
Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-result", -1)
|
||||
, resultDictPtr);
|
||||
code = TCL_ERROR;
|
||||
Tcl_SetReturnOptions(interp, returnOptsPtr);
|
||||
goto done;
|
||||
}
|
||||
lineLen = TCL_IO_FAILURE;
|
||||
@@ -371,7 +377,7 @@ Tcl_ReadObjCmd(
|
||||
Tcl_WideInt toRead; /* How many bytes to read? */
|
||||
Tcl_Size charactersRead; /* How many characters were read? */
|
||||
int mode; /* Mode in which channel is opened. */
|
||||
Tcl_Obj *resultPtr, *chanObjPtr;
|
||||
Tcl_Obj *resultPtr, *resultDictPtr, *returnOptsPtr, *chanObjPtr;
|
||||
|
||||
if ((objc != 2) && (objc != 3)) {
|
||||
Interp *iPtr;
|
||||
@@ -433,7 +439,6 @@ Tcl_ReadObjCmd(
|
||||
TclChannelPreserve(chan);
|
||||
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
|
||||
if (charactersRead == TCL_IO_FAILURE) {
|
||||
Tcl_DecrRefCount(resultPtr);
|
||||
/*
|
||||
* TIP #219.
|
||||
* Capture error messages put by the driver into the bypass area and
|
||||
@@ -446,7 +451,14 @@ Tcl_ReadObjCmd(
|
||||
"error reading \"%s\": %s",
|
||||
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
|
||||
}
|
||||
resultDictPtr = Tcl_NewDictObj();
|
||||
Tcl_DictObjPut(NULL, resultDictPtr, Tcl_NewStringObj("read", -1)
|
||||
, resultPtr);
|
||||
returnOptsPtr = Tcl_NewDictObj();
|
||||
Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-result", -1)
|
||||
, resultDictPtr);
|
||||
TclChannelRelease(chan);
|
||||
Tcl_SetReturnOptions(interp, returnOptsPtr);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
+5
-1
@@ -379,7 +379,11 @@ ExecuteCallback(
|
||||
unsigned char *resBuf;
|
||||
Tcl_InterpState state = NULL;
|
||||
int res = TCL_OK;
|
||||
Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
|
||||
Tcl_Obj *command = TclDuplicatePureObj(
|
||||
interp, dataPtr->command, tclListType);
|
||||
if (!command) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_Interp *eval = dataPtr->interp;
|
||||
|
||||
Tcl_Preserve(eval);
|
||||
|
||||
@@ -2261,7 +2261,10 @@ NewReflectedChannel(
|
||||
rcPtr->mode = mode;
|
||||
rcPtr->interest = 0; /* Initially no interest registered */
|
||||
|
||||
rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
|
||||
rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, tclListType);
|
||||
if (!rcPtr->cmd) {
|
||||
return NULL;
|
||||
}
|
||||
Tcl_IncrRefCount(rcPtr->cmd);
|
||||
rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
|
||||
while (mn <= (int)METH_WRITE) {
|
||||
@@ -2398,7 +2401,10 @@ InvokeTclMethod(
|
||||
* before the channel id.
|
||||
*/
|
||||
|
||||
cmd = TclListObjCopy(NULL, rcPtr->cmd);
|
||||
cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, tclListType);
|
||||
if (!cmd) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
|
||||
Tcl_ListObjAppendElement(NULL, cmd, methObj);
|
||||
Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
|
||||
|
||||
+10
-5
@@ -1687,7 +1687,7 @@ Tcl_FSEvalFileEx(
|
||||
use the utf-8 encoding. */
|
||||
{
|
||||
Tcl_Size length;
|
||||
int result = TCL_ERROR;
|
||||
int result = TCL_ERROR;
|
||||
Tcl_StatBuf statBuf;
|
||||
Tcl_Obj *oldScriptFile;
|
||||
Interp *iPtr;
|
||||
@@ -1734,6 +1734,11 @@ Tcl_FSEvalFileEx(
|
||||
Tcl_CloseEx(interp,chan,0);
|
||||
return result;
|
||||
}
|
||||
if (Tcl_SetChannelOption(interp, chan, "-profile", "strict")
|
||||
!= TCL_OK) {
|
||||
Tcl_CloseEx(interp,chan,0);
|
||||
return result;
|
||||
}
|
||||
|
||||
TclNewObj(objPtr);
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
@@ -1802,7 +1807,7 @@ Tcl_FSEvalFileEx(
|
||||
|
||||
const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
|
||||
unsigned limit = 150;
|
||||
int overflow = ((unsigned)length > limit);
|
||||
int overflow = (length > limit);
|
||||
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (file \"%.*s%s\" line %d)",
|
||||
@@ -1954,12 +1959,12 @@ EvalFileCallback(
|
||||
|
||||
Tcl_Size length;
|
||||
const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
|
||||
const unsigned limit = 150;
|
||||
int overflow = ((unsigned)length > limit);
|
||||
const unsigned int limit = 150;
|
||||
int overflow = (length > limit);
|
||||
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (file \"%.*s%s\" line %d)",
|
||||
(overflow ? limit : (unsigned)length), pathString,
|
||||
(overflow ? limit : (unsigned int)length), pathString,
|
||||
(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
|
||||
}
|
||||
|
||||
|
||||
+11
-11
@@ -37,7 +37,7 @@ static void PrintUsage(Tcl_Interp *interp,
|
||||
* that can be invoked by generic object code.
|
||||
*/
|
||||
|
||||
const Tcl_ObjType tclIndexType = {
|
||||
static const Tcl_ObjType indexType = {
|
||||
"index", /* name */
|
||||
FreeIndex, /* freeIntRepProc */
|
||||
DupIndex, /* dupIntRepProc */
|
||||
@@ -213,7 +213,7 @@ Tcl_GetIndexFromObjStruct(
|
||||
*/
|
||||
|
||||
if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) {
|
||||
irPtr = TclFetchInternalRep(objPtr, &tclIndexType);
|
||||
irPtr = TclFetchInternalRep(objPtr, &indexType);
|
||||
if (irPtr) {
|
||||
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
|
||||
if ((indexRep->tablePtr == tablePtr)
|
||||
@@ -282,7 +282,7 @@ Tcl_GetIndexFromObjStruct(
|
||||
*/
|
||||
|
||||
if (objPtr && (index != TCL_INDEX_NONE) && !(flags & TCL_INDEX_TEMP_TABLE)) {
|
||||
irPtr = TclFetchInternalRep(objPtr, &tclIndexType);
|
||||
irPtr = TclFetchInternalRep(objPtr, &indexType);
|
||||
if (irPtr) {
|
||||
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
|
||||
} else {
|
||||
@@ -290,7 +290,7 @@ Tcl_GetIndexFromObjStruct(
|
||||
|
||||
indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep));
|
||||
ir.twoPtrValue.ptr1 = indexRep;
|
||||
Tcl_StoreInternalRep(objPtr, &tclIndexType, &ir);
|
||||
Tcl_StoreInternalRep(objPtr, &indexType, &ir);
|
||||
}
|
||||
indexRep->tablePtr = (void *) tablePtr;
|
||||
indexRep->offset = offset;
|
||||
@@ -385,7 +385,7 @@ static void
|
||||
UpdateStringOfIndex(
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1;
|
||||
IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1;
|
||||
const char *indexStr = EXPAND_OF(indexRep);
|
||||
|
||||
Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
|
||||
@@ -417,11 +417,11 @@ DupIndex(
|
||||
Tcl_ObjInternalRep ir;
|
||||
IndexRep *dupIndexRep = (IndexRep *)Tcl_Alloc(sizeof(IndexRep));
|
||||
|
||||
memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &tclIndexType)->twoPtrValue.ptr1,
|
||||
memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &indexType)->twoPtrValue.ptr1,
|
||||
sizeof(IndexRep));
|
||||
|
||||
ir.twoPtrValue.ptr1 = dupIndexRep;
|
||||
Tcl_StoreInternalRep(dupPtr, &tclIndexType, &ir);
|
||||
Tcl_StoreInternalRep(dupPtr, &indexType, &ir);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -445,7 +445,7 @@ static void
|
||||
FreeIndex(
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
Tcl_Free(TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1);
|
||||
Tcl_Free(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1);
|
||||
objPtr->typePtr = NULL;
|
||||
}
|
||||
|
||||
@@ -865,7 +865,7 @@ Tcl_WrongNumArgs(
|
||||
*/
|
||||
const Tcl_ObjInternalRep *irPtr;
|
||||
|
||||
if ((irPtr = TclFetchInternalRep(origObjv[i], &tclIndexType))) {
|
||||
if ((irPtr = TclFetchInternalRep(origObjv[i], &indexType))) {
|
||||
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
|
||||
|
||||
elementStr = EXPAND_OF(indexRep);
|
||||
@@ -912,7 +912,7 @@ Tcl_WrongNumArgs(
|
||||
*/
|
||||
const Tcl_ObjInternalRep *irPtr;
|
||||
|
||||
if ((irPtr = TclFetchInternalRep(objv[i], &tclIndexType))) {
|
||||
if ((irPtr = TclFetchInternalRep(objv[i], &indexType))) {
|
||||
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
|
||||
|
||||
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
|
||||
@@ -1361,7 +1361,7 @@ TclGetCompletionCodeFromObj(
|
||||
"ok", "error", "return", "break", "continue", NULL
|
||||
};
|
||||
|
||||
if (!TclHasInternalRep(value, &tclIndexType)
|
||||
if (!TclHasInternalRep(value, &indexType)
|
||||
&& TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
+292
-221
@@ -11,6 +11,7 @@
|
||||
* Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
|
||||
* Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved.
|
||||
* Copyright (c) 2008 by Miguel Sofer. All rights reserved.
|
||||
* Copyright (c) 2021 by Nathan Coulter. All rights reserved.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -46,10 +47,13 @@
|
||||
|
||||
#if defined(__cplusplus)
|
||||
# define TCL_UNUSED(T) T
|
||||
# define TCL_UNUSEDVAR(T) T
|
||||
#elif defined(__GNUC__) && (__GNUC__ > 2)
|
||||
# define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused))
|
||||
# define TCL_UNUSEDVAR(T) T __attribute__((unused))
|
||||
#else
|
||||
# define TCL_UNUSED(T) T JOIN(dummy, __LINE__)
|
||||
# define TCL_UNUSEDVAR(T) T
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -66,8 +70,11 @@
|
||||
|
||||
#include <ctype.h>
|
||||
#include <stdarg.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#ifdef NO_STDLIB_H
|
||||
# include "../compat/stdlib.h"
|
||||
#else
|
||||
# include <stdlib.h>
|
||||
#endif
|
||||
#ifdef NO_STRING_H
|
||||
#include "../compat/string.h"
|
||||
#else
|
||||
@@ -203,6 +210,223 @@ typedef struct Tcl_ResolverInfo {
|
||||
|
||||
#define TCL_AVOID_RESOLVERS 0x40000
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* Object type
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
/* version is a pointer so that it can be overridden if ever needed */
|
||||
typedef struct TclObjectTypeType {
|
||||
int *version;
|
||||
} TclObjectTypeType;
|
||||
|
||||
|
||||
/* keep this structure in sync with Tcl_ObjType */
|
||||
typedef struct ObjectType {
|
||||
const char *name; /* Name of the type, e.g. "int". */
|
||||
Tcl_FreeInternalRepProc *freeIntRepProc;
|
||||
/* Called to free any storage for the type's
|
||||
* internal rep. NULL if the internal rep does
|
||||
* not need freeing. */
|
||||
Tcl_DupInternalRepProc *dupIntRepProc;
|
||||
/* Called to create a new object as a copy of
|
||||
* an existing object. */
|
||||
Tcl_UpdateStringProc *updateStringProc;
|
||||
/* Called to update the string rep from the
|
||||
* type's internal representation. */
|
||||
Tcl_SetFromAnyProc *setFromAnyProc;
|
||||
/* Called to convert the object's internal rep
|
||||
* to this type. Frees the internal rep of the
|
||||
* old type. Returns TCL_ERROR on failure. */
|
||||
int version;
|
||||
Tcl_ObjInterface *interface;
|
||||
} ObjectType;
|
||||
|
||||
#define TclObjectInterfaceCall(objPtr, iface, proc, ...) \
|
||||
((ObjInterface *)((ObjectType *)(objPtr)->typePtr)->interface) \
|
||||
->iface.proc(__VA_ARGS__)
|
||||
|
||||
#define TclObjectDispatch(objPtr, default, iface, proc, ...) \
|
||||
TclObjectHasInterface((objPtr), iface, proc) \
|
||||
? TclObjectInterfaceCall(objPtr, iface, proc, __VA_ARGS__) \
|
||||
: default(__VA_ARGS__)
|
||||
|
||||
|
||||
#define TclObjectDispatchNoDefault(interp, res, objPtr, iface, proc, ...) \
|
||||
(TclObjectHasInterface((objPtr), iface, proc) \
|
||||
? (res = TclObjectInterfaceCall((objPtr), iface, proc, __VA_ARGS__), \
|
||||
TCL_OK) \
|
||||
: (Tcl_SetObjResult((interp), \
|
||||
Tcl_ObjPrintf("interface not provided interface %s proc %s" \
|
||||
, #iface, #proc )), TCL_ERROR))
|
||||
|
||||
|
||||
#define TclObjectHasInterface(objPtr, iface, proc) \
|
||||
((objPtr)->typePtr != NULL \
|
||||
&& (objPtr)->typePtr->version == 2 \
|
||||
&& ((ObjInterface *)((ObjectType *)(objPtr)->typePtr)->interface) \
|
||||
->iface.proc != NULL)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* Object interface data structures and macros
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#define tclObjTypeInterfaceArgsListAll \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object for which an element array \
|
||||
* is to be returned. */ \
|
||||
Tcl_Size *objcPtr, /* Where to store the count of objects \
|
||||
* referenced by objv. */ \
|
||||
Tcl_Obj ***objvPtr /* Where to store the pointer to an \
|
||||
* array of */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListAppend \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object to append objPtr to. */ \
|
||||
Tcl_Obj *objPtr /* Object to append to listPtr's list. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListAppendList \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object to append elements to. */ \
|
||||
Tcl_Obj *elemListPtr /* List obj with elements to append. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListIndex \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object to index into. */ \
|
||||
Tcl_Size index, /* Index of element to return. */ \
|
||||
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListIndexEnd \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object to index into. */ \
|
||||
Tcl_Size index, /* Index of element to return. */ \
|
||||
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListIsSorted \
|
||||
Tcl_Interp * interp, /* Used to report errors */ \
|
||||
Tcl_Obj *listPtr, /* The list in question */ \
|
||||
size_t flags /* flags */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListLength \
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object whose #elements to return. */ \
|
||||
Tcl_Size *lenPtr /* The resulting length is stored here. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListRange \
|
||||
Tcl_Interp * interp, /* Used to report errors */ \
|
||||
Tcl_Obj *listObj, /* List object to take a range from. */ \
|
||||
Tcl_Size rangeStart, /* Index of first element to */ \
|
||||
/* include. */ \
|
||||
Tcl_Size rangeEnd /* Index of last element to include. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListRangeEnd \
|
||||
Tcl_Interp * interp, /* Used to report errors */ \
|
||||
Tcl_Obj *listPtr, /* List object to take a range from. */ \
|
||||
Tcl_Size fromAnchor,/* 0 for start and 1 for end */ \
|
||||
Tcl_Size fromIdx, /* Index of first element to include. */ \
|
||||
Tcl_Size toAnchor, /* 0 for start and 1 for end */ \
|
||||
Tcl_Size toIdx /* Index of last element to include. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListReplace \
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
|
||||
Tcl_Obj *listObj, /* List object whose elements to replace. */ \
|
||||
Tcl_Size first, /* Index of first element to replace. */ \
|
||||
Tcl_Size numToDelete, /* Number of elements to replace. */ \
|
||||
Tcl_Size numToInsert, /* Number of objects to insert. */ \
|
||||
/* An array of objc pointers to Tcl \
|
||||
* objects to insert. */ \
|
||||
Tcl_Obj *const insertObjs[]
|
||||
|
||||
#define tclObjTypeInterfaceArgsListReplaceList \
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object whose elements to replace. */ \
|
||||
Tcl_Size first, /* Index of first element to replace. */ \
|
||||
Tcl_Size count, /* Number of elements to replace. */ \
|
||||
Tcl_Obj *newItemsPtr /* a list of new items to insert */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListReverse \
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
|
||||
Tcl_Obj *listPtr /* List object whose elements to replace. */ \
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsListSet \
|
||||
Tcl_Interp *interp, /* Tcl interpreter; used for error reporting \
|
||||
* if not NULL. */ \
|
||||
Tcl_Obj *listObj, /* List object in which element should be \
|
||||
* stored. */ \
|
||||
Tcl_Size index, /* Index of element to store. */ \
|
||||
Tcl_Obj *valueObj /* Tcl object to store in the designated list \
|
||||
* element. */
|
||||
|
||||
#define tclObjTypeInterfaceArgsListSetList \
|
||||
Tcl_Interp *interp, /* Tcl interpreter. */ \
|
||||
Tcl_Obj *listObj, /* Pointer to the list being modified. */ \
|
||||
Tcl_Size indexCount, /* Number of index args. */ \
|
||||
Tcl_Obj *const indexArray[], /* Index args. */ \
|
||||
Tcl_Obj *valueObj /* Value arg to 'lset' or NULL to 'lpop'. */
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsStringIndex \
|
||||
Tcl_Interp *interp, \
|
||||
Tcl_Obj *objPtr, \
|
||||
Tcl_Size index, \
|
||||
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsStringIndexEnd \
|
||||
Tcl_Interp *interp, \
|
||||
Tcl_Obj *objPtr, \
|
||||
Tcl_Size index, \
|
||||
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsStringLength \
|
||||
Tcl_Obj *objPtr
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsStringRange \
|
||||
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ \
|
||||
Tcl_Size first, /* First index of the range. */ \
|
||||
Tcl_Size last /* Last index of the range. */
|
||||
|
||||
|
||||
#define tclObjTypeInterfaceArgsStringRangeEnd \
|
||||
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ \
|
||||
Tcl_Size first, /* First index of the range. */ \
|
||||
Tcl_Size last /* Last index of the range. */
|
||||
|
||||
|
||||
typedef struct ObjInterface {
|
||||
int version;
|
||||
struct string {
|
||||
int (*index)(tclObjTypeInterfaceArgsStringIndex);
|
||||
int (*indexEnd)(tclObjTypeInterfaceArgsStringIndexEnd);
|
||||
Tcl_Size (*length)(tclObjTypeInterfaceArgsStringLength);
|
||||
Tcl_Obj* (*range)(tclObjTypeInterfaceArgsStringRange);
|
||||
Tcl_Obj* (*rangeEnd)(tclObjTypeInterfaceArgsStringRangeEnd);
|
||||
} string;
|
||||
struct list {
|
||||
int (*all)(tclObjTypeInterfaceArgsListAll);
|
||||
int (*append)(tclObjTypeInterfaceArgsListAppend);
|
||||
int (*appendlist)(tclObjTypeInterfaceArgsListAppendList);
|
||||
int (*index)(tclObjTypeInterfaceArgsListIndex);
|
||||
int (*indexEnd)(tclObjTypeInterfaceArgsListIndexEnd);
|
||||
int (*isSorted)(tclObjTypeInterfaceArgsListIsSorted);
|
||||
int (*length)(tclObjTypeInterfaceArgsListLength);
|
||||
Tcl_Obj* (*range)(tclObjTypeInterfaceArgsListRange);
|
||||
Tcl_Obj* (*rangeEnd)(tclObjTypeInterfaceArgsListRangeEnd);
|
||||
int (*replace)(tclObjTypeInterfaceArgsListReplace);
|
||||
int (*replaceList)(tclObjTypeInterfaceArgsListReplaceList);
|
||||
Tcl_Obj* (*reverse)(tclObjTypeInterfaceArgsListReverse);
|
||||
int (*set)(tclObjTypeInterfaceArgsListSet);
|
||||
Tcl_Obj * (*setlist)(tclObjTypeInterfaceArgsListSetList);
|
||||
} list;
|
||||
} ObjInterface;
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* Data structures related to namespaces.
|
||||
@@ -222,9 +446,7 @@ typedef struct NamespacePathEntry NamespacePathEntry;
|
||||
typedef struct TclVarHashTable {
|
||||
Tcl_HashTable table;
|
||||
struct Namespace *nsPtr;
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
struct Var *arrayPtr;
|
||||
#endif /* TCL_MAJOR_VERSION > 8 */
|
||||
} TclVarHashTable;
|
||||
|
||||
/*
|
||||
@@ -274,11 +496,7 @@ typedef struct Namespace {
|
||||
* strings; values have type (Namespace *). If
|
||||
* NULL, there are no children. */
|
||||
#endif
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
size_t nsId; /* Unique id for the namespace. */
|
||||
#else
|
||||
unsigned long nsId;
|
||||
#endif
|
||||
Tcl_Interp *interp; /* The interpreter containing this
|
||||
* namespace. */
|
||||
int flags; /* OR-ed combination of the namespace status
|
||||
@@ -959,9 +1177,6 @@ typedef struct CompiledLocal {
|
||||
* Among others used to speed up var lookups. */
|
||||
Tcl_Size frameIndex; /* Index in the array of compiler-assigned
|
||||
* variables in the procedure call frame. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int flags;
|
||||
#endif
|
||||
Tcl_Obj *defValuePtr; /* Pointer to the default value of an
|
||||
* argument, if any. NULL if not an argument
|
||||
* or, if an argument, no default value. */
|
||||
@@ -972,12 +1187,10 @@ typedef struct CompiledLocal {
|
||||
* is marked by a unique tag during
|
||||
* compilation, and that same tag is used to
|
||||
* find the variable at runtime. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
int flags; /* Flag bits for the local variable. Same as
|
||||
* the flags for the Var structure above,
|
||||
* although only VAR_ARGUMENT, VAR_TEMPORARY,
|
||||
* and VAR_RESOLVED make sense. */
|
||||
#endif
|
||||
char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If
|
||||
* the name is NULL, this will just be '\0'.
|
||||
* The actual size of this field will be large
|
||||
@@ -1035,11 +1248,7 @@ typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
|
||||
typedef struct Trace {
|
||||
Tcl_Size level; /* Only trace commands at nesting level less
|
||||
* than or equal to this. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
Tcl_CmdObjTraceProc2 *proc; /* Procedure to call to trace command. */
|
||||
#else
|
||||
Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */
|
||||
#endif
|
||||
void *clientData; /* Arbitrary value to pass to proc. */
|
||||
struct Trace *nextPtr; /* Next in list of traces for this interp. */
|
||||
int flags; /* Flags governing the trace - see
|
||||
@@ -1083,102 +1292,6 @@ typedef struct ActiveInterpTrace {
|
||||
#define TCL_TRACE_ENTER_EXEC 1
|
||||
#define TCL_TRACE_LEAVE_EXEC 2
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
#define TclObjTypeHasProc(objPtr, proc) (((objPtr)->typePtr \
|
||||
&& ((offsetof(Tcl_ObjType, proc) < offsetof(Tcl_ObjType, version)) \
|
||||
|| (offsetof(Tcl_ObjType, proc) < (objPtr)->typePtr->version))) ? \
|
||||
((objPtr)->typePtr)->proc : NULL)
|
||||
|
||||
MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *);
|
||||
|
||||
|
||||
/*
|
||||
* Abstract List
|
||||
*
|
||||
* This structure provides the functions used in List operations to emulate a
|
||||
* List for AbstractList types.
|
||||
*/
|
||||
|
||||
|
||||
static inline Tcl_Size
|
||||
TclObjTypeLength(Tcl_Obj *objPtr)
|
||||
{
|
||||
Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc);
|
||||
return proc(objPtr);
|
||||
}
|
||||
static inline int
|
||||
TclObjTypeIndex(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr,
|
||||
Tcl_Size index,
|
||||
Tcl_Obj **elemObjPtr)
|
||||
{
|
||||
Tcl_ObjTypeIndexProc *proc = TclObjTypeHasProc(objPtr, indexProc);
|
||||
return proc(interp, objPtr, index, elemObjPtr);
|
||||
}
|
||||
static inline int
|
||||
TclObjTypeSlice(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr,
|
||||
Tcl_Size fromIdx,
|
||||
Tcl_Size toIdx,
|
||||
Tcl_Obj **newObjPtr)
|
||||
{
|
||||
Tcl_ObjTypeSliceProc *proc = TclObjTypeHasProc(objPtr, sliceProc);
|
||||
return proc(interp, objPtr, fromIdx, toIdx, newObjPtr);
|
||||
}
|
||||
static inline int
|
||||
TclObjTypeReverse(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr,
|
||||
Tcl_Obj **newObjPtr)
|
||||
{
|
||||
Tcl_ObjTypeReverseProc *proc = TclObjTypeHasProc(objPtr, reverseProc);
|
||||
return proc(interp, objPtr, newObjPtr);
|
||||
}
|
||||
static inline int
|
||||
TclObjTypeGetElements(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr,
|
||||
Tcl_Size *objCPtr,
|
||||
Tcl_Obj ***objVPtr)
|
||||
{
|
||||
Tcl_ObjTypeGetElements *proc = TclObjTypeHasProc(objPtr, getElementsProc);
|
||||
return proc(interp, objPtr, objCPtr, objVPtr);
|
||||
}
|
||||
static inline Tcl_Obj*
|
||||
TclObjTypeSetElement(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr,
|
||||
Tcl_Size indexCount,
|
||||
Tcl_Obj *const indexArray[],
|
||||
Tcl_Obj *valueObj)
|
||||
{
|
||||
Tcl_ObjTypeSetElement *proc = TclObjTypeHasProc(objPtr, setElementProc);
|
||||
return proc(interp, objPtr, indexCount, indexArray, valueObj);
|
||||
}
|
||||
static inline int
|
||||
TclObjTypeReplace(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr,
|
||||
Tcl_Size first,
|
||||
Tcl_Size numToDelete,
|
||||
Tcl_Size numToInsert,
|
||||
Tcl_Obj *const insertObjs[])
|
||||
{
|
||||
Tcl_ObjTypeReplaceProc *proc = TclObjTypeHasProc(objPtr, replaceProc);
|
||||
return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs);
|
||||
}
|
||||
static inline int
|
||||
TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj,
|
||||
struct Tcl_Obj *listObj, int *boolResult)
|
||||
{
|
||||
Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc);
|
||||
return proc(interp, valueObj, listObj, boolResult);
|
||||
}
|
||||
#endif /* TCL_MAJOR_VERSION > 8 */
|
||||
|
||||
|
||||
/*
|
||||
* The structure below defines an entry in the assocData hash table which is
|
||||
* associated with an interpreter. The entry contains a pointer to a function
|
||||
@@ -1321,7 +1434,7 @@ typedef struct CmdFrame {
|
||||
int type; /* Values see below. */
|
||||
int level; /* Number of frames in stack, prevent O(n)
|
||||
* scan of list. */
|
||||
Tcl_Size *line; /* Lines the words of the command start on. */
|
||||
int *line; /* Lines the words of the command start on. */
|
||||
Tcl_Size nline;
|
||||
CallFrame *framePtr; /* Procedure activation record, may be
|
||||
* NULL. */
|
||||
@@ -1416,7 +1529,7 @@ typedef struct CFWordBC {
|
||||
typedef struct ContLineLoc {
|
||||
Tcl_Size num; /* Number of entries in loc, not counting the
|
||||
* final -1 marker entry. */
|
||||
Tcl_Size loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
|
||||
int loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
|
||||
* The table is allocated as part of the
|
||||
* structure, extending behind the nominal end
|
||||
* of the structure. An entry containing the
|
||||
@@ -1960,18 +2073,7 @@ typedef struct Interp {
|
||||
void *interpInfo; /* Information used by tclInterp.c to keep
|
||||
* track of parent/child interps on a
|
||||
* per-interp basis. */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
void (*optimizer)(void *envPtr);
|
||||
#else
|
||||
union {
|
||||
void (*optimizer)(void *envPtr);
|
||||
Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The
|
||||
* unused space in interp was repurposed for
|
||||
* pluggable bytecode optimizers. The core
|
||||
* contains one optimizer, which can be
|
||||
* selectively overridden by extensions. */
|
||||
} extra;
|
||||
#endif
|
||||
/*
|
||||
* Information related to procedures and variables. See tclProc.c and
|
||||
* tclVar.c for usage.
|
||||
@@ -2000,12 +2102,6 @@ typedef struct Interp {
|
||||
Namespace *lookupNsPtr; /* Namespace to use ONLY on the next
|
||||
* TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
|
||||
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
char *appendResultDontUse;
|
||||
int appendAvlDontUse;
|
||||
int appendUsedDontUse;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Information about packages. Used only in tclPkg.c.
|
||||
*/
|
||||
@@ -2028,9 +2124,6 @@ typedef struct Interp {
|
||||
* Normally zero, but may be set before
|
||||
* calling Tcl_Eval. See below for valid
|
||||
* values. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
int unused1; /* No longer used (was termOffset) */
|
||||
#endif
|
||||
LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl
|
||||
* objects holding literals of scripts
|
||||
* compiled by the interpreter. Indexed by the
|
||||
@@ -2068,9 +2161,6 @@ typedef struct Interp {
|
||||
* string. Returned by Tcl_ObjSetVar2 when
|
||||
* variable traces change a variable in a
|
||||
* gross way. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
|
||||
#endif
|
||||
Tcl_Obj *objResultPtr; /* If the last command returned an object
|
||||
* result, this points to it. Should not be
|
||||
* accessed directly; see comment above. */
|
||||
@@ -2524,6 +2614,7 @@ typedef enum TclEolTranslation {
|
||||
#define TCL_INVOKE_NO_UNKNOWN (1<<1)
|
||||
#define TCL_INVOKE_NO_TRACEBACK (1<<2)
|
||||
|
||||
|
||||
/*
|
||||
* ListStore --
|
||||
*
|
||||
@@ -2673,8 +2764,8 @@ typedef struct ListRep {
|
||||
* (1) No string representation exists which means it will obviously have
|
||||
* to be generated from the list representation when needed
|
||||
* (2) The ListStore flags is marked canonical. This is done at the time
|
||||
* the string representation is generated from the list under certain
|
||||
* conditions (see comments in UpdateStringOfList).
|
||||
* the string representation is generated from the list IF the list
|
||||
* representation does not have a span (see comments in UpdateStringOfList).
|
||||
* (3) The list representation does not have a span component. This is
|
||||
* because list Tcl_Obj's with spans are always created from existing lists
|
||||
* and never from strings (see SetListFromAny) and thus their string
|
||||
@@ -2692,10 +2783,10 @@ typedef struct ListRep {
|
||||
* converted to a list.
|
||||
*/
|
||||
#define TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_) \
|
||||
(((listObj_)->typePtr == &tclListType) \
|
||||
? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
|
||||
TCL_OK) \
|
||||
: Tcl_ListObjGetElements( \
|
||||
(((listObj_)->typePtr == tclListType) \
|
||||
? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
|
||||
TCL_OK) \
|
||||
: Tcl_ListObjGetElements( \
|
||||
(interp_), (listObj_), (objcPtr_), (objvPtr_)))
|
||||
|
||||
/*
|
||||
@@ -2703,13 +2794,14 @@ typedef struct ListRep {
|
||||
* count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the
|
||||
* Tcl_Obj cannot be converted to a list.
|
||||
*/
|
||||
#define TclListObjLengthM(interp_, listObj_, lenPtr_) \
|
||||
(((listObj_)->typePtr == &tclListType) \
|
||||
? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
|
||||
#define TclListObjLengthM(interp_, listObj_, lenPtr_) \
|
||||
(((listObj_)->typePtr == tclListType) \
|
||||
? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
|
||||
: Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))
|
||||
|
||||
#define TclListObjIsCanonical(listObj_) \
|
||||
(((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0)
|
||||
#define TclListObjIsCanonical(listObj_) \
|
||||
(((listObj_)->typePtr == tclListType) \
|
||||
? ListObjIsCanonical((listObj_)) : 0)
|
||||
|
||||
/*
|
||||
* Modes for collecting (or not) in the implementations of TclNRForeachCmd,
|
||||
@@ -2727,29 +2819,20 @@ typedef struct ListRep {
|
||||
* WARNING: these macros eval their args more than once.
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType \
|
||||
|| (objPtr)->typePtr == &tclBooleanType) \
|
||||
(((objPtr)->typePtr == tclIntType \
|
||||
|| (objPtr)->typePtr == tclBooleanType) \
|
||||
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
|
||||
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
|
||||
#else
|
||||
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType) \
|
||||
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
|
||||
: ((objPtr)->typePtr == &tclBooleanType) \
|
||||
? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
|
||||
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
|
||||
#endif
|
||||
|
||||
#ifdef TCL_WIDE_INT_IS_LONG
|
||||
#define TclGetLongFromObj(interp, objPtr, longPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType) \
|
||||
(((objPtr)->typePtr == tclIntType) \
|
||||
? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
|
||||
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
|
||||
#else
|
||||
#define TclGetLongFromObj(interp, objPtr, longPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType \
|
||||
(((objPtr)->typePtr == tclIntType \
|
||||
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
|
||||
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
|
||||
? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
|
||||
@@ -2757,13 +2840,13 @@ typedef struct ListRep {
|
||||
#endif
|
||||
|
||||
#define TclGetIntFromObj(interp, objPtr, intPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType \
|
||||
(((objPtr)->typePtr == tclIntType \
|
||||
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
|
||||
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
|
||||
? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
|
||||
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
|
||||
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
|
||||
((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
|
||||
((((objPtr)->typePtr == tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
|
||||
&& ((objPtr)->internalRep.wideValue <= endValue)) \
|
||||
? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
|
||||
: Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
|
||||
@@ -2777,7 +2860,7 @@ typedef struct ListRep {
|
||||
*/
|
||||
|
||||
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType) \
|
||||
(((objPtr)->typePtr == tclIntType) \
|
||||
? (*(wideIntPtr) = \
|
||||
((objPtr)->internalRep.wideValue), TCL_OK) : \
|
||||
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
|
||||
@@ -3030,7 +3113,6 @@ MODULE_SCOPE TclPlatformType tclPlatform;
|
||||
*/
|
||||
|
||||
MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
|
||||
MODULE_SCOPE Tcl_Encoding tclUtf8Encoding;
|
||||
MODULE_SCOPE int
|
||||
TclEncodingProfileNameToId(Tcl_Interp *interp,
|
||||
const char *profileName,
|
||||
@@ -3053,13 +3135,13 @@ MODULE_SCOPE void *tclTimeClientData;
|
||||
* Variables denoting the Tcl object types defined in the core.
|
||||
*/
|
||||
|
||||
MODULE_SCOPE const Tcl_ObjType tclBignumType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclBignumType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclBooleanType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclIntType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclIndexType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclListType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclDoubleType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclIntType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclListType;
|
||||
MODULE_SCOPE const Tcl_ObjType *tclArithSeriesType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclDictType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclStringType;
|
||||
@@ -3202,12 +3284,11 @@ struct Tcl_LoadHandle_ {
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr,
|
||||
const unsigned char *bytes, Tcl_Size len);
|
||||
MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
int flags);
|
||||
MODULE_SCOPE void TclAdvanceContinuations(Tcl_Size *line, Tcl_Size **next,
|
||||
MODULE_SCOPE void TclAdvanceContinuations(Tcl_Size *line, int **next,
|
||||
int loc);
|
||||
MODULE_SCOPE void TclAdvanceLines(Tcl_Size *line, const char *start,
|
||||
const char *end);
|
||||
@@ -3217,7 +3298,7 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp,
|
||||
Tcl_Obj *objv[], int objc);
|
||||
MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp,
|
||||
Tcl_Obj *objv[], int objc,
|
||||
void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc);
|
||||
void *codePtr, CmdFrame *cfPtr, int cmd, Tcl_Size pc);
|
||||
MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
|
||||
CmdFrame *cfPtr);
|
||||
MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
|
||||
@@ -3226,6 +3307,7 @@ MODULE_SCOPE int TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId,
|
||||
void *clientData, int *flagPtr, int value);
|
||||
MODULE_SCOPE void TclAsyncMarkFromNotifier(void);
|
||||
MODULE_SCOPE double TclBignumToDouble(const void *bignum);
|
||||
MODULE_SCOPE void TclBounceRefCount(Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
|
||||
Tcl_Size strLen, const unsigned char *pattern,
|
||||
Tcl_Size ptnLen, int flags);
|
||||
@@ -3242,9 +3324,9 @@ MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
|
||||
MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
|
||||
Tcl_Obj *value2Ptr);
|
||||
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, Tcl_Size num,
|
||||
Tcl_Size *loc);
|
||||
int *loc);
|
||||
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
|
||||
Tcl_Size start, Tcl_Size *clNext);
|
||||
int start, int *clNext);
|
||||
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
|
||||
Tcl_Obj *originObjPtr);
|
||||
@@ -3259,7 +3341,8 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
|
||||
Tcl_Namespace *ensembleNamespacePtr, int flags);
|
||||
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
|
||||
MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr);
|
||||
MODULE_SCOPE Tcl_Size TclDictGetSize(Tcl_Obj *dictPtr);
|
||||
MODULE_SCOPE Tcl_Obj* TclDuplicatePureObj(Tcl_Interp *interp,
|
||||
Tcl_Obj * objPtr, const Tcl_ObjType *typPtr);
|
||||
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
|
||||
const char *dict, Tcl_Size dictLength,
|
||||
const char **elementPtr, const char **nextPtr,
|
||||
@@ -3267,7 +3350,7 @@ MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
|
||||
/* TIP #280 - Modified token based evaluation, with line information. */
|
||||
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
|
||||
Tcl_Size numBytes, int flags, Tcl_Size line,
|
||||
Tcl_Size *clNextOuter, const char *outerScript);
|
||||
int *clNextOuter, const char *outerScript);
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
|
||||
@@ -3348,6 +3431,8 @@ MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp,
|
||||
const char *packageName);
|
||||
MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
|
||||
Tcl_WideInt *);
|
||||
MODULE_SCOPE int TclIndexIsFromEnd(Tcl_Size encoded);
|
||||
MODULE_SCOPE Tcl_Size TclIndexLast (Tcl_Size N);
|
||||
MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
|
||||
Tcl_Obj *incrPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
|
||||
@@ -3387,10 +3472,12 @@ MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp,
|
||||
MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
Tcl_Size indexCount, Tcl_Obj *const indexArray[]);
|
||||
MODULE_SCOPE Tcl_Obj * TclListObjGetElement(Tcl_Obj *listObj, Tcl_Size index);
|
||||
MODULE_SCOPE int Tcl_LengthIsFinite(Tcl_Size length);
|
||||
/* TIP #280 */
|
||||
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, Tcl_Size n,
|
||||
Tcl_Size *lines, Tcl_Obj *const *elems);
|
||||
MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
|
||||
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, int n,
|
||||
int *lines, Tcl_Obj *const *elems);
|
||||
MODULE_SCOPE int (*TclObjInterfaceGetListIndex (Tcl_Obj *objPtr))
|
||||
(tclObjTypeInterfaceArgsListIndex);
|
||||
MODULE_SCOPE int TclListObjAppendElements(Tcl_Interp *interp,
|
||||
Tcl_Obj *toObj, Tcl_Size elemCount,
|
||||
Tcl_Obj *const elemObjv[]);
|
||||
@@ -3398,9 +3485,9 @@ MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
Tcl_Size fromIdx, Tcl_Size toIdx);
|
||||
MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
Tcl_Size indexCount, Tcl_Obj *const indexArray[],
|
||||
Tcl_Obj *valuePtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclLsetFlat(tclObjTypeInterfaceArgsListSetList);
|
||||
MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
|
||||
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
|
||||
const EnsembleImplMap map[]);
|
||||
MODULE_SCOPE int TclMakeSafe(Tcl_Interp *interp);
|
||||
@@ -3413,6 +3500,9 @@ MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
|
||||
MODULE_SCOPE int TclNokia770Doubles(void);
|
||||
MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr);
|
||||
MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclObjGetScalar(Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE const char * TclObjTypeName(const Tcl_ObjType *typePtr);
|
||||
MODULE_SCOPE int TclObjTypeVersion (const Tcl_ObjType *typePtr);
|
||||
MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
|
||||
Tcl_Obj *part2Ptr, const char *operation,
|
||||
const char *reason, int index);
|
||||
@@ -3438,11 +3528,6 @@ MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
|
||||
MODULE_SCOPE Tcl_Obj * TclpTempFileName(void);
|
||||
MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp,
|
||||
Tcl_Obj* pathPtr);
|
||||
MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr,
|
||||
int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj,
|
||||
Tcl_Obj *stepObj, Tcl_Obj *lenObj);
|
||||
MODULE_SCOPE Tcl_Obj * TclNewStringListObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *srcStringObj);
|
||||
MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
|
||||
Tcl_Size len);
|
||||
MODULE_SCOPE void TclpAlertNotifier(void *clientData);
|
||||
@@ -3499,6 +3584,7 @@ MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
|
||||
MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
|
||||
int linkType);
|
||||
MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr);
|
||||
MODULE_SCOPE void Tcl_ObjTypeVersion(Tcl_Obj *objPtr, int *version);
|
||||
MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
|
||||
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
|
||||
Tcl_Obj *resultingNameObj);
|
||||
@@ -3546,6 +3632,8 @@ MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
|
||||
MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[], int *nocase,
|
||||
Tcl_Size *reqlength);
|
||||
MODULE_SCOPE int TclStringIndexInterface(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
Tcl_Obj *indexPtr, Tcl_Obj **charPtr);
|
||||
MODULE_SCOPE int TclStringMatch(const char *str, Tcl_Size strLen,
|
||||
const char *pattern, int ptnLen, int flags);
|
||||
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
|
||||
@@ -3560,7 +3648,7 @@ MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes,
|
||||
Tcl_InterpState *statePtr);
|
||||
MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
|
||||
Tcl_Size count, int *tokensLeftPtr, Tcl_Size line,
|
||||
Tcl_Size *clNextOuter, const char *outerScript);
|
||||
int *clNextOuter, const char *outerScript);
|
||||
MODULE_SCOPE Tcl_Size TclTrim(const char *bytes, Tcl_Size numBytes,
|
||||
const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight);
|
||||
MODULE_SCOPE Tcl_Size TclTrimLeft(const char *bytes, Tcl_Size numBytes,
|
||||
@@ -3571,18 +3659,10 @@ MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
|
||||
MODULE_SCOPE void TclRegisterCommandTypeName(
|
||||
Tcl_ObjCmdProc *implementationProc,
|
||||
const char *nameStr);
|
||||
MODULE_SCOPE void TclUndoRefCount(Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct);
|
||||
MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct);
|
||||
MODULE_SCOPE int TclUtfCount(int ch);
|
||||
#if TCL_UTF_MAX > 3
|
||||
# define TclUtfToUCS4 Tcl_UtfToUniChar
|
||||
# define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1)
|
||||
# define TclUCS4Prev(src, ptr) (((src) > (ptr)) ? ((src) - 1) : (src))
|
||||
#else
|
||||
MODULE_SCOPE int TclUtfToUCS4(const char *, int *);
|
||||
MODULE_SCOPE int TclUniCharToUCS4(const Tcl_UniChar *, int *);
|
||||
MODULE_SCOPE const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *, const Tcl_UniChar *);
|
||||
#endif
|
||||
MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(void *clientData);
|
||||
MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr);
|
||||
MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
|
||||
@@ -4315,7 +4395,6 @@ MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
|
||||
int *codePtr, Tcl_Obj **msgObjPtr,
|
||||
Tcl_Obj **errorObjPtr);
|
||||
MODULE_SCOPE int TclClose(Tcl_Interp *, Tcl_Channel chan);
|
||||
|
||||
/*
|
||||
* TIP #508: [array default]
|
||||
*/
|
||||
@@ -4339,7 +4418,6 @@ MODULE_SCOPE int TclIndexInvalidError(Tcl_Interp *interp,
|
||||
*/
|
||||
MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count);
|
||||
|
||||
#endif /* TCL_MAJOR_VERSION > 8 */
|
||||
|
||||
/* Constants used in index value encoding routines. */
|
||||
#define TCL_INDEX_END ((Tcl_Size)-2)
|
||||
@@ -4852,17 +4930,10 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if TCL_UTF_MAX > 3
|
||||
#define TclUtfToUniChar(str, chPtr) \
|
||||
(((UCHAR(*(str))) < 0x80) ? \
|
||||
((*(chPtr) = UCHAR(*(str))), 1) \
|
||||
: Tcl_UtfToUniChar(str, chPtr))
|
||||
#else
|
||||
#define TclUtfToUniChar(str, chPtr) \
|
||||
(((UCHAR(*(str))) < 0x80) ? \
|
||||
((*(chPtr) = UCHAR(*(str))), 1) \
|
||||
: Tcl_UtfToChar16(str, chPtr))
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
@@ -4925,7 +4996,7 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
|
||||
#if defined(WORDS_BIGENDIAN)
|
||||
# define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
|
||||
#endif /* WORDS_BIGENDIAN */
|
||||
|
||||
@@ -4971,8 +5042,8 @@ MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init;
|
||||
MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init;
|
||||
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init;
|
||||
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
|
||||
MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
|
||||
|
||||
MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceInit;
|
||||
MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceListIntegerInit;
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
@@ -5003,7 +5074,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
|
||||
Tcl_ObjInternalRep ir; \
|
||||
ir.wideValue = (Tcl_WideInt) i; \
|
||||
TclInvalidateStringRep(objPtr); \
|
||||
Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \
|
||||
Tcl_StoreInternalRep(objPtr, tclIntType, &ir); \
|
||||
} while (0)
|
||||
|
||||
#define TclSetDoubleObj(objPtr, d) \
|
||||
@@ -5011,7 +5082,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
|
||||
Tcl_ObjInternalRep ir; \
|
||||
ir.doubleValue = (double) d; \
|
||||
TclInvalidateStringRep(objPtr); \
|
||||
Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir); \
|
||||
Tcl_StoreInternalRep(objPtr, tclDoubleType, &ir); \
|
||||
} while (0)
|
||||
|
||||
/*
|
||||
@@ -5022,7 +5093,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
|
||||
*
|
||||
* MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
|
||||
* MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d);
|
||||
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, Tcl_Size len);
|
||||
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, size_t len);
|
||||
* MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
|
||||
*
|
||||
*----------------------------------------------------------------
|
||||
@@ -5036,7 +5107,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
|
||||
(objPtr)->refCount = 0; \
|
||||
(objPtr)->bytes = NULL; \
|
||||
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
|
||||
(objPtr)->typePtr = &tclIntType; \
|
||||
(objPtr)->typePtr = tclIntType; \
|
||||
TCL_DTRACE_OBJ_CREATE(objPtr); \
|
||||
} while (0)
|
||||
|
||||
@@ -5055,13 +5126,13 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
|
||||
TclSetBignumInternalRep((objPtr), &bignumValue_); \
|
||||
} else { \
|
||||
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \
|
||||
(objPtr)->typePtr = &tclIntType; \
|
||||
(objPtr)->typePtr = tclIntType; \
|
||||
} \
|
||||
TCL_DTRACE_OBJ_CREATE(objPtr); \
|
||||
} while (0)
|
||||
|
||||
#define TclNewIndexObj(objPtr, w) \
|
||||
TclNewIntObj(objPtr, w)
|
||||
#define TclNewIndexObj(objPtr, uw) \
|
||||
TclNewIntObj(objPtr, uw)
|
||||
|
||||
#define TclNewDoubleObj(objPtr, d) \
|
||||
do { \
|
||||
@@ -5070,7 +5141,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
|
||||
(objPtr)->refCount = 0; \
|
||||
(objPtr)->bytes = NULL; \
|
||||
(objPtr)->internalRep.doubleValue = (double)(d); \
|
||||
(objPtr)->typePtr = &tclDoubleType; \
|
||||
(objPtr)->typePtr = tclDoubleType; \
|
||||
TCL_DTRACE_OBJ_CREATE(objPtr); \
|
||||
} while (0)
|
||||
|
||||
@@ -5331,7 +5402,7 @@ typedef struct NRE_callback {
|
||||
#define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr))
|
||||
#else
|
||||
#define TCLNR_ALLOC(interp, ptr) \
|
||||
((ptr) = Tcl_Alloc(sizeof(NRE_callback)))
|
||||
(ptr = (Tcl_Alloc(sizeof(NRE_callback))))
|
||||
#define TCLNR_FREE(interp, ptr) Tcl_Free(ptr)
|
||||
#endif
|
||||
|
||||
|
||||
@@ -1281,15 +1281,6 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclStaticLibrary)
|
||||
#endif /* defined(USE_TCL_STUBS) */
|
||||
|
||||
#if (TCL_MAJOR_VERSION < 9) && defined(USE_TCL_STUBS)
|
||||
#undef TclpGetClicks
|
||||
#define TclpGetClicks() \
|
||||
((unsigned long)tclIntStubsPtr->tclpGetClicks())
|
||||
#undef TclpGetSeconds
|
||||
#define TclpGetSeconds() \
|
||||
((unsigned long)tclIntStubsPtr->tclpGetSeconds())
|
||||
#endif
|
||||
|
||||
#undef TclObjInterpProc
|
||||
#define TclObjInterpProc TclGetObjInterpProc()
|
||||
#define TclObjInterpProc2 TclGetObjInterpProc2()
|
||||
|
||||
+1
-544
@@ -30,535 +30,6 @@
|
||||
* in the generic/tclInt.decls script.
|
||||
*/
|
||||
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Exported function declarations:
|
||||
*/
|
||||
|
||||
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
/* 0 */
|
||||
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
/* 1 */
|
||||
EXTERN int TclpCloseFile(TclFile file);
|
||||
/* 2 */
|
||||
EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
|
||||
TclFile writeFile, TclFile errorFile,
|
||||
int numPids, Tcl_Pid *pidPtr);
|
||||
/* 3 */
|
||||
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
|
||||
/* 4 */
|
||||
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
|
||||
const char **argv, TclFile inputFile,
|
||||
TclFile outputFile, TclFile errorFile,
|
||||
Tcl_Pid *pidPtr);
|
||||
/* 5 */
|
||||
EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout);
|
||||
/* 6 */
|
||||
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
|
||||
/* 7 */
|
||||
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
|
||||
/* 8 */
|
||||
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 9 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
|
||||
/* 13 */
|
||||
EXTERN char * TclpInetNtoa(struct in_addr addr);
|
||||
/* 14 */
|
||||
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr,
|
||||
int dontCopyAtts);
|
||||
/* 15 */
|
||||
EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
|
||||
int objIndex, Tcl_Obj *fileName,
|
||||
Tcl_Obj **attributePtrPtr);
|
||||
/* 16 */
|
||||
EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
|
||||
int objIndex, Tcl_Obj *fileName,
|
||||
Tcl_Obj *attributePtr);
|
||||
/* 17 */
|
||||
EXTERN int TclMacOSXCopyFileAttributes(const char *src,
|
||||
const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr);
|
||||
/* 18 */
|
||||
EXTERN int TclMacOSXMatchType(Tcl_Interp *interp,
|
||||
const char *pathName, const char *fileName,
|
||||
Tcl_StatBuf *statBufPtr,
|
||||
Tcl_GlobTypeData *types);
|
||||
/* 19 */
|
||||
EXTERN void TclMacOSXNotifierAddRunLoopMode(
|
||||
const void *runLoopMode);
|
||||
/* Slot 20 is reserved */
|
||||
/* Slot 21 is reserved */
|
||||
/* 22 */
|
||||
EXTERN TclFile TclpCreateTempFile_(const char *contents);
|
||||
/* Slot 23 is reserved */
|
||||
/* Slot 24 is reserved */
|
||||
/* Slot 25 is reserved */
|
||||
/* Slot 26 is reserved */
|
||||
/* Slot 27 is reserved */
|
||||
/* Slot 28 is reserved */
|
||||
/* 29 */
|
||||
EXTERN int TclWinCPUID(int index, int *regs);
|
||||
/* 30 */
|
||||
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
|
||||
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
|
||||
Tcl_Obj *resultingNameObj);
|
||||
#endif /* UNIX */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
/* 0 */
|
||||
EXTERN void TclWinConvertError(DWORD errCode);
|
||||
/* 1 */
|
||||
EXTERN void TclWinConvertWSAError(DWORD errCode);
|
||||
/* 2 */
|
||||
EXTERN struct servent * TclWinGetServByName(const char *nm,
|
||||
const char *proto);
|
||||
/* 3 */
|
||||
EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname,
|
||||
char *optval, int *optlen);
|
||||
/* 4 */
|
||||
EXTERN HINSTANCE TclWinGetTclInstance(void);
|
||||
/* 5 */
|
||||
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 6 */
|
||||
EXTERN unsigned short TclWinNToHS(unsigned short ns);
|
||||
/* 7 */
|
||||
EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname,
|
||||
const char *optval, int optlen);
|
||||
/* 8 */
|
||||
EXTERN int TclpGetPid(Tcl_Pid pid);
|
||||
/* 9 */
|
||||
EXTERN int TclWinGetPlatformId(void);
|
||||
/* 11 */
|
||||
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
/* 12 */
|
||||
EXTERN int TclpCloseFile(TclFile file);
|
||||
/* 13 */
|
||||
EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
|
||||
TclFile writeFile, TclFile errorFile,
|
||||
int numPids, Tcl_Pid *pidPtr);
|
||||
/* 14 */
|
||||
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
|
||||
/* 15 */
|
||||
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
|
||||
const char **argv, TclFile inputFile,
|
||||
TclFile outputFile, TclFile errorFile,
|
||||
Tcl_Pid *pidPtr);
|
||||
/* 16 */
|
||||
EXTERN int TclpIsAtty(int fd);
|
||||
/* 17 */
|
||||
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr,
|
||||
int dontCopyAtts);
|
||||
/* 18 */
|
||||
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
|
||||
/* 19 */
|
||||
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
|
||||
/* 20 */
|
||||
EXTERN void TclWinAddProcess(void *hProcess, Tcl_Size id);
|
||||
/* 21 */
|
||||
EXTERN char * TclpInetNtoa(struct in_addr addr);
|
||||
/* 22 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* Slot 23 is reserved */
|
||||
/* 24 */
|
||||
EXTERN char * TclWinNoBackslash(char *path);
|
||||
/* Slot 25 is reserved */
|
||||
/* 26 */
|
||||
EXTERN void TclWinSetInterfaces(int wide);
|
||||
/* 27 */
|
||||
EXTERN void TclWinFlushDirtyChannels(void);
|
||||
/* 28 */
|
||||
EXTERN void TclWinResetInterfaces(void);
|
||||
/* 29 */
|
||||
EXTERN int TclWinCPUID(int index, int *regs);
|
||||
/* 30 */
|
||||
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
|
||||
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
|
||||
Tcl_Obj *resultingNameObj);
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
/* 0 */
|
||||
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
/* 1 */
|
||||
EXTERN int TclpCloseFile(TclFile file);
|
||||
/* 2 */
|
||||
EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
|
||||
TclFile writeFile, TclFile errorFile,
|
||||
int numPids, Tcl_Pid *pidPtr);
|
||||
/* 3 */
|
||||
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
|
||||
/* 4 */
|
||||
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
|
||||
const char **argv, TclFile inputFile,
|
||||
TclFile outputFile, TclFile errorFile,
|
||||
Tcl_Pid *pidPtr);
|
||||
/* 5 */
|
||||
EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout);
|
||||
/* 6 */
|
||||
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
|
||||
/* 7 */
|
||||
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
|
||||
/* 8 */
|
||||
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 9 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
|
||||
/* 13 */
|
||||
EXTERN char * TclpInetNtoa(struct in_addr addr);
|
||||
/* 14 */
|
||||
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr,
|
||||
int dontCopyAtts);
|
||||
/* 15 */
|
||||
EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
|
||||
int objIndex, Tcl_Obj *fileName,
|
||||
Tcl_Obj **attributePtrPtr);
|
||||
/* 16 */
|
||||
EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
|
||||
int objIndex, Tcl_Obj *fileName,
|
||||
Tcl_Obj *attributePtr);
|
||||
/* 17 */
|
||||
EXTERN int TclMacOSXCopyFileAttributes(const char *src,
|
||||
const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr);
|
||||
/* 18 */
|
||||
EXTERN int TclMacOSXMatchType(Tcl_Interp *interp,
|
||||
const char *pathName, const char *fileName,
|
||||
Tcl_StatBuf *statBufPtr,
|
||||
Tcl_GlobTypeData *types);
|
||||
/* 19 */
|
||||
EXTERN void TclMacOSXNotifierAddRunLoopMode(
|
||||
const void *runLoopMode);
|
||||
/* Slot 20 is reserved */
|
||||
/* Slot 21 is reserved */
|
||||
/* 22 */
|
||||
EXTERN TclFile TclpCreateTempFile_(const char *contents);
|
||||
/* Slot 23 is reserved */
|
||||
/* Slot 24 is reserved */
|
||||
/* Slot 25 is reserved */
|
||||
/* Slot 26 is reserved */
|
||||
/* Slot 27 is reserved */
|
||||
/* Slot 28 is reserved */
|
||||
/* 29 */
|
||||
EXTERN int TclWinCPUID(int index, int *regs);
|
||||
/* 30 */
|
||||
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
|
||||
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
|
||||
Tcl_Obj *resultingNameObj);
|
||||
#endif /* MACOSX */
|
||||
|
||||
typedef struct TclIntPlatStubs {
|
||||
int magic;
|
||||
void *hooks;
|
||||
|
||||
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
|
||||
int (*tclpCloseFile) (TclFile file); /* 1 */
|
||||
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
|
||||
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
|
||||
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
|
||||
int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
|
||||
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
|
||||
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
|
||||
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
|
||||
int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
|
||||
int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
|
||||
void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
|
||||
void (*reserved20)(void);
|
||||
void (*reserved21)(void);
|
||||
TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
|
||||
void (*reserved23)(void);
|
||||
void (*reserved24)(void);
|
||||
void (*reserved25)(void);
|
||||
void (*reserved26)(void);
|
||||
void (*reserved27)(void);
|
||||
void (*reserved28)(void);
|
||||
int (*tclWinCPUID) (int index, int *regs); /* 29 */
|
||||
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
|
||||
#endif /* UNIX */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
void (*tclWinConvertError) (DWORD errCode); /* 0 */
|
||||
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
|
||||
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
|
||||
int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
|
||||
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
|
||||
unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
|
||||
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
|
||||
Tcl_Size (*tclpGetPid) (Tcl_Pid pid); /* 8 */
|
||||
int (*tclWinGetPlatformId) (void); /* 9 */
|
||||
void *(*tclpReaddir) (void *dir); /* 10 */
|
||||
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
|
||||
int (*tclpCloseFile) (TclFile file); /* 12 */
|
||||
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
|
||||
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
|
||||
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
|
||||
int (*tclpIsAtty) (int fd); /* 16 */
|
||||
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
|
||||
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
|
||||
void (*tclWinAddProcess) (void *hProcess, Tcl_Size id); /* 20 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
|
||||
void (*reserved23)(void);
|
||||
char * (*tclWinNoBackslash) (char *path); /* 24 */
|
||||
void (*reserved25)(void);
|
||||
void (*tclWinSetInterfaces) (int wide); /* 26 */
|
||||
void (*tclWinFlushDirtyChannels) (void); /* 27 */
|
||||
void (*tclWinResetInterfaces) (void); /* 28 */
|
||||
int (*tclWinCPUID) (int index, int *regs); /* 29 */
|
||||
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
|
||||
int (*tclpCloseFile) (TclFile file); /* 1 */
|
||||
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
|
||||
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
|
||||
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
|
||||
int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
|
||||
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
|
||||
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
|
||||
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
|
||||
int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
|
||||
int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
|
||||
void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
|
||||
void (*reserved20)(void);
|
||||
void (*reserved21)(void);
|
||||
TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
|
||||
void (*reserved23)(void);
|
||||
void (*reserved24)(void);
|
||||
void (*reserved25)(void);
|
||||
void (*reserved26)(void);
|
||||
void (*reserved27)(void);
|
||||
void (*reserved28)(void);
|
||||
int (*tclWinCPUID) (int index, int *regs); /* 29 */
|
||||
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
|
||||
#endif /* MACOSX */
|
||||
} TclIntPlatStubs;
|
||||
|
||||
extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#if defined(USE_TCL_STUBS)
|
||||
|
||||
/*
|
||||
* Inline function declarations:
|
||||
*/
|
||||
|
||||
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#define TclGetAndDetachPids \
|
||||
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
|
||||
#define TclpCloseFile \
|
||||
(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
|
||||
#define TclpCreateCommandChannel \
|
||||
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
|
||||
#define TclpCreatePipe \
|
||||
(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
|
||||
#define TclpCreateProcess \
|
||||
(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
|
||||
#define TclUnixWaitForFile_ \
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
|
||||
#define TclpMakeFile \
|
||||
(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
|
||||
#define TclpOpenFile \
|
||||
(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
|
||||
#define TclUnixWaitForFile \
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
|
||||
#define TclpCreateTempFile \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
|
||||
#define TclpReaddir \
|
||||
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
|
||||
#define TclpLocaltime_unix \
|
||||
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
|
||||
#define TclpGmtime_unix \
|
||||
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
|
||||
#define TclpInetNtoa \
|
||||
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
|
||||
#define TclUnixCopyFile \
|
||||
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
|
||||
#define TclMacOSXGetFileAttribute \
|
||||
(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
|
||||
#define TclMacOSXSetFileAttribute \
|
||||
(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
|
||||
#define TclMacOSXCopyFileAttributes \
|
||||
(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
|
||||
#define TclMacOSXMatchType \
|
||||
(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
|
||||
#define TclMacOSXNotifierAddRunLoopMode \
|
||||
(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
|
||||
/* Slot 20 is reserved */
|
||||
/* Slot 21 is reserved */
|
||||
#define TclpCreateTempFile_ \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
|
||||
/* Slot 23 is reserved */
|
||||
/* Slot 24 is reserved */
|
||||
/* Slot 25 is reserved */
|
||||
/* Slot 26 is reserved */
|
||||
/* Slot 27 is reserved */
|
||||
/* Slot 28 is reserved */
|
||||
#define TclWinCPUID \
|
||||
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
|
||||
#define TclUnixOpenTemporaryFile \
|
||||
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
|
||||
#endif /* UNIX */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
#define TclWinConvertError \
|
||||
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
|
||||
#define TclWinConvertWSAError \
|
||||
(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
|
||||
#define TclWinGetServByName \
|
||||
(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
|
||||
#define TclWinGetSockOpt \
|
||||
(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
|
||||
#define TclWinGetTclInstance \
|
||||
(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
|
||||
#define TclUnixWaitForFile \
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
|
||||
#define TclWinNToHS \
|
||||
(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
|
||||
#define TclWinSetSockOpt \
|
||||
(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
|
||||
#define TclpGetPid \
|
||||
(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
|
||||
#define TclWinGetPlatformId \
|
||||
(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
|
||||
#define TclGetAndDetachPids \
|
||||
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
|
||||
#define TclpCloseFile \
|
||||
(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
|
||||
#define TclpCreateCommandChannel \
|
||||
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
|
||||
#define TclpCreatePipe \
|
||||
(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
|
||||
#define TclpCreateProcess \
|
||||
(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
|
||||
#define TclpIsAtty \
|
||||
(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
|
||||
#define TclUnixCopyFile \
|
||||
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
|
||||
#define TclpMakeFile \
|
||||
(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
|
||||
#define TclpOpenFile \
|
||||
(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
|
||||
#define TclWinAddProcess \
|
||||
(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
|
||||
#define TclpInetNtoa \
|
||||
(tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
|
||||
#define TclpCreateTempFile \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
|
||||
/* Slot 23 is reserved */
|
||||
#define TclWinNoBackslash \
|
||||
(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
|
||||
/* Slot 25 is reserved */
|
||||
#define TclWinSetInterfaces \
|
||||
(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
|
||||
#define TclWinFlushDirtyChannels \
|
||||
(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
|
||||
#define TclWinResetInterfaces \
|
||||
(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
|
||||
#define TclWinCPUID \
|
||||
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
|
||||
#define TclUnixOpenTemporaryFile \
|
||||
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
#define TclGetAndDetachPids \
|
||||
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
|
||||
#define TclpCloseFile \
|
||||
(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
|
||||
#define TclpCreateCommandChannel \
|
||||
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
|
||||
#define TclpCreatePipe \
|
||||
(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
|
||||
#define TclpCreateProcess \
|
||||
(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
|
||||
#define TclUnixWaitForFile_ \
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
|
||||
#define TclpMakeFile \
|
||||
(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
|
||||
#define TclpOpenFile \
|
||||
(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
|
||||
#define TclUnixWaitForFile \
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
|
||||
#define TclpCreateTempFile \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
|
||||
#define TclpReaddir \
|
||||
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
|
||||
#define TclpLocaltime_unix \
|
||||
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
|
||||
#define TclpGmtime_unix \
|
||||
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
|
||||
#define TclpInetNtoa \
|
||||
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
|
||||
#define TclUnixCopyFile \
|
||||
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
|
||||
#define TclMacOSXGetFileAttribute \
|
||||
(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
|
||||
#define TclMacOSXSetFileAttribute \
|
||||
(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
|
||||
#define TclMacOSXCopyFileAttributes \
|
||||
(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
|
||||
#define TclMacOSXMatchType \
|
||||
(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
|
||||
#define TclMacOSXNotifierAddRunLoopMode \
|
||||
(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
|
||||
/* Slot 20 is reserved */
|
||||
/* Slot 21 is reserved */
|
||||
#define TclpCreateTempFile_ \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
|
||||
/* Slot 23 is reserved */
|
||||
/* Slot 24 is reserved */
|
||||
/* Slot 25 is reserved */
|
||||
/* Slot 26 is reserved */
|
||||
/* Slot 27 is reserved */
|
||||
/* Slot 28 is reserved */
|
||||
#define TclWinCPUID \
|
||||
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
|
||||
#define TclUnixOpenTemporaryFile \
|
||||
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
|
||||
#endif /* MACOSX */
|
||||
|
||||
#endif /* defined(USE_TCL_STUBS) */
|
||||
|
||||
#else /* TCL_MAJOR_VERSION > 8 */
|
||||
/* !BEGIN!: Do not edit below this line. */
|
||||
|
||||
#ifdef __cplusplus
|
||||
@@ -731,7 +202,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
#endif /* defined(USE_TCL_STUBS) */
|
||||
|
||||
/* !END!: Do not edit above this line. */
|
||||
#endif /* TCL_MAJOR_VERSION */
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#define TCL_STORAGE_CLASS DLLIMPORT
|
||||
@@ -739,17 +209,13 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
#undef TclpGmtime_unix
|
||||
#undef TclWinConvertWSAError
|
||||
#define TclWinConvertWSAError TclWinConvertError
|
||||
#if !defined(TCL_USE_STUBS) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
# undef TclWinConvertError
|
||||
# define TclWinConvertError Tcl_WinConvertError
|
||||
#endif
|
||||
|
||||
#undef TclpInetNtoa
|
||||
#define TclpInetNtoa inet_ntoa
|
||||
|
||||
#undef TclpCreateTempFile_
|
||||
#undef TclUnixWaitForFile_
|
||||
#ifdef MAC_OSX_TCL /* not accessible on Win32/UNIX */
|
||||
#ifdef MAC_OSX_TCL /* not accessable on Win32/UNIX */
|
||||
MODULE_SCOPE int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
|
||||
int objIndex, Tcl_Obj *fileName,
|
||||
Tcl_Obj **attributePtrPtr);
|
||||
@@ -782,15 +248,6 @@ MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp,
|
||||
# undef TclWinGetPlatformId
|
||||
# undef TclWinResetInterfaces
|
||||
# undef TclWinSetInterfaces
|
||||
# if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
# define TclWinNToHS ntohs
|
||||
# define TclWinGetServByName getservbyname
|
||||
# define TclWinGetSockOpt getsockopt
|
||||
# define TclWinSetSockOpt setsockopt
|
||||
# define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
|
||||
# define TclWinResetInterfaces() /* nop */
|
||||
# define TclWinSetInterfaces(dummy) /* nop */
|
||||
# endif /* TCL_NO_DEPRECATED */
|
||||
#else
|
||||
# undef TclpGetPid
|
||||
# define TclpGetPid(pid) ((size_t)(pid))
|
||||
|
||||
@@ -624,9 +624,7 @@ NRInterpCmd(
|
||||
"hidden", "issafe", "invokehidden",
|
||||
"limit", "marktrusted", "recursionlimit",
|
||||
"share",
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
"slaves",
|
||||
#endif
|
||||
"target", "transfer", NULL
|
||||
};
|
||||
static const char *const optionsNoSlaves[] = {
|
||||
@@ -644,9 +642,7 @@ NRInterpCmd(
|
||||
OPT_EVAL, OPT_EXISTS, OPT_EXPOSE, OPT_HIDE,
|
||||
OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID,
|
||||
OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT, OPT_SHARE,
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
OPT_SLAVES,
|
||||
#endif
|
||||
OPT_TARGET, OPT_TRANSFER
|
||||
} index;
|
||||
|
||||
@@ -1033,9 +1029,7 @@ NRInterpCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
case OPT_SLAVES:
|
||||
#endif
|
||||
case OPT_CHILDREN: {
|
||||
InterpInfo *iiPtr;
|
||||
Tcl_Obj *resultPtr;
|
||||
|
||||
+1
-17
@@ -179,14 +179,6 @@ Tcl_LinkVar(
|
||||
Tcl_IncrRefCount(linkPtr->varName);
|
||||
linkPtr->addr = addr;
|
||||
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
|
||||
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
|
||||
|| defined(_WIN32) || defined(__CYGWIN__))
|
||||
if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
|
||||
linkPtr->type = TCL_LINK_LONG;
|
||||
} else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
|
||||
linkPtr->type = TCL_LINK_ULONG;
|
||||
}
|
||||
#endif
|
||||
if (type & TCL_LINK_READ_ONLY) {
|
||||
linkPtr->flags = LINK_READ_ONLY;
|
||||
} else {
|
||||
@@ -262,14 +254,6 @@ Tcl_LinkArray(
|
||||
|
||||
linkPtr = (Link *)Tcl_Alloc(sizeof(Link));
|
||||
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
|
||||
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
|
||||
|| defined(_WIN32) || defined(__CYGWIN__))
|
||||
if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
|
||||
linkPtr->type = TCL_LINK_LONG;
|
||||
} else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
|
||||
linkPtr->type = TCL_LINK_ULONG;
|
||||
}
|
||||
#endif
|
||||
linkPtr->numElems = size;
|
||||
if (type & TCL_LINK_READ_ONLY) {
|
||||
linkPtr->flags = LINK_READ_ONLY;
|
||||
@@ -547,7 +531,7 @@ GetDouble(
|
||||
return 0;
|
||||
} else {
|
||||
#ifdef ACCEPT_NAN
|
||||
Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclDoubleType);
|
||||
Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, tclDoubleType);
|
||||
|
||||
if (irPtr != NULL) {
|
||||
*dblPtr = irPtr->doubleValue;
|
||||
|
||||
+539
-395
File diff suppressed because it is too large
Load Diff
+1
-1
@@ -395,7 +395,7 @@ Tcl_PopCallFrame(
|
||||
Tcl_Free(framePtr->varTablePtr);
|
||||
framePtr->varTablePtr = NULL;
|
||||
}
|
||||
if (framePtr->numCompiledLocals > 0) {
|
||||
if (framePtr->numCompiledLocals + 1 > 1) {
|
||||
TclDeleteCompiledLocalVars(iPtr, framePtr);
|
||||
if (framePtr->localCachePtr->refCount-- <= 1) {
|
||||
TclFreeLocalCache(interp, framePtr->localCachePtr);
|
||||
|
||||
@@ -138,9 +138,6 @@ static const Tcl_MethodType classConstructor = {
|
||||
*/
|
||||
|
||||
static const char initScript[] =
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
|
||||
#endif
|
||||
"package ifneeded tcl::oo " TCLOO_PATCHLEVEL " {# Already present, OK?};"
|
||||
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
|
||||
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
|
||||
@@ -260,10 +257,6 @@ TclOOInit(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
|
||||
&tclOOStubs);
|
||||
#endif
|
||||
return Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL,
|
||||
&tclOOStubs);
|
||||
}
|
||||
|
||||
@@ -588,7 +588,7 @@ TclOOMakeProcInstanceMethod(
|
||||
|
||||
cfPtr->level = -1;
|
||||
cfPtr->type = context.type;
|
||||
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
|
||||
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
|
||||
cfPtr->line[0] = context.line[3];
|
||||
cfPtr->nline = 1;
|
||||
cfPtr->framePtr = NULL;
|
||||
@@ -701,7 +701,7 @@ TclOOMakeProcMethod(
|
||||
|
||||
cfPtr->level = -1;
|
||||
cfPtr->type = context.type;
|
||||
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
|
||||
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
|
||||
cfPtr->line[0] = context.line[3];
|
||||
cfPtr->nline = 1;
|
||||
cfPtr->framePtr = NULL;
|
||||
|
||||
@@ -164,13 +164,12 @@ static const char *tclOOSetupScript =
|
||||
"\t\tmethod -appendifnew -export args {\n"
|
||||
"\t\t\tset my [namespace which my]\n"
|
||||
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
|
||||
"\t\t\tforeach a $args {\n"
|
||||
"\t\t\tset args [lmap a $args {\n"
|
||||
"\t\t\t\tset a [uplevel 1 [list $my Resolve $a]]\n"
|
||||
"\t\t\t\tif {$a ni $current} {\n"
|
||||
"\t\t\t\t\tlappend current $a\n"
|
||||
"\t\t\t\t}\n"
|
||||
"\t\t\t}\n"
|
||||
"\t\t\ttailcall my Set $current\n"
|
||||
"\t\t\t\tif {$a in $current} continue\n"
|
||||
"\t\t\t\tset a\n"
|
||||
"\t\t\t}]\n"
|
||||
"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
|
||||
"\t\t}\n"
|
||||
"\t\tmethod -clear -export {} {tailcall my Set {}}\n"
|
||||
"\t\tmethod -prepend -export args {\n"
|
||||
|
||||
+338
-119
@@ -9,6 +9,7 @@
|
||||
* Copyright © 2001 ActiveState Corporation.
|
||||
* Copyright © 2005 Kevin B. Kenny. All rights reserved.
|
||||
* Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
|
||||
* Copyright © 2021 Nathan Coulter. All rights reserved.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -19,6 +20,7 @@
|
||||
#include <math.h>
|
||||
#include <assert.h>
|
||||
|
||||
|
||||
/*
|
||||
* Table of all object types.
|
||||
*/
|
||||
@@ -27,6 +29,10 @@ static Tcl_HashTable typeTable;
|
||||
static int typeTableInitialized = 0; /* 0 means not yet initialized. */
|
||||
TCL_DECLARE_MUTEX(tableMutex)
|
||||
|
||||
TclObjectTypeType TclObjectTypeType0 = {
|
||||
(int *)1
|
||||
};
|
||||
|
||||
/*
|
||||
* Head of the list of free Tcl_Obj structs we maintain.
|
||||
*/
|
||||
@@ -202,6 +208,9 @@ static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
|
||||
static void UpdateStringOfBignum(Tcl_Obj *objPtr);
|
||||
static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
int copy, mp_int *bignumValue);
|
||||
static int SetDuplicatePureObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *dupPtr, Tcl_Obj *objPtr,
|
||||
const Tcl_ObjType *typePtr);
|
||||
|
||||
/*
|
||||
* Prototypes for the array hash key methods.
|
||||
@@ -218,6 +227,32 @@ static void DupCmdNameInternalRep(Tcl_Obj *objPtr,
|
||||
static void FreeCmdNameInternalRep(Tcl_Obj *objPtr);
|
||||
static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
|
||||
static int ScalarObjIndex(tclObjTypeInterfaceArgsListIndex);
|
||||
static int ScalarObjInterfaceListLength(tclObjTypeInterfaceArgsListLength);
|
||||
static Tcl_Obj* ScalarObjRange(tclObjTypeInterfaceArgsListRange);
|
||||
|
||||
ObjInterface tclScalarInterface = {
|
||||
1,
|
||||
{},
|
||||
{
|
||||
NULL,
|
||||
NULL, /* append */
|
||||
NULL, /* appendList */
|
||||
&ScalarObjIndex, /* index */
|
||||
NULL, /* indexEnd */
|
||||
NULL, /* isSorted */
|
||||
&ScalarObjInterfaceListLength, /* length */
|
||||
&ScalarObjRange, /* range */
|
||||
NULL, /* rangeEnd */
|
||||
NULL, /* replace */
|
||||
NULL, /* replaceList */
|
||||
NULL, /* reverse */
|
||||
NULL, /* set */
|
||||
NULL, /* setList */
|
||||
},
|
||||
};
|
||||
|
||||
|
||||
/*
|
||||
* The structures below defines the Tcl object types defined in this file by
|
||||
* means of functions that can be invoked by generic object code. See also
|
||||
@@ -225,39 +260,55 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
* implementations.
|
||||
*/
|
||||
|
||||
const Tcl_ObjType tclBooleanType= {
|
||||
const ObjectType tclBooleanObjType= {
|
||||
"boolean", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
NULL, /* updateStringProc */
|
||||
TclSetBooleanFromAny, /* setFromAnyProc */
|
||||
TCL_OBJTYPE_V1(TclLengthOne)
|
||||
TclSetBooleanFromAny, /* setFromAnyProc */
|
||||
2,
|
||||
(Tcl_ObjInterface *)&tclScalarInterface
|
||||
};
|
||||
const Tcl_ObjType tclDoubleType= {
|
||||
|
||||
|
||||
MODULE_SCOPE const Tcl_ObjType *tclBooleanType = (Tcl_ObjType *)&tclBooleanObjType;
|
||||
|
||||
const ObjectType tclDoubleObjType= {
|
||||
"double", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
UpdateStringOfDouble, /* updateStringProc */
|
||||
SetDoubleFromAny, /* setFromAnyProc */
|
||||
TCL_OBJTYPE_V1(TclLengthOne)
|
||||
2,
|
||||
(Tcl_ObjInterface *)&tclScalarInterface
|
||||
};
|
||||
const Tcl_ObjType tclIntType = {
|
||||
|
||||
MODULE_SCOPE const Tcl_ObjType *tclDoubleType = (Tcl_ObjType *)&tclDoubleObjType;
|
||||
|
||||
const ObjectType tclIntObjType = {
|
||||
"int", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
UpdateStringOfInt, /* updateStringProc */
|
||||
SetIntFromAny, /* setFromAnyProc */
|
||||
TCL_OBJTYPE_V1(TclLengthOne)
|
||||
2,
|
||||
(Tcl_ObjInterface *)&tclScalarInterface
|
||||
};
|
||||
const Tcl_ObjType tclBignumType = {
|
||||
|
||||
MODULE_SCOPE const Tcl_ObjType *tclIntType = (Tcl_ObjType *)&tclIntObjType;
|
||||
|
||||
const ObjectType tclBignumObjType = {
|
||||
"bignum", /* name */
|
||||
FreeBignum, /* freeIntRepProc */
|
||||
DupBignum, /* dupIntRepProc */
|
||||
UpdateStringOfBignum, /* updateStringProc */
|
||||
NULL, /* setFromAnyProc */
|
||||
TCL_OBJTYPE_V1(TclLengthOne)
|
||||
2,
|
||||
(Tcl_ObjInterface *)&tclScalarInterface
|
||||
};
|
||||
|
||||
MODULE_SCOPE const Tcl_ObjType *tclBignumType = (Tcl_ObjType *)&tclBignumObjType;
|
||||
|
||||
/*
|
||||
* The structure below defines the Tcl obj hash key type.
|
||||
*/
|
||||
@@ -300,7 +351,7 @@ Tcl_ObjType tclCmdNameType = {
|
||||
DupCmdNameInternalRep, /* dupIntRepProc */
|
||||
NULL, /* updateStringProc */
|
||||
SetCmdNameFromAny, /* setFromAnyProc */
|
||||
TCL_OBJTYPE_V0
|
||||
0
|
||||
};
|
||||
|
||||
/*
|
||||
@@ -377,24 +428,15 @@ TclInitObjSubsystem(void)
|
||||
Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
|
||||
Tcl_MutexUnlock(&tableMutex);
|
||||
|
||||
Tcl_RegisterObjType(&tclDoubleType);
|
||||
Tcl_RegisterObjType(tclDoubleType);
|
||||
Tcl_RegisterObjType(&tclStringType);
|
||||
Tcl_RegisterObjType(&tclListType);
|
||||
Tcl_RegisterObjType(tclListType);
|
||||
Tcl_RegisterObjType(&tclDictType);
|
||||
Tcl_RegisterObjType(&tclByteCodeType);
|
||||
Tcl_RegisterObjType(&tclCmdNameType);
|
||||
Tcl_RegisterObjType(&tclRegexpType);
|
||||
Tcl_RegisterObjType(&tclProcBodyType);
|
||||
|
||||
/* For backward compatibility only ... */
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
Tcl_RegisterObjType(&tclIntType);
|
||||
#if !defined(TCL_WIDE_INT_IS_LONG)
|
||||
Tcl_RegisterObjType(&oldIntType);
|
||||
#endif
|
||||
Tcl_RegisterObjType(&oldBooleanType);
|
||||
#endif
|
||||
|
||||
#ifdef TCL_COMPILE_STATS
|
||||
Tcl_MutexLock(&tclObjMutex);
|
||||
tclObjsAlloced = 0;
|
||||
@@ -552,13 +594,13 @@ ContLineLoc *
|
||||
TclContinuationsEnter(
|
||||
Tcl_Obj *objPtr,
|
||||
Tcl_Size num,
|
||||
Tcl_Size *loc)
|
||||
int *loc)
|
||||
{
|
||||
int newEntry;
|
||||
ThreadSpecificData *tsdPtr = TclGetContLineTable();
|
||||
Tcl_HashEntry *hPtr =
|
||||
Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
|
||||
ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(Tcl_Size));
|
||||
ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(int));
|
||||
|
||||
if (!newEntry) {
|
||||
/*
|
||||
@@ -586,7 +628,7 @@ TclContinuationsEnter(
|
||||
}
|
||||
|
||||
clLocPtr->num = num;
|
||||
memcpy(&clLocPtr->loc, loc, num*sizeof(Tcl_Size));
|
||||
memcpy(&clLocPtr->loc, loc, num*sizeof(int));
|
||||
clLocPtr->loc[num] = CLL_END; /* Sentinel */
|
||||
Tcl_SetHashValue(hPtr, clLocPtr);
|
||||
|
||||
@@ -615,12 +657,12 @@ TclContinuationsEnter(
|
||||
void
|
||||
TclContinuationsEnterDerived(
|
||||
Tcl_Obj *objPtr,
|
||||
Tcl_Size start,
|
||||
Tcl_Size *clNext)
|
||||
int start,
|
||||
int *clNext)
|
||||
{
|
||||
Tcl_Size length;
|
||||
Tcl_Size end, num;
|
||||
Tcl_Size *wordCLLast = clNext;
|
||||
int end, num;
|
||||
int *wordCLLast = clNext;
|
||||
|
||||
/*
|
||||
* We have to handle invisible continuations lines here as well, despite
|
||||
@@ -663,7 +705,7 @@ TclContinuationsEnterDerived(
|
||||
|
||||
num = wordCLLast - clNext;
|
||||
if (num) {
|
||||
Tcl_Size i;
|
||||
int i;
|
||||
ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);
|
||||
|
||||
/*
|
||||
@@ -814,6 +856,25 @@ TclThreadFinalizeContLines(
|
||||
*--------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int TclObjTypeVersion (
|
||||
const Tcl_ObjType *typePtr)
|
||||
{
|
||||
ObjectType *otPtr = (ObjectType *)typePtr;
|
||||
if ((void *)otPtr->name == (void *)&TclObjectTypeType0) {
|
||||
return otPtr->version;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
const char *TclObjTypeName(
|
||||
const Tcl_ObjType *typePtr)
|
||||
{
|
||||
ObjectType *otPtr = (ObjectType *)typePtr;
|
||||
return otPtr->name;
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
Tcl_RegisterObjType(
|
||||
const Tcl_ObjType *typePtr) /* Information about object type; storage must
|
||||
@@ -823,8 +884,9 @@ Tcl_RegisterObjType(
|
||||
int isNew;
|
||||
|
||||
Tcl_MutexLock(&tableMutex);
|
||||
const char *name = TclObjTypeName(typePtr);
|
||||
Tcl_SetHashValue(
|
||||
Tcl_CreateHashEntry(&typeTable, typePtr->name, &isNew), typePtr);
|
||||
Tcl_CreateHashEntry(&typeTable, name, &isNew), typePtr);
|
||||
Tcl_MutexUnlock(&tableMutex);
|
||||
}
|
||||
|
||||
@@ -950,7 +1012,7 @@ Tcl_ConvertToType(
|
||||
}
|
||||
|
||||
/*
|
||||
* Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal form
|
||||
* Use the target type's setFromAnyProc to set "objPtr"s internal form
|
||||
* as appropriate for the target type. This frees the old internal
|
||||
* representation.
|
||||
*/
|
||||
@@ -1526,6 +1588,14 @@ TclObjBeingDeleted(
|
||||
* Create and return a new object that is a duplicate of the argument
|
||||
* object.
|
||||
*
|
||||
* TclDuplicatePureObj --
|
||||
* Like Tcl_DuplicateObj, except that it converts the duplicate to the
|
||||
* specifid typ, does not duplicate the 'bytes'
|
||||
* field unless it is necessary, i.e. the duplicated Tcl_Obj provides no
|
||||
* updateStringProc. This can avoid an expensive memory allocation since
|
||||
* the data in the 'bytes' field of each Tcl_Obj must reside in allocated
|
||||
* memory.
|
||||
*
|
||||
* Results:
|
||||
* The return value is a pointer to a newly created Tcl_Obj. This object
|
||||
* has reference count 0 and the same type, if any, as the source object
|
||||
@@ -1577,6 +1647,111 @@ Tcl_DuplicateObj(
|
||||
return dupPtr;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclDuplicatePureObj --
|
||||
*
|
||||
* Duplicates a Tcl_Obj and converts the internal representation of the
|
||||
* duplicate to the given type, changing neither the 'bytes' field
|
||||
* nor the internal representation of the original object, and without
|
||||
* duplicating the bytes field unless necessary, i.e. unless the
|
||||
* duplicate provides no updateStringProc after conversion. This can
|
||||
* avoid an expensive memory allocation since the data in the 'bytes'
|
||||
* field of each Tcl_Obj must reside in allocated memory.
|
||||
*
|
||||
* Results:
|
||||
* A pointer to a newly-created Tcl_Obj or NULL if there was an error.
|
||||
* This object has reference count 0. Also:
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
int SetDuplicatePureObj(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *dupPtr,
|
||||
Tcl_Obj *objPtr,
|
||||
const Tcl_ObjType *typePtr)
|
||||
{
|
||||
char *bytes = objPtr->bytes;
|
||||
int status = TCL_OK;
|
||||
|
||||
TclInvalidateStringRep(dupPtr);
|
||||
assert(dupPtr->typePtr == NULL);
|
||||
|
||||
if (objPtr->typePtr && objPtr->typePtr->dupIntRepProc) {
|
||||
objPtr->typePtr->dupIntRepProc(objPtr, dupPtr);
|
||||
} else {
|
||||
dupPtr->internalRep = objPtr->internalRep;
|
||||
dupPtr->typePtr = objPtr->typePtr;
|
||||
}
|
||||
|
||||
if (typePtr != NULL && dupPtr->typePtr != typePtr) {
|
||||
if (bytes) {
|
||||
dupPtr->bytes = bytes;
|
||||
dupPtr->length = objPtr->length;
|
||||
}
|
||||
/* borrow bytes from original object */
|
||||
status = Tcl_ConvertToType(interp, dupPtr, typePtr);
|
||||
if (bytes) {
|
||||
dupPtr->bytes = NULL;
|
||||
dupPtr->length = 0;
|
||||
}
|
||||
if (status != TCL_OK) {
|
||||
return status;
|
||||
}
|
||||
}
|
||||
|
||||
/* tclStringType is treated as a special case because a Tcl_Obj having this
|
||||
* type can not always update the string representation. This happens, for
|
||||
* example, when Tcl_GetCharLength() converts the internal representation
|
||||
* to tclStringType in order to store the number of characters, but does
|
||||
* not store enough information to generate the string representation.
|
||||
*
|
||||
* Perhaps in the future this can be remedied and this special treatment
|
||||
* removed.
|
||||
*/
|
||||
|
||||
|
||||
if (bytes && (dupPtr->typePtr == NULL
|
||||
|| dupPtr->typePtr->updateStringProc == NULL
|
||||
|| typePtr == &tclStringType
|
||||
)
|
||||
) {
|
||||
if (!TclAttemptInitStringRep(dupPtr, bytes, objPtr->length)) {
|
||||
if (interp) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"insufficient memory to initialize string", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
|
||||
}
|
||||
status = TCL_ERROR;
|
||||
}
|
||||
}
|
||||
return status;
|
||||
}
|
||||
|
||||
Tcl_Obj *
|
||||
TclDuplicatePureObj(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr,
|
||||
const Tcl_ObjType *typePtr
|
||||
) /* The object to duplicate. */
|
||||
{
|
||||
int status;
|
||||
Tcl_Obj *dupPtr;
|
||||
|
||||
TclNewObj(dupPtr);
|
||||
status = SetDuplicatePureObj(interp, dupPtr, objPtr, typePtr);
|
||||
if (status == TCL_OK) {
|
||||
return dupPtr;
|
||||
} else {
|
||||
Tcl_DecrRefCount(dupPtr);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
void
|
||||
TclSetDuplicateObj(
|
||||
Tcl_Obj *dupPtr,
|
||||
@@ -1668,52 +1843,7 @@ Tcl_GetString(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED)
|
||||
char *
|
||||
TclGetStringFromObj(
|
||||
Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
|
||||
* be returned. */
|
||||
void *lengthPtr) /* If non-NULL, the location where the string
|
||||
* rep's byte array length should * be stored.
|
||||
* If NULL, no length is stored. */
|
||||
{
|
||||
if (objPtr->bytes == NULL) {
|
||||
/*
|
||||
* Note we do not check for objPtr->typePtr == NULL. An invariant
|
||||
* of a properly maintained Tcl_Obj is that at least one of
|
||||
* objPtr->bytes and objPtr->typePtr must not be NULL. If broken
|
||||
* extensions fail to maintain that invariant, we can crash here.
|
||||
*/
|
||||
|
||||
if (objPtr->typePtr->updateStringProc == NULL) {
|
||||
/*
|
||||
* Those Tcl_ObjTypes which choose not to define an
|
||||
* updateStringProc must be written in such a way that
|
||||
* (objPtr->bytes) never becomes NULL.
|
||||
*/
|
||||
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
|
||||
objPtr->typePtr->name);
|
||||
}
|
||||
objPtr->typePtr->updateStringProc(objPtr);
|
||||
if (objPtr->bytes == NULL || objPtr->length == TCL_INDEX_NONE
|
||||
|| objPtr->bytes[objPtr->length] != '\0') {
|
||||
Tcl_Panic("UpdateStringProc for type '%s' "
|
||||
"failed to create a valid string rep",
|
||||
objPtr->typePtr->name);
|
||||
}
|
||||
}
|
||||
if (lengthPtr != NULL) {
|
||||
if (objPtr->length > INT_MAX) {
|
||||
Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr"
|
||||
" cannot handle such long strings. Please use 'Tcl_Size'");
|
||||
}
|
||||
*(int *)lengthPtr = (int)objPtr->length;
|
||||
}
|
||||
return objPtr->bytes;
|
||||
}
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
|
||||
#undef Tcl_GetStringFromObj
|
||||
char *
|
||||
Tcl_GetStringFromObj(
|
||||
Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
|
||||
@@ -2007,7 +2137,6 @@ Tcl_FreeInternalRep(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_GetBoolFromObj
|
||||
int
|
||||
Tcl_GetBoolFromObj(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
@@ -2030,11 +2159,11 @@ Tcl_GetBoolFromObj(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
do {
|
||||
if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
|
||||
if (objPtr->typePtr == tclIntType || objPtr->typePtr == tclBooleanType) {
|
||||
result = (objPtr->internalRep.wideValue != 0);
|
||||
goto boolEnd;
|
||||
}
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
if (objPtr->typePtr == tclDoubleType) {
|
||||
/*
|
||||
* Caution: Don't be tempted to check directly for the "double"
|
||||
* Tcl_ObjType and then compare the internalrep to 0.0. This isn't
|
||||
@@ -2051,7 +2180,7 @@ Tcl_GetBoolFromObj(
|
||||
result = (d != 0.0);
|
||||
goto boolEnd;
|
||||
}
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
if (objPtr->typePtr == tclBignumType) {
|
||||
result = 1;
|
||||
boolEnd:
|
||||
if (charPtr != NULL) {
|
||||
@@ -2077,7 +2206,6 @@ Tcl_GetBoolFromObj(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
#undef Tcl_GetBooleanFromObj
|
||||
int
|
||||
Tcl_GetBooleanFromObj(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
@@ -2119,18 +2247,18 @@ TclSetBooleanFromAny(
|
||||
*/
|
||||
|
||||
if (objPtr->bytes == NULL) {
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
if (objPtr->typePtr == tclIntType) {
|
||||
if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
|
||||
return TCL_OK;
|
||||
}
|
||||
goto badBoolean;
|
||||
}
|
||||
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
if (objPtr->typePtr == tclBignumType) {
|
||||
goto badBoolean;
|
||||
}
|
||||
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
if (objPtr->typePtr == tclDoubleType) {
|
||||
goto badBoolean;
|
||||
}
|
||||
}
|
||||
@@ -2261,13 +2389,13 @@ ParseBoolean(
|
||||
goodBoolean:
|
||||
TclFreeInternalRep(objPtr);
|
||||
objPtr->internalRep.wideValue = newBool;
|
||||
objPtr->typePtr = &tclBooleanType;
|
||||
objPtr->typePtr = tclBooleanType;
|
||||
return TCL_OK;
|
||||
|
||||
numericBoolean:
|
||||
TclFreeInternalRep(objPtr);
|
||||
objPtr->internalRep.wideValue = newBool;
|
||||
objPtr->typePtr = &tclIntType;
|
||||
objPtr->typePtr = tclIntType;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2359,7 +2487,7 @@ Tcl_DbNewDoubleObj(
|
||||
objPtr->bytes = NULL;
|
||||
|
||||
objPtr->internalRep.doubleValue = dblValue;
|
||||
objPtr->typePtr = &tclDoubleType;
|
||||
objPtr->typePtr = tclDoubleType;
|
||||
return objPtr;
|
||||
}
|
||||
|
||||
@@ -2432,7 +2560,7 @@ Tcl_GetDoubleFromObj(
|
||||
double *dblPtr) /* Place to store resulting double. */
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
if (objPtr->typePtr == tclDoubleType) {
|
||||
if (isnan(objPtr->internalRep.doubleValue)) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
@@ -2445,11 +2573,11 @@ Tcl_GetDoubleFromObj(
|
||||
*dblPtr = (double) objPtr->internalRep.doubleValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
if (objPtr->typePtr == tclIntType) {
|
||||
*dblPtr = (double) objPtr->internalRep.wideValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
if (objPtr->typePtr == tclBignumType) {
|
||||
mp_int big;
|
||||
|
||||
TclUnpackBignum(objPtr, big);
|
||||
@@ -2577,6 +2705,17 @@ Tcl_GetIntFromObj(
|
||||
return TCL_OK;
|
||||
#endif
|
||||
}
|
||||
|
||||
int
|
||||
ScalarObjInterfaceListLength(
|
||||
TCL_UNUSED(Tcl_Interp *), /* Used to report errors if not NULL. */ \
|
||||
TCL_UNUSED(Tcl_Obj *), /* List object whose #elements to return. */ \
|
||||
Tcl_Size *lenPtr /* The resulting length is stored here. */
|
||||
)
|
||||
{
|
||||
*lenPtr = 1;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
@@ -2663,12 +2802,12 @@ Tcl_GetLongFromObj(
|
||||
{
|
||||
do {
|
||||
#ifdef TCL_WIDE_INT_IS_LONG
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
if (objPtr->typePtr == tclIntType) {
|
||||
*longPtr = objPtr->internalRep.wideValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
#else
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
if (objPtr->typePtr == tclIntType) {
|
||||
/*
|
||||
* We return any integer in the range LONG_MIN to ULONG_MAX
|
||||
* converted to a long, ignoring overflow. The rule preserves
|
||||
@@ -2687,7 +2826,7 @@ Tcl_GetLongFromObj(
|
||||
goto tooLarge;
|
||||
}
|
||||
#endif
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
if (objPtr->typePtr == tclDoubleType) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"expected integer but got \"%s\"",
|
||||
@@ -2696,7 +2835,7 @@ Tcl_GetLongFromObj(
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
if (objPtr->typePtr == tclBignumType) {
|
||||
/*
|
||||
* Must check for those bignum values that can fit in a long, even
|
||||
* when auto-narrowing is enabled. Only those values in the signed
|
||||
@@ -2924,11 +3063,11 @@ Tcl_GetWideIntFromObj(
|
||||
/* Place to store resulting long. */
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
if (objPtr->typePtr == tclIntType) {
|
||||
*wideIntPtr = objPtr->internalRep.wideValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
if (objPtr->typePtr == tclDoubleType) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"expected integer but got \"%s\"",
|
||||
@@ -2937,7 +3076,7 @@ Tcl_GetWideIntFromObj(
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
if (objPtr->typePtr == tclBignumType) {
|
||||
/*
|
||||
* Must check for those bignum values that can fit in a
|
||||
* Tcl_WideInt, even when auto-narrowing is enabled.
|
||||
@@ -3009,7 +3148,7 @@ Tcl_GetWideUIntFromObj(
|
||||
/* Place to store resulting long. */
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
if (objPtr->typePtr == tclIntType) {
|
||||
if (objPtr->internalRep.wideValue < 0) {
|
||||
wideUIntOutOfRange:
|
||||
if (interp != NULL) {
|
||||
@@ -3023,10 +3162,10 @@ Tcl_GetWideUIntFromObj(
|
||||
*wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
if (objPtr->typePtr == tclDoubleType) {
|
||||
goto wideUIntOutOfRange;
|
||||
}
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
if (objPtr->typePtr == tclBignumType) {
|
||||
/*
|
||||
* Must check for those bignum values that can fit in a
|
||||
* Tcl_WideUInt, even when auto-narrowing is enabled.
|
||||
@@ -3093,11 +3232,11 @@ TclGetWideBitsFromObj(
|
||||
Tcl_WideInt *wideIntPtr) /* Place to store resulting wide integer. */
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
if (objPtr->typePtr == tclIntType) {
|
||||
*wideIntPtr = objPtr->internalRep.wideValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
if (objPtr->typePtr == tclDoubleType) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"expected integer but got \"%s\"",
|
||||
@@ -3106,7 +3245,7 @@ TclGetWideBitsFromObj(
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
if (objPtr->typePtr == tclBignumType) {
|
||||
mp_int big;
|
||||
mp_err err;
|
||||
|
||||
@@ -3210,7 +3349,7 @@ DupBignum(
|
||||
mp_int bignumVal;
|
||||
mp_int bignumCopy;
|
||||
|
||||
copyPtr->typePtr = &tclBignumType;
|
||||
copyPtr->typePtr = tclBignumType;
|
||||
TclUnpackBignum(srcPtr, bignumVal);
|
||||
if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
|
||||
Tcl_Panic("initialization failure in DupBignum");
|
||||
@@ -3380,7 +3519,7 @@ GetBignumFromObj(
|
||||
mp_int *bignumValue) /* Returned bignum value. */
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
if (objPtr->typePtr == tclBignumType) {
|
||||
if (copy || Tcl_IsShared(objPtr)) {
|
||||
mp_int temp;
|
||||
|
||||
@@ -3405,14 +3544,14 @@ GetBignumFromObj(
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
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 (objPtr->typePtr == tclDoubleType) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"expected integer but got \"%s\"",
|
||||
@@ -3572,7 +3711,7 @@ TclSetBignumInternalRep(
|
||||
void *big)
|
||||
{
|
||||
mp_int *bignumValue = (mp_int *)big;
|
||||
objPtr->typePtr = &tclBignumType;
|
||||
objPtr->typePtr = tclBignumType;
|
||||
PACK_BIGNUM(*bignumValue, objPtr);
|
||||
|
||||
/*
|
||||
@@ -3595,14 +3734,13 @@ TclSetBignumInternalRep(
|
||||
* Extracts a number (of any possible numeric type) from an object.
|
||||
*
|
||||
* Results:
|
||||
* Whether the extraction worked. The type is stored in the variable
|
||||
* referred to by the typePtr argument, and a pointer to the
|
||||
* representation is stored in the variable referred to by the
|
||||
* clientDataPtr.
|
||||
* A standard Tcl completion code. On success, the type is stored at the
|
||||
* address given by typePtr, and a pointer to the representation is stored
|
||||
* at the address given by clientDataPtr.
|
||||
*
|
||||
* Side effects:
|
||||
* Can allocate thread-specific data for handling the copy-out space for
|
||||
* bignums; this space is shared within a thread.
|
||||
* May allocate thread-specific data shared within a thread for handling
|
||||
* the copy-out space for bignums.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -3615,7 +3753,7 @@ Tcl_GetNumberFromObj(
|
||||
int *typePtr)
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
if (objPtr->typePtr == tclDoubleType) {
|
||||
if (isnan(objPtr->internalRep.doubleValue)) {
|
||||
*typePtr = TCL_NUMBER_NAN;
|
||||
} else {
|
||||
@@ -3624,12 +3762,12 @@ Tcl_GetNumberFromObj(
|
||||
*clientDataPtr = &objPtr->internalRep.doubleValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
if (objPtr->typePtr == tclIntType) {
|
||||
*typePtr = TCL_NUMBER_INT;
|
||||
*clientDataPtr = &objPtr->internalRep.wideValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
if (objPtr->typePtr == tclBignumType) {
|
||||
static Tcl_ThreadDataKey bignumKey;
|
||||
mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
|
||||
sizeof(mp_int));
|
||||
@@ -3680,6 +3818,29 @@ Tcl_GetNumber(
|
||||
return Tcl_GetNumberFromObj(interp, objPtr, clientDataPtr, typePtr);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclBounceRefCount --
|
||||
*
|
||||
* Performs the equivante of incrementing and then decrementing the
|
||||
* reference count.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
void
|
||||
TclBounceRefCount(
|
||||
Tcl_Obj *objPtr) /* The object we are registering a reference to. */
|
||||
{
|
||||
if (objPtr->refCount < 1) {
|
||||
TclFreeObj(objPtr);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -4472,6 +4633,37 @@ DupCmdNameInternalRep(
|
||||
resPtr->refCount++;
|
||||
copyPtr->typePtr = &tclCmdNameType;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
ScalarObjIndex(
|
||||
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj *listPtr, /* List object to index into. */ \
|
||||
Tcl_Size index, /* Index of element to return. */ \
|
||||
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
|
||||
) {
|
||||
if (index == 0) {
|
||||
*objPtrPtr = listPtr;
|
||||
} else {
|
||||
*objPtrPtr = NULL;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static Tcl_Obj* ScalarObjRange(
|
||||
TCL_UNUSED(Tcl_Interp *),/* Used to report errors */ \
|
||||
Tcl_Obj *listObj, /* List object to take a range from. */ \
|
||||
Tcl_Size rangeStart, /* Index of first element to */ \
|
||||
/* include. */ \
|
||||
Tcl_Size rangeEnd /* Index of last element to include. */
|
||||
)
|
||||
{
|
||||
if (rangeEnd >= 0 && rangeEnd >= rangeStart) {
|
||||
return listObj;
|
||||
} else {
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -4584,13 +4776,14 @@ Tcl_RepresentationCmd(
|
||||
* "1872361827361287"
|
||||
*/
|
||||
|
||||
const char *name = objv[1]->typePtr ? TclObjTypeName(objv[1]->typePtr) : "pure string";
|
||||
descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u,"
|
||||
" object pointer at %p",
|
||||
objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
|
||||
name,
|
||||
objv[1]->refCount, objv[1]);
|
||||
|
||||
if (objv[1]->typePtr) {
|
||||
if (objv[1]->typePtr == &tclDoubleType) {
|
||||
if (objv[1]->typePtr == tclDoubleType) {
|
||||
Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
|
||||
objv[1]->internalRep.doubleValue);
|
||||
} else {
|
||||
@@ -4612,6 +4805,32 @@ Tcl_RepresentationCmd(
|
||||
Tcl_SetObjResult(interp, descObj);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
void Tcl_ObjTypeVersion(Tcl_Obj *objPtr, int *version) {
|
||||
if ((void *)objPtr->typePtr->name == (void *)&TclObjectTypeType0) {
|
||||
*version = ((ObjectType *)objPtr->typePtr)->version;
|
||||
} else {
|
||||
*version = 1;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
TclObjectTypeType * TclGetObjectTypeType () {
|
||||
return &TclObjectTypeType0;
|
||||
}
|
||||
|
||||
|
||||
int (*TclObjInterfaceGetListIndex (Tcl_Obj *objPtr))
|
||||
(tclObjTypeInterfaceArgsListIndex)
|
||||
{
|
||||
ObjInterface *interface = (ObjInterface *)((ObjectType *)objPtr->typePtr)->interface;
|
||||
if (interface->version >= 1) {
|
||||
return interface->list.index;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
|
||||
+14
-31
@@ -871,18 +871,6 @@ TclParseBackslash(
|
||||
* No hexdigits -> This is just "u".
|
||||
*/
|
||||
result = 'u';
|
||||
#if TCL_UTF_MAX < 4
|
||||
} else if (((result & 0xFC00) == 0xD800) && (count == 6)
|
||||
&& (p[5] == '\\') && (p[6] == 'u') && (numBytes >= 10)) {
|
||||
/* If high surrogate is immediately followed by a low surrogate
|
||||
* escape, combine them into one character. */
|
||||
int low;
|
||||
int count2 = ParseHex(p+7, 4, &low);
|
||||
if ((count2 == 4) && ((low & 0xFC00) == 0xDC00)) {
|
||||
result = ((result & 0x3FF)<<10 | (low & 0x3FF)) + 0x10000;
|
||||
count += count2 + 2;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
break;
|
||||
case 'U':
|
||||
@@ -938,13 +926,13 @@ TclParseBackslash(
|
||||
*/
|
||||
|
||||
if (Tcl_UtfCharComplete(p, numBytes - 1)) {
|
||||
count = TclUtfToUCS4(p, &unichar) + 1; /* +1 for '\' */
|
||||
count = Tcl_UtfToUniChar(p, &unichar) + 1; /* +1 for '\' */
|
||||
} else {
|
||||
char utfBytes[8];
|
||||
|
||||
memcpy(utfBytes, p, numBytes - 1);
|
||||
utfBytes[numBytes - 1] = '\0';
|
||||
count = TclUtfToUCS4(utfBytes, &unichar) + 1;
|
||||
count = Tcl_UtfToUniChar(utfBytes, &unichar) + 1;
|
||||
}
|
||||
result = unichar;
|
||||
break;
|
||||
@@ -955,12 +943,6 @@ TclParseBackslash(
|
||||
*readPtr = count;
|
||||
}
|
||||
count = Tcl_UniCharToUtf(result, dst);
|
||||
#if TCL_UTF_MAX < 4
|
||||
if ((result >= 0xD800) && (count < 3)) {
|
||||
/* Special case for handling high surrogates. */
|
||||
count += Tcl_UniCharToUtf(-1, dst + count);
|
||||
}
|
||||
#endif
|
||||
return count;
|
||||
}
|
||||
|
||||
@@ -1072,7 +1054,7 @@ ParseTokens(
|
||||
* termination information. */
|
||||
{
|
||||
char type;
|
||||
Tcl_Size originalTokens;
|
||||
int originalTokens;
|
||||
int noSubstCmds = !(flags & TCL_SUBST_COMMANDS);
|
||||
int noSubstVars = !(flags & TCL_SUBST_VARIABLES);
|
||||
int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES);
|
||||
@@ -1106,7 +1088,7 @@ ParseTokens(
|
||||
tokenPtr->size = src - tokenPtr->start;
|
||||
parsePtr->numTokens++;
|
||||
} else if (*src == '$') {
|
||||
Tcl_Size varToken;
|
||||
int varToken;
|
||||
|
||||
if (noSubstVars) {
|
||||
tokenPtr->type = TCL_TOKEN_TEXT;
|
||||
@@ -1233,7 +1215,7 @@ ParseTokens(
|
||||
*/
|
||||
|
||||
if (mask & TYPE_SPACE) {
|
||||
if (parsePtr->numTokens == originalTokens) {
|
||||
if ((int)parsePtr->numTokens == originalTokens) {
|
||||
goto finishToken;
|
||||
}
|
||||
break;
|
||||
@@ -1254,7 +1236,7 @@ ParseTokens(
|
||||
Tcl_Panic("ParseTokens encountered unknown character");
|
||||
}
|
||||
}
|
||||
if (parsePtr->numTokens == originalTokens) {
|
||||
if ((int)parsePtr->numTokens == originalTokens) {
|
||||
/*
|
||||
* There was nothing in this range of text. Add an empty token for the
|
||||
* empty range, so that there is always at least one token added.
|
||||
@@ -1651,7 +1633,8 @@ Tcl_ParseBraces(
|
||||
{
|
||||
Tcl_Token *tokenPtr;
|
||||
const char *src;
|
||||
Tcl_Size length, startIndex, level;
|
||||
int startIndex, level;
|
||||
Tcl_Size length;
|
||||
|
||||
if (numBytes < 0 && start) {
|
||||
numBytes = strlen(start);
|
||||
@@ -1702,7 +1685,7 @@ Tcl_ParseBraces(
|
||||
*/
|
||||
|
||||
if ((src != tokenPtr->start)
|
||||
|| (parsePtr->numTokens == startIndex)) {
|
||||
|| ((int)parsePtr->numTokens == startIndex)) {
|
||||
tokenPtr->size = (src - tokenPtr->start);
|
||||
parsePtr->numTokens++;
|
||||
}
|
||||
@@ -2121,7 +2104,7 @@ TclSubstTokens(
|
||||
* integer representing the number of tokens
|
||||
* left to be substituted will be written */
|
||||
Tcl_Size line, /* The line the script starts on. */
|
||||
Tcl_Size *clNextOuter, /* Information about an outer context for */
|
||||
int *clNextOuter, /* Information about an outer context for */
|
||||
const char *outerScript) /* continuation line data. This is set by
|
||||
* EvalEx() to properly handle [...]-nested
|
||||
* commands. The 'outerScript' refers to the
|
||||
@@ -2144,7 +2127,7 @@ TclSubstTokens(
|
||||
#define NUM_STATIC_POS 20
|
||||
int isLiteral;
|
||||
Tcl_Size i, maxNumCL, numCL, adjust;
|
||||
Tcl_Size *clPosition = NULL;
|
||||
int *clPosition = NULL;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
|
||||
|
||||
@@ -2179,7 +2162,7 @@ TclSubstTokens(
|
||||
|
||||
if (isLiteral) {
|
||||
maxNumCL = NUM_STATIC_POS;
|
||||
clPosition = (Tcl_Size *)Tcl_Alloc(maxNumCL * sizeof(Tcl_Size));
|
||||
clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
|
||||
}
|
||||
|
||||
adjust = 0;
|
||||
@@ -2229,8 +2212,8 @@ TclSubstTokens(
|
||||
|
||||
if (numCL >= maxNumCL) {
|
||||
maxNumCL *= 2;
|
||||
clPosition = (Tcl_Size *)Tcl_Realloc(clPosition,
|
||||
maxNumCL * sizeof(Tcl_Size));
|
||||
clPosition = (int *)Tcl_Realloc(clPosition,
|
||||
maxNumCL * sizeof(int));
|
||||
}
|
||||
clPosition[numCL] = clPos;
|
||||
numCL++;
|
||||
|
||||
+1
-90
@@ -48,93 +48,6 @@
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Exported function declarations:
|
||||
*/
|
||||
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
/* 0 */
|
||||
EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len,
|
||||
Tcl_DString *dsPtr);
|
||||
/* 1 */
|
||||
EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len,
|
||||
Tcl_DString *dsPtr);
|
||||
/* Slot 2 is reserved */
|
||||
/* 3 */
|
||||
EXTERN void Tcl_WinConvertError(unsigned errCode);
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
/* 0 */
|
||||
EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
|
||||
const char *bundleName, int hasResourceFile,
|
||||
Tcl_Size maxPathLen, char *libraryPath);
|
||||
/* 1 */
|
||||
EXTERN int Tcl_MacOSXOpenVersionedBundleResources(
|
||||
Tcl_Interp *interp, const char *bundleName,
|
||||
const char *bundleVersion,
|
||||
int hasResourceFile, Tcl_Size maxPathLen,
|
||||
char *libraryPath);
|
||||
/* 2 */
|
||||
EXTERN void Tcl_MacOSXNotifierAddRunLoopMode(
|
||||
const void *runLoopMode);
|
||||
#endif /* MACOSX */
|
||||
|
||||
typedef struct TclPlatStubs {
|
||||
int magic;
|
||||
void *hooks;
|
||||
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
|
||||
char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
|
||||
void (*reserved2)(void);
|
||||
void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath); /* 0 */
|
||||
int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath); /* 1 */
|
||||
void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
|
||||
#endif /* MACOSX */
|
||||
} TclPlatStubs;
|
||||
|
||||
extern const TclPlatStubs *tclPlatStubsPtr;
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#if defined(USE_TCL_STUBS)
|
||||
|
||||
/*
|
||||
* Inline function declarations:
|
||||
*/
|
||||
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
#define Tcl_WinUtfToTChar \
|
||||
(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
|
||||
#define Tcl_WinTCharToUtf \
|
||||
(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
|
||||
/* Slot 2 is reserved */
|
||||
#define Tcl_WinConvertError \
|
||||
(tclPlatStubsPtr->tcl_WinConvertError) /* 3 */
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
#define Tcl_MacOSXOpenBundleResources \
|
||||
(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
|
||||
#define Tcl_MacOSXOpenVersionedBundleResources \
|
||||
(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
|
||||
#define Tcl_MacOSXNotifierAddRunLoopMode \
|
||||
(tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */
|
||||
#endif /* MACOSX */
|
||||
|
||||
#endif /* defined(USE_TCL_STUBS) */
|
||||
|
||||
#else /* TCL_MAJOR_VERSION > 8 */
|
||||
|
||||
/* !BEGIN!: Do not edit below this line. */
|
||||
|
||||
@@ -193,7 +106,6 @@ extern const TclPlatStubs *tclPlatStubsPtr;
|
||||
|
||||
/* !END!: Do not edit above this line. */
|
||||
|
||||
#endif /* TCL_MAJOR_VERSION */
|
||||
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
#undef Tcl_MacOSXOpenBundleResources
|
||||
@@ -213,8 +125,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
|
||||
# undef Tcl_MacOSXNotifierAddRunLoopMode
|
||||
#endif
|
||||
|
||||
#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))\
|
||||
&& (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8)
|
||||
#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))
|
||||
#undef Tcl_WinUtfToTChar
|
||||
#undef Tcl_WinTCharToUtf
|
||||
#ifdef _WIN32
|
||||
|
||||
+8
-8
@@ -268,7 +268,7 @@ Tcl_ProcObjCmd(
|
||||
|
||||
cfPtr->level = -1;
|
||||
cfPtr->type = contextPtr->type;
|
||||
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
|
||||
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
|
||||
cfPtr->line[0] = contextPtr->line[3];
|
||||
cfPtr->nline = 1;
|
||||
cfPtr->framePtr = NULL;
|
||||
@@ -495,8 +495,8 @@ TclCreateProc(
|
||||
if (precompiled) {
|
||||
if (numArgs > procPtr->numArgs) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"procedure \"%s\": arg list contains %" TCL_SIZE_MODIFIER "u entries, "
|
||||
"precompiled header expects %" TCL_SIZE_MODIFIER "u", procName, numArgs,
|
||||
"procedure \"%s\": arg list contains %" TCL_Z_MODIFIER "u entries, "
|
||||
"precompiled header expects %" TCL_Z_MODIFIER "u", procName, numArgs,
|
||||
procPtr->numArgs));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
|
||||
"BYTECODELIES", NULL);
|
||||
@@ -590,7 +590,7 @@ TclCreateProc(
|
||||
|| (localPtr->defValuePtr == NULL && fieldCount == 2)
|
||||
|| (localPtr->defValuePtr != NULL && fieldCount != 2)) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"procedure \"%s\": formal parameter %" TCL_SIZE_MODIFIER "u is "
|
||||
"procedure \"%s\": formal parameter %" TCL_Z_MODIFIER "u is "
|
||||
"inconsistent with precompiled body", procName, i));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
|
||||
"BYTECODELIES", NULL);
|
||||
@@ -1067,7 +1067,7 @@ ProcWrongNumArgs(
|
||||
{
|
||||
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
|
||||
Proc *procPtr = framePtr->procPtr;
|
||||
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, i;
|
||||
int localCt = procPtr->numCompiledLocals, numArgs, i;
|
||||
Tcl_Obj **desiredObjs;
|
||||
const char *final = NULL;
|
||||
|
||||
@@ -1348,7 +1348,7 @@ InitArgsAndLocals(
|
||||
Proc *procPtr = framePtr->procPtr;
|
||||
ByteCode *codePtr;
|
||||
Var *varPtr, *defPtr;
|
||||
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
|
||||
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
|
||||
Tcl_Obj *const *argObjs;
|
||||
|
||||
ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
|
||||
@@ -2547,7 +2547,7 @@ SetLambdaFromAny(
|
||||
|
||||
if (contextPtr->line
|
||||
&& (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
|
||||
Tcl_Size buf[2];
|
||||
int buf[2];
|
||||
|
||||
/*
|
||||
* Move from approximation (line of list cmd word) to actual
|
||||
@@ -2559,7 +2559,7 @@ SetLambdaFromAny(
|
||||
|
||||
cfPtr->level = -1;
|
||||
cfPtr->type = contextPtr->type;
|
||||
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
|
||||
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
|
||||
cfPtr->line[0] = buf[1];
|
||||
cfPtr->nline = 1;
|
||||
cfPtr->framePtr = NULL;
|
||||
|
||||
+2
-2
@@ -903,7 +903,7 @@ Tcl_ScanObjCmd(
|
||||
* Scan a single Unicode character.
|
||||
*/
|
||||
|
||||
offset = TclUtfToUCS4(string, &i);
|
||||
offset = Tcl_UtfToUniChar(string, &i);
|
||||
string += offset;
|
||||
if (!(flags & SCAN_SUPPRESS)) {
|
||||
TclNewIntObj(objPtr, i);
|
||||
@@ -1046,7 +1046,7 @@ Tcl_ScanObjCmd(
|
||||
if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
|
||||
#ifdef ACCEPT_NAN
|
||||
const Tcl_ObjInternalRep *irPtr
|
||||
= TclFetchInternalRep(objPtr, &tclDoubleType);
|
||||
= TclFetchInternalRep(objPtr, tclDoubleType);
|
||||
if (irPtr) {
|
||||
dvalue = irPtr->doubleValue;
|
||||
} else
|
||||
|
||||
+6
-6
@@ -555,7 +555,7 @@ TclParseNumber(
|
||||
/* A dict can never be a (single) number */
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (TclHasInternalRep(objPtr, &tclListType)) {
|
||||
if (TclHasInternalRep(objPtr, tclListType)) {
|
||||
Tcl_Size length;
|
||||
/* A list can only be a (single) number if its length == 1 */
|
||||
TclListObjLengthM(NULL, objPtr, &length);
|
||||
@@ -1378,7 +1378,7 @@ TclParseNumber(
|
||||
octalSignificandWide);
|
||||
octalSignificandOverflow = 1;
|
||||
} else {
|
||||
objPtr->typePtr = &tclIntType;
|
||||
objPtr->typePtr = tclIntType;
|
||||
if (signum) {
|
||||
objPtr->internalRep.wideValue =
|
||||
(Tcl_WideInt)(-octalSignificandWide);
|
||||
@@ -1414,7 +1414,7 @@ TclParseNumber(
|
||||
significandWide);
|
||||
significandOverflow = 1;
|
||||
} else {
|
||||
objPtr->typePtr = &tclIntType;
|
||||
objPtr->typePtr = tclIntType;
|
||||
if (signum) {
|
||||
objPtr->internalRep.wideValue =
|
||||
(Tcl_WideInt)(-significandWide);
|
||||
@@ -1446,7 +1446,7 @@ TclParseNumber(
|
||||
* k = numTrailZeros+exponent-numDigitsAfterDp.
|
||||
*/
|
||||
|
||||
objPtr->typePtr = &tclDoubleType;
|
||||
objPtr->typePtr = tclDoubleType;
|
||||
if (exponentSignum) {
|
||||
/*
|
||||
* At this point exponent>=0, so the following calculation
|
||||
@@ -1497,14 +1497,14 @@ TclParseNumber(
|
||||
} else {
|
||||
objPtr->internalRep.doubleValue = HUGE_VAL;
|
||||
}
|
||||
objPtr->typePtr = &tclDoubleType;
|
||||
objPtr->typePtr = tclDoubleType;
|
||||
break;
|
||||
|
||||
#ifdef IEEE_FLOATING_POINT
|
||||
case sNAN:
|
||||
case sNANFINISH:
|
||||
objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
|
||||
objPtr->typePtr = &tclDoubleType;
|
||||
objPtr->typePtr = tclDoubleType;
|
||||
break;
|
||||
#endif
|
||||
case INITIAL:
|
||||
|
||||
@@ -1,602 +0,0 @@
|
||||
/*
|
||||
* tclStringList.c --
|
||||
*
|
||||
* This file contains the StringList concrete abstract list
|
||||
* implementation. It implements a view of a string as a list of
|
||||
* of characters.
|
||||
*
|
||||
* Copyright © 2023 Ashok P. Nadkarni
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include "tcl.h"
|
||||
#include "tclInt.h"
|
||||
#include <assert.h>
|
||||
#include <math.h>
|
||||
|
||||
/*
|
||||
* The structure below defines the StringList Tcl_ObjType. Implementation
|
||||
* stores the target Tcl_Obj being split in the internal representation of the
|
||||
* abstract list Tcl_Obj. List operations are then mapped to the corresponding
|
||||
* string operations. This makes per character processing of the form
|
||||
* foreach ch [split $str ""] {...}
|
||||
* less expensive for large strings.
|
||||
*
|
||||
* The source string is stored in the internalRep.twpPtrValue.ptr1 field.
|
||||
* The ptr2 field holds a StringListInfo struct with ancillary information
|
||||
* as below. If ptr2 is NULL, list covers all elements of source string.
|
||||
*/
|
||||
typedef struct StringListInfo {
|
||||
Tcl_Size startIndex; /* Starting index in source string where this list
|
||||
begins. Used for fast range operations */
|
||||
Tcl_Size count; /* Number of elements in list. If negative, count
|
||||
is entire source string */
|
||||
int flags;
|
||||
#define STRINGLIST_REVERSE 0x01 /* If set, reverse element order */
|
||||
} StringListInfo;
|
||||
|
||||
/* -------------------------- StringList object ---------------------------- */
|
||||
|
||||
static int StringListObjIndex(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *arithSeriesObj,
|
||||
Tcl_Size index, Tcl_Obj **elemObj);
|
||||
|
||||
static Tcl_Size StringListObjLength(Tcl_Obj *strListObj);
|
||||
static int StringListObjRange(Tcl_Interp *interp, Tcl_Obj *strListObj,
|
||||
Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
|
||||
static int StringListObjReverse(Tcl_Interp *interp, Tcl_Obj *strListObj, Tcl_Obj **newObjPtr);
|
||||
static void DupStringListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
|
||||
static void FreeStringListInternalRep(Tcl_Obj *strListObj);
|
||||
static void UpdateStringOfStringList(Tcl_Obj *strListObj);
|
||||
|
||||
static const Tcl_ObjType stringListType = {
|
||||
"stringlist", /* name */
|
||||
FreeStringListInternalRep, /* freeIntRepProc */
|
||||
DupStringListInternalRep, /* dupIntRepProc */
|
||||
UpdateStringOfStringList, /* updateStringProc */
|
||||
NULL, /* setFromAnyProc */
|
||||
TCL_OBJTYPE_V2(
|
||||
StringListObjLength,
|
||||
StringListObjIndex,
|
||||
StringListObjRange,
|
||||
StringListObjReverse,
|
||||
NULL, /* GetElements */
|
||||
NULL, /* SetElement */
|
||||
NULL, /* Replace */
|
||||
NULL) /* "in" operator */
|
||||
};
|
||||
|
||||
/* Returns the source for a StringList, NULL if objPtr is not a StringList */
|
||||
static inline Tcl_Obj *
|
||||
StringListGetSourceObj(Tcl_Obj *objPtr)
|
||||
{
|
||||
const Tcl_ObjInternalRep *irPtr;
|
||||
irPtr = TclFetchInternalRep((objPtr), &stringListType);
|
||||
return irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Returns the ancillary information about a StringList. May return an
|
||||
* NULL either because objPtr is not a StringList or because it has no
|
||||
* ancillary information. Use StringListGetSourceObj to distinguish.
|
||||
*/
|
||||
static inline StringListInfo *
|
||||
StringListGetInfo(Tcl_Obj *objPtr)
|
||||
{
|
||||
const Tcl_ObjInternalRep *irPtr;
|
||||
irPtr = TclFetchInternalRep((objPtr), &stringListType);
|
||||
return irPtr ? (StringListInfo *)irPtr->twoPtrValue.ptr2 : NULL;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* DupStringListInternalRep --
|
||||
*
|
||||
* Initialize the internal representation of a StringList Tcl_Obj to a
|
||||
* copy of the internal representation of an existing one.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* We set "copyPtr"s internal rep to a newly allocated structure.
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
DupStringListInternalRep(
|
||||
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
|
||||
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
|
||||
{
|
||||
/* Copy the source string and hold a reference */
|
||||
Tcl_Obj *srcStringObj = StringListGetSourceObj(srcPtr);
|
||||
copyPtr->internalRep.twoPtrValue.ptr1 = srcStringObj;
|
||||
Tcl_IncrRefCount(srcStringObj);
|
||||
|
||||
/* Copy the ancillary information if there is any. */
|
||||
StringListInfo *srcInfoPtr = StringListGetInfo(srcPtr);
|
||||
if (srcInfoPtr) {
|
||||
StringListInfo *copyInfoPtr;
|
||||
copyInfoPtr = (StringListInfo *)Tcl_Alloc(sizeof(*copyInfoPtr));
|
||||
*copyInfoPtr = *srcInfoPtr;
|
||||
copyPtr->internalRep.twoPtrValue.ptr2 = copyInfoPtr;
|
||||
} else {
|
||||
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
|
||||
}
|
||||
copyPtr->typePtr = &stringListType;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* FreeStringListInternalRep --
|
||||
*
|
||||
* Free any allocated memory in the StringList Rep
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
static void
|
||||
FreeStringListInternalRep(Tcl_Obj *strListObj)
|
||||
{
|
||||
Tcl_Obj *srcStringObj = StringListGetSourceObj(strListObj);
|
||||
assert(srcStringObj);
|
||||
if (srcStringObj) {
|
||||
Tcl_DecrRefCount(srcStringObj);
|
||||
}
|
||||
StringListInfo *infoPtr = StringListGetInfo(strListObj);
|
||||
if (infoPtr) {
|
||||
Tcl_Free(infoPtr);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclNewStringListObj --
|
||||
*
|
||||
* Creates a new StringList object formed by splitting the source string
|
||||
* object.
|
||||
*
|
||||
* Results:
|
||||
*
|
||||
* A Tcl_Obj pointer to the created StringList object with ref count 0.
|
||||
*
|
||||
* Side Effects:
|
||||
*
|
||||
* None.
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_Obj *
|
||||
TclNewStringListObj(
|
||||
TCL_UNUSED(Tcl_Interp *),
|
||||
Tcl_Obj *srcStringObj) /* String to split */
|
||||
{
|
||||
Tcl_Obj *objPtr = Tcl_NewObj();
|
||||
Tcl_InvalidateStringRep(objPtr);
|
||||
objPtr->internalRep.twoPtrValue.ptr1 = srcStringObj;
|
||||
Tcl_IncrRefCount(srcStringObj);
|
||||
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
|
||||
objPtr->typePtr = &stringListType;
|
||||
return objPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* StringListGetExtent
|
||||
*
|
||||
* Gets the starting index and length subrange within the source string
|
||||
* that comprises this list.
|
||||
*
|
||||
* Results:
|
||||
*
|
||||
* Returns the length of the list.
|
||||
*
|
||||
* Side Effects:
|
||||
*
|
||||
* The starting index in the source string is stored in startIndexPtr
|
||||
* if it is not NULL.
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static Tcl_Size
|
||||
StringListGetExtent(Tcl_Obj *strListObj, Tcl_Size *startIndexPtr, Tcl_Size *numCharsPtr, int *reversedPtr)
|
||||
{
|
||||
Tcl_Obj *srcStringObj;
|
||||
StringListInfo *infoPtr;
|
||||
Tcl_Size numChars;
|
||||
Tcl_Size listLen;
|
||||
Tcl_Size startIndex;
|
||||
int reversed;
|
||||
|
||||
srcStringObj = StringListGetSourceObj(strListObj);
|
||||
infoPtr = StringListGetInfo(strListObj);
|
||||
|
||||
assert(srcStringObj);
|
||||
numChars = Tcl_GetCharLength(srcStringObj);
|
||||
|
||||
if (infoPtr) {
|
||||
/* The list is a subrange of the string */
|
||||
startIndex = infoPtr->startIndex;
|
||||
if (infoPtr->count >= 0) {
|
||||
listLen = infoPtr->count;
|
||||
assert(listLen <= numChars);
|
||||
}
|
||||
else {
|
||||
listLen = numChars - startIndex;
|
||||
}
|
||||
reversed = (infoPtr->flags & STRINGLIST_REVERSE) != 0;
|
||||
} else {
|
||||
startIndex = 0;
|
||||
listLen = numChars;
|
||||
reversed = 0;
|
||||
}
|
||||
|
||||
assert(listLen <= numChars);
|
||||
assert(startIndex == 0 || startIndex < numChars);
|
||||
assert(startIndex <= (numChars - listLen));
|
||||
|
||||
if (startIndexPtr) {
|
||||
*startIndexPtr = startIndex;
|
||||
}
|
||||
if (numCharsPtr) {
|
||||
*numCharsPtr = numChars;
|
||||
}
|
||||
if (reversedPtr) {
|
||||
*reversedPtr = reversed;
|
||||
}
|
||||
return listLen;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* StringListObjIndex --
|
||||
*
|
||||
* Returns the element with the specified index in the list. If index
|
||||
* is out of range, an empty Tcl_Obj is returned.
|
||||
*
|
||||
* Results:
|
||||
*
|
||||
* TCL_OK on success.
|
||||
*
|
||||
* Side Effects:
|
||||
*
|
||||
* On success, the
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
StringListObjIndex(
|
||||
TCL_UNUSED(Tcl_Interp *),/* Used for error reporting if not NULL. */
|
||||
Tcl_Obj *strListObj, /* List obj */
|
||||
Tcl_Size index, /* index to element of interest */
|
||||
Tcl_Obj **elemObj) /* Return value */
|
||||
{
|
||||
Tcl_Size listLen;
|
||||
Tcl_Size startIndex;
|
||||
Tcl_Obj *srcStringObj;
|
||||
int reversed;
|
||||
Tcl_Size strIndex;
|
||||
|
||||
if (index < 0) {
|
||||
goto outOfBounds;
|
||||
}
|
||||
|
||||
srcStringObj = StringListGetSourceObj(strListObj);
|
||||
assert(srcStringObj);
|
||||
|
||||
listLen = StringListGetExtent(strListObj, &startIndex, NULL, &reversed);
|
||||
if (index >= listLen) {
|
||||
goto outOfBounds;
|
||||
}
|
||||
|
||||
/*
|
||||
* The index into the string depends on whether the list is only a
|
||||
* substring of the string and whether it is reversed.
|
||||
*/
|
||||
if (reversed) {
|
||||
strIndex = startIndex + listLen - index - 1;
|
||||
} else {
|
||||
strIndex = startIndex + index;
|
||||
}
|
||||
|
||||
char buf[TCL_UTF_MAX];
|
||||
int utfLen;
|
||||
|
||||
assert(strIndex <
|
||||
Tcl_GetCharLength(srcStringObj));
|
||||
Tcl_UniChar ch = Tcl_GetUniChar(srcStringObj, strIndex);
|
||||
utfLen = Tcl_UniCharToUtf(ch, buf);
|
||||
*elemObj = Tcl_NewStringObj(buf, utfLen);
|
||||
|
||||
return TCL_OK;
|
||||
|
||||
outOfBounds:
|
||||
/* TODO - NULL or empty obj? */
|
||||
*elemObj = Tcl_NewObj();
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* StringListObjLength
|
||||
*
|
||||
* Returns the length of the StringList
|
||||
*
|
||||
* Results:
|
||||
*
|
||||
* The length of the list.
|
||||
*
|
||||
* Side Effects:
|
||||
*
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
Tcl_Size StringListObjLength(Tcl_Obj *strListObj)
|
||||
{
|
||||
return StringListGetExtent(strListObj, NULL, NULL, NULL);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* StringListObjRange --
|
||||
*
|
||||
* Makes a slice of an StringList.
|
||||
*
|
||||
* Results:
|
||||
* Returns a pointer to the sliced series.
|
||||
* This may be a new object or the same object if not shared.
|
||||
*
|
||||
* Side effects:
|
||||
* ?The possible conversion of the object referenced by listPtr?
|
||||
* ?to a list object.?
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
StringListObjRange(
|
||||
TCL_UNUSED(Tcl_Interp *), /* For error message(s) */
|
||||
Tcl_Obj *strListObj, /* List object to take a range from. */
|
||||
Tcl_Size fromIdx, /* Index of first element to include. */
|
||||
Tcl_Size toIdx, /* Index of last element to include. */
|
||||
Tcl_Obj **newObjPtr) /* return value */
|
||||
{
|
||||
Tcl_Size listLen;
|
||||
Tcl_Size startIndex;
|
||||
Tcl_Obj *srcStringObj;
|
||||
int reversed;
|
||||
|
||||
srcStringObj = StringListGetSourceObj(strListObj);
|
||||
assert(srcStringObj);
|
||||
|
||||
listLen = StringListGetExtent(strListObj, &startIndex, NULL, &reversed);
|
||||
|
||||
if (fromIdx < 0) {
|
||||
fromIdx = 0;
|
||||
}
|
||||
|
||||
if (toIdx >= listLen) {
|
||||
toIdx = listLen - 1;
|
||||
}
|
||||
|
||||
if (fromIdx > toIdx ||
|
||||
fromIdx >= listLen) {
|
||||
TclNewObj(*newObjPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
assert(fromIdx >= 0);
|
||||
assert(toIdx >= fromIdx);
|
||||
assert(listLen > toIdx);
|
||||
|
||||
/*
|
||||
* We could do a Tcl_Range to allocate a new string but instead
|
||||
* keep the old one and just add ancillary information specifying
|
||||
* range and reverse setting.
|
||||
*/
|
||||
StringListInfo *infoPtr;
|
||||
infoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*infoPtr));
|
||||
|
||||
infoPtr->count = toIdx - fromIdx + 1;
|
||||
if (reversed) {
|
||||
infoPtr->startIndex = startIndex + listLen - toIdx - 1;
|
||||
infoPtr->flags = STRINGLIST_REVERSE;
|
||||
} else {
|
||||
infoPtr->startIndex = startIndex + fromIdx;
|
||||
infoPtr->flags = 0;
|
||||
assert(fromIdx < Tcl_GetCharLength(strListObj));
|
||||
assert(toIdx < Tcl_GetCharLength(strListObj));
|
||||
}
|
||||
|
||||
Tcl_Obj *newObj = Tcl_NewObj();
|
||||
Tcl_InvalidateStringRep(newObj);
|
||||
newObj->internalRep.twoPtrValue.ptr1 = srcStringObj;
|
||||
Tcl_IncrRefCount(srcStringObj);
|
||||
newObj->internalRep.twoPtrValue.ptr2 = infoPtr;
|
||||
newObj->typePtr = &stringListType;
|
||||
|
||||
*newObjPtr = newObj;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* StringListObjReverse --
|
||||
*
|
||||
* Reverse the order of the StringList value.
|
||||
*
|
||||
* Results:
|
||||
* The result will be StringList in the reverse order.
|
||||
*
|
||||
* Side effects:
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
int
|
||||
StringListObjReverse(
|
||||
TCL_UNUSED(Tcl_Interp *), /* For error message(s) */
|
||||
Tcl_Obj *strListObj, /* List object to reverse. */
|
||||
Tcl_Obj **newObjPtr)
|
||||
{
|
||||
Tcl_Obj *srcStringObj, *newObj;
|
||||
StringListInfo *infoPtr, *newInfoPtr;
|
||||
|
||||
srcStringObj = StringListGetSourceObj(strListObj);
|
||||
assert(srcStringObj);
|
||||
|
||||
newObj = Tcl_NewObj();
|
||||
Tcl_InvalidateStringRep(newObj);
|
||||
newObj->internalRep.twoPtrValue.ptr1 = srcStringObj;
|
||||
Tcl_IncrRefCount(srcStringObj);
|
||||
newObj->typePtr = &stringListType;
|
||||
|
||||
infoPtr = StringListGetInfo(strListObj);
|
||||
if (infoPtr) {
|
||||
if (infoPtr->startIndex == 0 && infoPtr->count < 0 &&
|
||||
(infoPtr->flags & STRINGLIST_REVERSE)) {
|
||||
/* No need for ancillary information */
|
||||
newInfoPtr = NULL;
|
||||
} else {
|
||||
newInfoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*newInfoPtr));
|
||||
newInfoPtr->startIndex = infoPtr->startIndex;
|
||||
newInfoPtr->count = infoPtr->count;
|
||||
newInfoPtr->flags = infoPtr->flags ^ STRINGLIST_REVERSE;
|
||||
}
|
||||
} else {
|
||||
newInfoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*newInfoPtr));
|
||||
newInfoPtr->startIndex = 0;
|
||||
newInfoPtr->count = -1; /* Entire string */
|
||||
newInfoPtr->flags = STRINGLIST_REVERSE;
|
||||
}
|
||||
|
||||
newObj->internalRep.twoPtrValue.ptr2 = newInfoPtr;
|
||||
*newObjPtr = newObj;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* UpdateStringOfStringList --
|
||||
*
|
||||
* Update the string representation for an StringList object.
|
||||
* Note: This procedure does not invalidate an existing old string rep
|
||||
* so storage will be lost if this has not already been done.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The object's string is set to a valid string that results from
|
||||
* the list-to-string conversion. This string will be empty if the
|
||||
* list has no elements. The list internal representation
|
||||
* should be a StringList when this function is called.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
UpdateStringOfStringList(Tcl_Obj *strListObj)
|
||||
{
|
||||
Tcl_Size listLen;
|
||||
Tcl_Size startIndex;
|
||||
Tcl_Size numChars;
|
||||
Tcl_Obj *srcStringObj;
|
||||
int reversed;
|
||||
|
||||
assert(strListObj->bytes == NULL);
|
||||
|
||||
srcStringObj = StringListGetSourceObj(strListObj);
|
||||
assert(srcStringObj);
|
||||
|
||||
listLen =
|
||||
StringListGetExtent(strListObj, &startIndex, &numChars, &reversed);
|
||||
if (listLen == 0) {
|
||||
Tcl_InitStringRep(strListObj, NULL, 0);
|
||||
return;
|
||||
}
|
||||
|
||||
if (reversed) {
|
||||
Tcl_Obj *tempObj = TclStringReverse(srcStringObj, TCL_STRING_IN_PLACE);
|
||||
/* NOTE: TclStringReverse may return same or different Tcl_Obj! */
|
||||
srcStringObj = tempObj;
|
||||
startIndex = numChars - (startIndex + listLen) - 1;
|
||||
}
|
||||
|
||||
/* srcStringObj may be original or newly allocated so we have to decrref later */
|
||||
Tcl_IncrRefCount(srcStringObj);
|
||||
|
||||
const char *utf;
|
||||
const char *utfStart = Tcl_GetString(srcStringObj);
|
||||
# define LOCAL_SIZE 64
|
||||
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
|
||||
Tcl_Size i, bytesNeeded;
|
||||
int utfLen, uniChar;
|
||||
|
||||
utfStart = Tcl_UtfAtIndex(utfStart, startIndex);
|
||||
|
||||
/* Pass 1: estimate space, gather flags. */
|
||||
if (listLen <= LOCAL_SIZE) {
|
||||
flagPtr = localFlags;
|
||||
} else {
|
||||
/* We know numElems <= LIST_MAX, so this is safe. */
|
||||
flagPtr = (char *)Tcl_Alloc(listLen);
|
||||
}
|
||||
for (i = 0, bytesNeeded = 0, utf = utfStart; i < listLen; ++i) {
|
||||
flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
|
||||
utfLen = Tcl_UtfToUniChar(utf, &uniChar);
|
||||
bytesNeeded += TclScanElement(utf, utfLen, flagPtr+i);
|
||||
if (bytesNeeded > TCL_SIZE_MAX - listLen) {
|
||||
Tcl_Panic("max size for a Tcl value (%" TCL_Z_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX);
|
||||
}
|
||||
utf += utfLen;
|
||||
}
|
||||
bytesNeeded += listLen - 1; /* Room for space separators */
|
||||
|
||||
/*
|
||||
* Pass 2: copy into string rep buffer.
|
||||
*/
|
||||
|
||||
char * const dstStart = Tcl_InitStringRep(strListObj, NULL, bytesNeeded);
|
||||
char *dst;
|
||||
TclOOM(dstStart, bytesNeeded);
|
||||
for (i = 0, dst = dstStart, utf = utfStart; i < listLen; ++i) {
|
||||
flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
|
||||
utfLen = Tcl_UtfToUniChar(utf, &uniChar);
|
||||
dst += TclConvertElement(utf, utfLen, dst, flagPtr[i]);
|
||||
*dst++ = ' ';
|
||||
utf += utfLen;
|
||||
}
|
||||
|
||||
/* Set the string length to what was actually written, the safe choice */
|
||||
(void) Tcl_InitStringRep(strListObj, NULL, dst - 1 - dstStart);
|
||||
|
||||
Tcl_DecrRefCount(srcStringObj);
|
||||
if (flagPtr != localFlags) {
|
||||
Tcl_Free(flagPtr);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
* c-basic-offset: 4
|
||||
* fill-column: 78
|
||||
* End:
|
||||
*/
|
||||
+50
-146
@@ -59,6 +59,8 @@ static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
|
||||
Tcl_Size numAppendChars);
|
||||
static void FillUnicodeRep(Tcl_Obj *objPtr);
|
||||
static void FreeStringInternalRep(Tcl_Obj *objPtr);
|
||||
static Tcl_Size GetCharLength(Tcl_Obj *objPtr);
|
||||
static Tcl_Obj* GetRange(tclObjTypeInterfaceArgsStringRange);
|
||||
static void GrowStringBuffer(Tcl_Obj *objPtr, Tcl_Size needed, int flag);
|
||||
static void GrowUnicodeBuffer(Tcl_Obj *objPtr, Tcl_Size needed);
|
||||
static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
@@ -67,16 +69,6 @@ static void SetUnicodeObj(Tcl_Obj *objPtr,
|
||||
static Tcl_Size UnicodeLength(const Tcl_UniChar *unicode);
|
||||
static void UpdateStringOfString(Tcl_Obj *objPtr);
|
||||
|
||||
#if TCL_UTF_MAX > 3
|
||||
#define ISCONTINUATION(bytes) (\
|
||||
((bytes)[0] & 0xC0) == 0x80)
|
||||
#else
|
||||
#define ISCONTINUATION(bytes) (\
|
||||
((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \
|
||||
&& (((bytes)[1] & 0xF0) == 0xB0) && (((bytes)[2] & 0xC0) == 0x80))))
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
* The structure below defines the string Tcl object type by means of
|
||||
* functions that can be invoked by generic object code.
|
||||
@@ -379,11 +371,18 @@ Tcl_NewUnicodeObj(
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_Size
|
||||
Tcl_GetCharLength(
|
||||
Tcl_Obj *objPtr) /* The String object to get the num chars
|
||||
* of. */
|
||||
{
|
||||
return TclObjectDispatch(objPtr, GetCharLength,
|
||||
string, length, objPtr);
|
||||
}
|
||||
|
||||
Tcl_Size
|
||||
GetCharLength(
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
String *stringPtr;
|
||||
Tcl_Size numChars = 0;
|
||||
@@ -589,22 +588,6 @@ Tcl_GetUniChar(
|
||||
return -1;
|
||||
}
|
||||
ch = stringPtr->unicode[index];
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* 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 */
|
||||
}
|
||||
} else if ((++index < stringPtr->numChars)
|
||||
&& ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
|
||||
/* high surrogate followed by low surrogate */
|
||||
ch = (((ch & 0x3FF) << 10) |
|
||||
(stringPtr->unicode[index] & 0x3FF)) + 0x10000;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
return ch;
|
||||
}
|
||||
|
||||
@@ -666,36 +649,6 @@ TclGetUniChar(
|
||||
*/
|
||||
|
||||
#undef Tcl_GetUnicodeFromObj
|
||||
#if !defined(TCL_NO_DEPRECATED)
|
||||
Tcl_UniChar *
|
||||
TclGetUnicodeFromObj(
|
||||
Tcl_Obj *objPtr, /* The object to find the Unicode string
|
||||
* for. */
|
||||
void *lengthPtr) /* If non-NULL, the location where the string
|
||||
* rep's Tcl_UniChar length should be stored. If
|
||||
* NULL, no length is stored. */
|
||||
{
|
||||
String *stringPtr;
|
||||
|
||||
SetStringFromAny(NULL, objPtr);
|
||||
stringPtr = GET_STRING(objPtr);
|
||||
|
||||
if (stringPtr->hasUnicode == 0) {
|
||||
FillUnicodeRep(objPtr);
|
||||
stringPtr = GET_STRING(objPtr);
|
||||
}
|
||||
|
||||
if (lengthPtr != NULL) {
|
||||
if (stringPtr->numChars > INT_MAX) {
|
||||
Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr"
|
||||
" cannot handle such long strings. Please use 'Tcl_Size'");
|
||||
}
|
||||
*(int *)lengthPtr = (int)stringPtr->numChars;
|
||||
}
|
||||
return stringPtr->unicode;
|
||||
}
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
|
||||
Tcl_UniChar *
|
||||
Tcl_GetUnicodeFromObj(
|
||||
Tcl_Obj *objPtr, /* The object to find the unicode string
|
||||
@@ -741,11 +694,15 @@ Tcl_GetUnicodeFromObj(
|
||||
*/
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_GetRange(
|
||||
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
|
||||
Tcl_Size first, /* First index of the range. */
|
||||
Tcl_Size last) /* Last index of the range. */
|
||||
Tcl_GetRange(tclObjTypeInterfaceArgsStringRange)
|
||||
{
|
||||
return TclObjectDispatch(objPtr, GetRange,
|
||||
string, range, objPtr, first, last);
|
||||
}
|
||||
|
||||
|
||||
Tcl_Obj *
|
||||
GetRange(tclObjTypeInterfaceArgsStringRange) {
|
||||
Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
|
||||
String *stringPtr;
|
||||
Tcl_Size length = 0;
|
||||
@@ -816,18 +773,6 @@ Tcl_GetRange(
|
||||
TclNewObj(newObjPtr);
|
||||
return newObjPtr;
|
||||
}
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* 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)
|
||||
&& ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
|
||||
++last;
|
||||
}
|
||||
#endif
|
||||
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
|
||||
}
|
||||
|
||||
@@ -1283,12 +1228,6 @@ Tcl_AppendLimitedToObj(
|
||||
SetStringFromAny(NULL, objPtr);
|
||||
stringPtr = GET_STRING(objPtr);
|
||||
|
||||
/* If appended string starts with a continuation byte or a lower surrogate,
|
||||
* force objPtr to unicode representation. See [7f1162a867] */
|
||||
if (bytes && ISCONTINUATION(bytes)) {
|
||||
Tcl_GetUnicode(objPtr);
|
||||
stringPtr = GET_STRING(objPtr);
|
||||
}
|
||||
if (stringPtr->hasUnicode && (stringPtr->numChars) > 0) {
|
||||
AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
|
||||
} else {
|
||||
@@ -1488,13 +1427,6 @@ Tcl_AppendObjToObj(
|
||||
SetStringFromAny(NULL, objPtr);
|
||||
stringPtr = GET_STRING(objPtr);
|
||||
|
||||
/* If appended string starts with a continuation byte or a lower surrogate,
|
||||
* force objPtr to unicode representation. See [7f1162a867]
|
||||
* This fixes append-3.4, append-3.7 and utf-1.18 testcases. */
|
||||
if (ISCONTINUATION(TclGetString(appendObjPtr))) {
|
||||
Tcl_GetUnicode(objPtr);
|
||||
stringPtr = GET_STRING(objPtr);
|
||||
}
|
||||
/*
|
||||
* If objPtr has a valid Unicode rep, then get a Unicode string from
|
||||
* appendObjPtr and append it.
|
||||
@@ -2157,12 +2089,6 @@ Tcl_AppendFormatToObj(
|
||||
code = 0xFFFD;
|
||||
}
|
||||
length = Tcl_UniCharToUtf(code, buf);
|
||||
#if TCL_UTF_MAX < 4
|
||||
if ((code >= 0xD800) && (length < 3)) {
|
||||
/* Special case for handling high surrogates. */
|
||||
length += Tcl_UniCharToUtf(-1, buf + length);
|
||||
}
|
||||
#endif
|
||||
segment = Tcl_NewStringObj(buf, length);
|
||||
Tcl_IncrRefCount(segment);
|
||||
allocSegment = 1;
|
||||
@@ -3124,7 +3050,7 @@ TclStringCat(
|
||||
Tcl_Obj *objResultPtr, * const *ov;
|
||||
int binary = 1;
|
||||
Tcl_Size oc, length = 0;
|
||||
int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
|
||||
int allowUniChar = 1, requestUniChar = 0;
|
||||
Tcl_Size first = objc - 1; /* Index of first value possibly not empty */
|
||||
Tcl_Size last = 0; /* Index of last value possibly not empty */
|
||||
int inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv);
|
||||
@@ -3166,9 +3092,7 @@ TclStringCat(
|
||||
*/
|
||||
|
||||
binary = 0;
|
||||
if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) {
|
||||
forceUniChar = 1;
|
||||
} else if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
|
||||
if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
|
||||
/* Prevent shimmer of non-string types. */
|
||||
allowUniChar = 0;
|
||||
}
|
||||
@@ -3218,7 +3142,7 @@ TclStringCat(
|
||||
}
|
||||
}
|
||||
} while (--oc);
|
||||
} else if ((allowUniChar && requestUniChar) || forceUniChar) {
|
||||
} else if ((allowUniChar && requestUniChar)) {
|
||||
/*
|
||||
* Result will be pure Tcl_UniChar array. Pre-size it.
|
||||
*/
|
||||
@@ -3375,7 +3299,7 @@ TclStringCat(
|
||||
dst += more;
|
||||
}
|
||||
}
|
||||
} else if ((allowUniChar && requestUniChar) || forceUniChar) {
|
||||
} else if ((allowUniChar && requestUniChar)) {
|
||||
/* Efficiently produce a pure Tcl_UniChar array result */
|
||||
Tcl_UniChar *dst;
|
||||
|
||||
@@ -3567,7 +3491,7 @@ TclStringCmp(
|
||||
s1 = (char *) Tcl_GetUnicode(value1Ptr);
|
||||
s2 = (char *) Tcl_GetUnicode(value2Ptr);
|
||||
if (
|
||||
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
|
||||
#if defined(WORDS_BIGENDIAN)
|
||||
1
|
||||
#else
|
||||
checkEq
|
||||
@@ -3790,6 +3714,32 @@ TclStringFirst(
|
||||
return obj;
|
||||
}
|
||||
|
||||
int
|
||||
TclStringIndexInterface(
|
||||
Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *indexPtr, Tcl_Obj **charPtrPtr)
|
||||
{
|
||||
Tcl_Size index, status;
|
||||
|
||||
status = TclGetIntForIndexM(interp, indexPtr, /*endValue*/ TCL_SIZE_MAX - 1,
|
||||
&index);
|
||||
if (status != TCL_OK) {
|
||||
return status;
|
||||
}
|
||||
|
||||
if (TclIndexIsFromEnd(index)) {
|
||||
if (TclObjectInterfaceCall(objPtr, string, indexEnd,
|
||||
interp, objPtr, index, charPtrPtr) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
if (TclObjectInterfaceCall(objPtr, string, index, interp, objPtr,
|
||||
index, charPtrPtr) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*---------------------------------------------------------------------------
|
||||
*
|
||||
@@ -3927,9 +3877,6 @@ TclStringReverse(
|
||||
String *stringPtr;
|
||||
Tcl_UniChar ch = 0;
|
||||
int inPlace = flags & TCL_STRING_IN_PLACE;
|
||||
#if TCL_UTF_MAX < 4
|
||||
int needFlip = 0;
|
||||
#endif
|
||||
|
||||
if (TclIsPureByteArray(objPtr)) {
|
||||
Tcl_Size numBytes = 0;
|
||||
@@ -3962,54 +3909,19 @@ TclStringReverse(
|
||||
to = Tcl_GetUnicode(objPtr);
|
||||
stringPtr = GET_STRING(objPtr);
|
||||
while (--src >= from) {
|
||||
#if TCL_UTF_MAX < 4
|
||||
ch = *src;
|
||||
if ((ch & 0xF800) == 0xD800) {
|
||||
needFlip = 1;
|
||||
}
|
||||
*to++ = ch;
|
||||
#else
|
||||
*to++ = *src;
|
||||
#endif
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* Reversing in place.
|
||||
*/
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
to = src;
|
||||
#endif
|
||||
while (--src > from) {
|
||||
ch = *src;
|
||||
#if TCL_UTF_MAX < 4
|
||||
if ((ch & 0xF800) == 0xD800) {
|
||||
needFlip = 1;
|
||||
}
|
||||
#endif
|
||||
*src = *from;
|
||||
*from++ = ch;
|
||||
}
|
||||
}
|
||||
#if TCL_UTF_MAX < 4
|
||||
if (needFlip) {
|
||||
/*
|
||||
* Flip back surrogate pairs.
|
||||
*/
|
||||
|
||||
from = to - stringPtr->numChars;
|
||||
while (--to >= from) {
|
||||
ch = *to;
|
||||
if ((ch & 0xFC00) == 0xD800) {
|
||||
if ((to-1 >= from) && ((to[-1] & 0xFC00) == 0xDC00)) {
|
||||
to[0] = to[-1];
|
||||
to[-1] = ch;
|
||||
--to;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
if (objPtr->bytes) {
|
||||
@@ -4043,7 +3955,7 @@ TclStringReverse(
|
||||
* skip calling Tcl_UtfCharComplete() here.
|
||||
*/
|
||||
|
||||
int bytesInChar = TclUtfToUCS4(from, &chw);
|
||||
int bytesInChar = Tcl_UtfToUniChar(from, &chw);
|
||||
|
||||
ReverseBytes((unsigned char *)to, (unsigned char *)from,
|
||||
bytesInChar);
|
||||
@@ -4492,14 +4404,6 @@ ExtendStringRepWithUnicode(
|
||||
|
||||
copyBytes:
|
||||
dst = objPtr->bytes + origLength;
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Initialize the buffer so that some random data doesn't trick
|
||||
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
|
||||
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
|
||||
* prior non-stateful nature, this call to memset can also be removed.
|
||||
*/
|
||||
memset(dst, 0xff, stringPtr->allocated - origLength);
|
||||
#endif
|
||||
for (i = 0; i < numChars; i++) {
|
||||
dst += Tcl_UniCharToUtf(unicode[i], dst);
|
||||
}
|
||||
|
||||
+1
-114
@@ -79,16 +79,12 @@
|
||||
# undef Tcl_WinConvertError
|
||||
# define Tcl_WinConvertError 0
|
||||
#endif
|
||||
#if defined(TCL_NO_DEPRECATED)
|
||||
# undef TclGetStringFromObj
|
||||
# undef TclGetBytesFromObj
|
||||
# undef TclGetUnicodeFromObj
|
||||
# define TclGetStringFromObj 0
|
||||
# define TclGetBytesFromObj 0
|
||||
# if TCL_UTF_MAX > 3
|
||||
# define TclGetUnicodeFromObj 0
|
||||
# endif
|
||||
#endif
|
||||
# define TclGetUnicodeFromObj 0
|
||||
#undef Tcl_Close
|
||||
#define Tcl_Close 0
|
||||
#undef TclGetByteArrayFromObj
|
||||
@@ -97,24 +93,10 @@
|
||||
#define Tcl_GetByteArrayFromObj 0
|
||||
#define TclUnusedStubEntry 0
|
||||
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
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_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, Tcl_Size *))(void *)uniCodePanic
|
||||
# define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, void *))(void *)uniCodePanic
|
||||
# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
|
||||
# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
|
||||
# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
|
||||
#endif
|
||||
|
||||
#define TclUtfCharComplete Tcl_UtfCharComplete
|
||||
#define TclUtfNext Tcl_UtfNext
|
||||
#define TclUtfPrev Tcl_UtfPrev
|
||||
|
||||
#if defined(TCL_NO_DEPRECATED)
|
||||
# define TclListObjGetElements 0
|
||||
# define TclListObjLength 0
|
||||
# define TclDictObjSize 0
|
||||
@@ -122,101 +104,6 @@ static void uniCodePanic() {
|
||||
# define TclSplitPath 0
|
||||
# define TclFSSplitPath 0
|
||||
# define TclParseArgsObjv 0
|
||||
#else /* !defined(TCL_NO_DEPRECATED) */
|
||||
int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
void *objcPtr, Tcl_Obj ***objvPtr) {
|
||||
Tcl_Size n = TCL_INDEX_NONE;
|
||||
int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr);
|
||||
if (objcPtr) {
|
||||
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
|
||||
if (interp) {
|
||||
Tcl_AppendResult(interp, "List too large to be processed", NULL);
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
*(int *)objcPtr = (int)n;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
void *lengthPtr) {
|
||||
Tcl_Size n = TCL_INDEX_NONE;
|
||||
int result = Tcl_ListObjLength(interp, listPtr, &n);
|
||||
if (lengthPtr) {
|
||||
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
|
||||
if (interp) {
|
||||
Tcl_AppendResult(interp, "List too large to be processed", NULL);
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
*(int *)lengthPtr = (int)n;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
|
||||
void *sizePtr) {
|
||||
Tcl_Size n = TCL_INDEX_NONE;
|
||||
int result = Tcl_DictObjSize(interp, dictPtr, &n);
|
||||
if (sizePtr) {
|
||||
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
|
||||
if (interp) {
|
||||
Tcl_AppendResult(interp, "Dict too large to be processed", NULL);
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
*(int *)sizePtr = (int)n;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr,
|
||||
const char ***argvPtr) {
|
||||
Tcl_Size n = TCL_INDEX_NONE;
|
||||
int result = Tcl_SplitList(interp, listStr, &n, argvPtr);
|
||||
if (argcPtr) {
|
||||
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
|
||||
if (interp) {
|
||||
Tcl_AppendResult(interp, "List too large to be processed", NULL);
|
||||
}
|
||||
Tcl_Free((void *)*argvPtr);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
*(int *)argcPtr = (int)n;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) {
|
||||
Tcl_Size n = TCL_INDEX_NONE;
|
||||
Tcl_SplitPath(path, &n, argvPtr);
|
||||
if (argcPtr) {
|
||||
if ((sizeof(int) != sizeof(size_t)) && (n > INT_MAX)) {
|
||||
n = TCL_INDEX_NONE; /* No other way to return an error-situation */
|
||||
Tcl_Free((void *)*argvPtr);
|
||||
*argvPtr = NULL;
|
||||
}
|
||||
*(int *)argcPtr = (int)n;
|
||||
}
|
||||
}
|
||||
Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) {
|
||||
Tcl_Size n = TCL_INDEX_NONE;
|
||||
Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n);
|
||||
if (lenPtr) {
|
||||
if ((sizeof(int) != sizeof(size_t)) && result && (n > INT_MAX)) {
|
||||
Tcl_DecrRefCount(result);
|
||||
return NULL;
|
||||
}
|
||||
*(int *)lenPtr = (int)n;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
int TclParseArgsObjv(Tcl_Interp *interp,
|
||||
const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv,
|
||||
Tcl_Obj ***remObjv) {
|
||||
Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ;
|
||||
int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv);
|
||||
*(int *)objcPtr = (int)n;
|
||||
return result;
|
||||
}
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
|
||||
#define TclBN_mp_add mp_add
|
||||
#define TclBN_mp_add_d mp_add_d
|
||||
|
||||
+7
-21
@@ -515,9 +515,6 @@ static const char version[] = TCL_PATCH_LEVEL "+" STRINGIFY(TCL_VERSION_UUID)
|
||||
#ifdef STATIC_BUILD
|
||||
".static"
|
||||
#endif
|
||||
#if TCL_UTF_MAX < 4
|
||||
".utf-16"
|
||||
#endif
|
||||
;
|
||||
|
||||
int
|
||||
@@ -546,12 +543,10 @@ Tcltest_Init(
|
||||
}
|
||||
|
||||
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
if (info.isNativeObjectProc == 2) {
|
||||
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
|
||||
info.objProc2, (void *)version, NULL);
|
||||
} else
|
||||
#endif
|
||||
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
|
||||
info.objProc, (void *)version, NULL);
|
||||
}
|
||||
@@ -732,6 +727,12 @@ Tcltest_Init(
|
||||
if (TclObjTest_Init(interp) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (TcltestObjectInterfaceInit(interp) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (TcltestObjectInterfaceListIntegerInit(interp) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Procbodytest_Init(interp) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -741,10 +742,6 @@ Tcltest_Init(
|
||||
}
|
||||
#endif
|
||||
|
||||
if (Tcl_ABSListTest_Init(interp) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Check for special options used in ../tests/main.test
|
||||
*/
|
||||
@@ -814,12 +811,10 @@ Tcltest_SafeInit(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
if (info.isNativeObjectProc == 2) {
|
||||
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
|
||||
info.objProc2, (void *)version, NULL);
|
||||
} else
|
||||
#endif
|
||||
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
|
||||
info.objProc, (void *)version, NULL);
|
||||
}
|
||||
@@ -5762,17 +5757,7 @@ TestbytestringObjCmd(
|
||||
Tcl_Obj *const objv[]) /* The argument objects. */
|
||||
{
|
||||
struct {
|
||||
#if !defined(TCL_NO_DEPRECATED)
|
||||
# if defined(_MSC_VER) && !defined(NDEBUG)
|
||||
# pragma warning(disable:4133)
|
||||
# elif defined(__clang__)
|
||||
# pragma clang diagnostic push
|
||||
# pragma clang diagnostic ignored "-Wincompatible-pointer-types"
|
||||
# endif
|
||||
int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */
|
||||
#else
|
||||
Tcl_Size n;
|
||||
#endif
|
||||
int m; /* This variable should not be overwritten */
|
||||
} x = {0, 1};
|
||||
const char *p;
|
||||
@@ -8806,3 +8791,4 @@ vamoose:
|
||||
* indent-tabs-mode: nil
|
||||
* End:
|
||||
*/
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
+14
-69
@@ -891,7 +891,6 @@ TestlistobjCmd(
|
||||
"replace",
|
||||
"indexmemcheck",
|
||||
"getelementsmemcheck",
|
||||
"index",
|
||||
NULL
|
||||
};
|
||||
enum listobjCmdIndex {
|
||||
@@ -900,7 +899,6 @@ TestlistobjCmd(
|
||||
LISTOBJ_REPLACE,
|
||||
LISTOBJ_INDEXMEMCHECK,
|
||||
LISTOBJ_GETELEMENTSMEMCHECK,
|
||||
LISTOBJ_INDEX,
|
||||
} cmdIndex;
|
||||
|
||||
Tcl_Size varIndex; /* Variable number converted to binary */
|
||||
@@ -976,13 +974,16 @@ TestlistobjCmd(
|
||||
!= TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objP->refCount < 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"Tcl_ListObjIndex returned object with ref count < 0",
|
||||
TCL_INDEX_NONE));
|
||||
/* Keep looping since we are also looping for leaks */
|
||||
}
|
||||
Tcl_BounceRefCount(objP);
|
||||
Tcl_IncrRefCount(objP);
|
||||
Tcl_DecrRefCount(objP);
|
||||
TCL_COMMENT(
|
||||
if (objP->refCount <= 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"Tcl_ListObjIndex returned object with ref count <= 0",
|
||||
TCL_INDEX_NONE));
|
||||
/* Keep looping since we are also looping for leaks */
|
||||
}
|
||||
)
|
||||
}
|
||||
break;
|
||||
|
||||
@@ -1009,26 +1010,6 @@ TestlistobjCmd(
|
||||
}
|
||||
}
|
||||
break;
|
||||
case LISTOBJ_INDEX:
|
||||
/*
|
||||
* Tcl_ListObjIndex semantics differ from lindex for out of bounds.
|
||||
* Hence this explicit test.
|
||||
*/
|
||||
if (objc != 4) {
|
||||
Tcl_WrongNumArgs(interp, 2, objv,
|
||||
"varIndex listIndex");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
} else {
|
||||
Tcl_Obj *objP;
|
||||
if (Tcl_ListObjIndex(interp, varPtr[varIndex], first, &objP) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_SetObjResult(interp, objP ? objP : Tcl_NewStringObj("null", -1));
|
||||
}
|
||||
break;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -1050,33 +1031,6 @@ TestlistobjCmd(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static Tcl_Size V1TestListObjLength(TCL_UNUSED(Tcl_Obj *)) {
|
||||
return 100;
|
||||
}
|
||||
|
||||
static int V1TestListObjIndex(
|
||||
TCL_UNUSED(Tcl_Interp *),
|
||||
TCL_UNUSED(Tcl_Obj *),
|
||||
TCL_UNUSED(Tcl_Size),
|
||||
Tcl_Obj **objPtr)
|
||||
{
|
||||
*objPtr = Tcl_NewStringObj("This indexProc should never be accessed (bug: e58d7e19e9)", -1);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static const Tcl_ObjType v1TestListType = {
|
||||
"testlist", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
NULL, /* updateStringProc */
|
||||
NULL, /* setFromAnyProc */
|
||||
offsetof(Tcl_ObjType, indexProc), /* This is a V1 objType, which doesn't have an indexProc */
|
||||
V1TestListObjLength, /* always return 100, doesn't really matter */
|
||||
V1TestListObjIndex, /* should never be accessed, because this objType = V1*/
|
||||
NULL, NULL, NULL, NULL, NULL, NULL
|
||||
};
|
||||
|
||||
|
||||
static int
|
||||
TestobjCmd(
|
||||
TCL_UNUSED(void *),
|
||||
@@ -1089,15 +1043,15 @@ TestobjCmd(
|
||||
const Tcl_ObjType *targetType;
|
||||
Tcl_Obj **varPtr;
|
||||
const char *subcommands[] = {
|
||||
"freeallvars", "bug3598580", "buge58d7e19e9",
|
||||
"types", "objtype", "newobj", "set",
|
||||
"freeallvars", "bug3598580", "types",
|
||||
"objtype", "newobj", "set",
|
||||
"assign", "convert", "duplicate",
|
||||
"invalidateStringRep", "refcount", "type",
|
||||
NULL
|
||||
};
|
||||
enum testobjCmdIndex {
|
||||
TESTOBJ_FREEALLVARS, TESTOBJ_BUG3598580, TESTOBJ_BUGE58D7E19E9,
|
||||
TESTOBJ_TYPES, TESTOBJ_OBJTYPE, TESTOBJ_NEWOBJ, TESTOBJ_SET,
|
||||
TESTOBJ_FREEALLVARS, TESTOBJ_BUG3598580, TESTOBJ_TYPES,
|
||||
TESTOBJ_OBJTYPE, TESTOBJ_NEWOBJ, TESTOBJ_SET,
|
||||
TESTOBJ_ASSIGN, TESTOBJ_CONVERT, TESTOBJ_DUPLICATE,
|
||||
TESTOBJ_INVALIDATESTRINGREP, TESTOBJ_REFCOUNT, TESTOBJ_TYPE,
|
||||
} cmdIndex;
|
||||
@@ -1139,15 +1093,6 @@ TestobjCmd(
|
||||
Tcl_SetObjResult(interp, listObjPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
case TESTOBJ_BUGE58D7E19E9:
|
||||
if (objc != 3) {
|
||||
goto wrongNumArgs;
|
||||
} else {
|
||||
Tcl_Obj *listObjPtr = Tcl_NewStringObj(Tcl_GetString(objv[2]), -1);
|
||||
listObjPtr->typePtr = &v1TestListType;
|
||||
Tcl_SetObjResult(interp, listObjPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
case TESTOBJ_TYPES:
|
||||
if (objc != 2) {
|
||||
goto wrongNumArgs;
|
||||
|
||||
@@ -0,0 +1,530 @@
|
||||
/*
|
||||
* tclTestObjInterface.c --
|
||||
*
|
||||
* This file contains C command functions for the additional Tcl commands
|
||||
* that are used for testing implementations of the Tcl object types.
|
||||
* These commands are not normally included in Tcl applications; they're
|
||||
* only used for testing.
|
||||
*
|
||||
* Copyright © 2021 Nathan Coulter
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include "tcl.h"
|
||||
#include "tclInt.h"
|
||||
|
||||
/*
|
||||
* Prototypes for functions defined later in this file:
|
||||
*/
|
||||
typedef struct indexHex {
|
||||
int refCount;
|
||||
Tcl_Size offset;
|
||||
} indexHex;
|
||||
|
||||
|
||||
int TcltestObjectInterfaceInit(Tcl_Interp *interp);
|
||||
|
||||
int NewTestIndexHex (
|
||||
ClientData, Tcl_Interp *interp, Tcl_Size argc, Tcl_Obj *const objv[]);
|
||||
static void DupTestIndexHexInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
|
||||
static void FreeTestIndexHexInternalRep(Tcl_Obj *objPtr);
|
||||
static int SetTestIndexHexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
static void UpdateStringOfTestIndexHex(Tcl_Obj *listPtr);
|
||||
|
||||
static int indexHexListStringIndex (tclObjTypeInterfaceArgsStringIndex);
|
||||
static int indexHexListStringIndexEnd(tclObjTypeInterfaceArgsStringIndexEnd);
|
||||
static Tcl_Size indexHexListStringLength(tclObjTypeInterfaceArgsStringLength);
|
||||
static int indexHexStringListIndexFromStringIndex(
|
||||
Tcl_Size *index, Tcl_Size *itemchars, Tcl_Size *totalitems);
|
||||
static Tcl_Obj* indexHexListStringRange(tclObjTypeInterfaceArgsStringRange);
|
||||
static Tcl_Obj* indexHexListStringRangeEnd(tclObjTypeInterfaceArgsStringRangeEnd);
|
||||
|
||||
static int indexHexListObjGetElements (tclObjTypeInterfaceArgsListAll);
|
||||
static int indexHexListObjAppendElement (tclObjTypeInterfaceArgsListAppend);
|
||||
static int indexHexListObjAppendList (tclObjTypeInterfaceArgsListAppendList);
|
||||
static int indexHexListObjIndex (tclObjTypeInterfaceArgsListIndex);
|
||||
static int indexHexListObjIndexEnd (tclObjTypeInterfaceArgsListIndexEnd);
|
||||
static int indexHexListObjIsSorted(tclObjTypeInterfaceArgsListIsSorted);
|
||||
static int indexHexListObjLength (tclObjTypeInterfaceArgsListLength);
|
||||
static Tcl_Obj* indexHexListObjRange (tclObjTypeInterfaceArgsListRange);
|
||||
static Tcl_Obj* indexHexListObjRangeEnd (tclObjTypeInterfaceArgsListRangeEnd);
|
||||
static int indexHexListObjReplace (tclObjTypeInterfaceArgsListReplace);
|
||||
static int indexHexListObjSetElement (tclObjTypeInterfaceArgsListSet);
|
||||
static Tcl_Obj * indexHexLsetFlat (tclObjTypeInterfaceArgsListSetList);
|
||||
|
||||
static int indexHexListErrorIndeterminate (Tcl_Interp *interp);
|
||||
static int indexHexListErrorReadOnly (Tcl_Interp *interp);
|
||||
|
||||
|
||||
|
||||
ObjInterface IndexHexInterface = {
|
||||
1,
|
||||
{
|
||||
&indexHexListStringIndex,
|
||||
&indexHexListStringIndexEnd,
|
||||
&indexHexListStringLength,
|
||||
&indexHexListStringRange,
|
||||
&indexHexListStringRangeEnd
|
||||
},
|
||||
{
|
||||
&indexHexListObjGetElements,
|
||||
&indexHexListObjAppendElement,
|
||||
&indexHexListObjAppendList,
|
||||
&indexHexListObjIndex,
|
||||
&indexHexListObjIndexEnd,
|
||||
&indexHexListObjIsSorted,
|
||||
&indexHexListObjLength,
|
||||
&indexHexListObjRange,
|
||||
&indexHexListObjRangeEnd,
|
||||
&indexHexListObjReplace,
|
||||
NULL,
|
||||
NULL,
|
||||
&indexHexListObjSetElement,
|
||||
&indexHexLsetFlat
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
const ObjectType testIndexHexType = {
|
||||
"testindexHex",
|
||||
FreeTestIndexHexInternalRep, /* freeIntRepProc */
|
||||
DupTestIndexHexInternalRep, /* dupIntRepProc */
|
||||
UpdateStringOfTestIndexHex, /* updateStringProc */
|
||||
SetTestIndexHexFromAny, /* setFromAnyProc */
|
||||
2,
|
||||
(Tcl_ObjInterface *)&IndexHexInterface
|
||||
};
|
||||
|
||||
const Tcl_ObjType *testIndexHexTypePtr = (Tcl_ObjType *)&testIndexHexType;
|
||||
|
||||
|
||||
int TcltestObjectInterfaceInit(Tcl_Interp *interp) {
|
||||
Tcl_CreateObjCommand2(interp, "testindexhex", NewTestIndexHex, NULL, NULL);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
|
||||
int NewTestIndexHex (
|
||||
TCL_UNUSED(void *),
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Size argc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Tcl_WideInt offset;
|
||||
Tcl_ObjInternalRep intrep;
|
||||
if (argc > 2) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj("too many arguments", -1));
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
if (argc == 2) {
|
||||
if (Tcl_GetWideIntFromObj(interp, objv[1], &offset) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (offset < 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj("bad offset", -1));
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
offset = 0;
|
||||
}
|
||||
Tcl_Obj *objPtr = Tcl_NewObj();
|
||||
Tcl_InvalidateStringRep(objPtr);
|
||||
|
||||
indexHex *indexHexPtr = (indexHex *)Tcl_Alloc(sizeof(indexHex));
|
||||
indexHexPtr->refCount = 1;
|
||||
indexHexPtr->offset = offset;
|
||||
intrep.twoPtrValue.ptr1 = indexHexPtr;
|
||||
Tcl_StoreInternalRep(objPtr, testIndexHexTypePtr, &intrep);
|
||||
Tcl_SetObjResult(interp, objPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
DupTestIndexHexInternalRep(
|
||||
TCL_UNUSED(Tcl_Obj *),
|
||||
TCL_UNUSED(Tcl_Obj *))
|
||||
{
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
FreeTestIndexHexInternalRep(Tcl_Obj *objPtr)
|
||||
{
|
||||
indexHex *indexHexPtr = (indexHex *)objPtr->internalRep.twoPtrValue.ptr1;
|
||||
if (--indexHexPtr->refCount == 0) {
|
||||
Tcl_Free(indexHexPtr);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
SetTestIndexHexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
{
|
||||
if (TclHasInternalRep(objPtr, testIndexHexTypePtr)) {
|
||||
return TCL_OK;
|
||||
} else {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewStringObj("can not set an existing value to this type", -1));
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
UpdateStringOfTestIndexHex(
|
||||
TCL_UNUSED(Tcl_Obj *))
|
||||
{
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
static int indexHexListStringIndex(tclObjTypeInterfaceArgsStringIndex) {
|
||||
Tcl_Obj *hexPtr;
|
||||
int status;
|
||||
Tcl_Size itemchars, totalitems;
|
||||
|
||||
status = indexHexStringListIndexFromStringIndex(
|
||||
&index, &itemchars, &totalitems);
|
||||
if (status != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
status = indexHexListObjIndex(interp, objPtr, totalitems, &hexPtr);
|
||||
if (status != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (index == itemchars - 1) {
|
||||
/* index refers to the space delimiter after the item. */
|
||||
*objPtrPtr = Tcl_NewStringObj(" ", -1);
|
||||
} else {
|
||||
*objPtrPtr = Tcl_GetRange(hexPtr, index, index);
|
||||
}
|
||||
Tcl_DecrRefCount(hexPtr);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
static int indexHexListErrorIndeterminate (Tcl_Interp *interp) {
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewStringObj("list length indeterminate", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "INDETERMINATE", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
static int indexHexListErrorReadOnly (Tcl_Interp *interp) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewStringObj("list length indeterminate", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "INTERFACE",
|
||||
"READONLY", NULL);
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
static int indexHexStringListIndexFromStringIndex(
|
||||
Tcl_Size *indexPtr, Tcl_Size *itemcharsPtr, Tcl_Size *totalitemsPtr)
|
||||
{
|
||||
Tcl_Size itemoffset, last = 0, power = 1, lasttotalchars = 0, newitems,
|
||||
top, totalchars = 0;
|
||||
|
||||
/* add 1 for the space after the item */
|
||||
*itemcharsPtr = power + 1;
|
||||
*totalitemsPtr = 0;
|
||||
|
||||
/* Count the number of characters in the items that contain fewer
|
||||
* characters than the item containing the requested index. */
|
||||
while (1) {
|
||||
top = 1u << (4 * power);
|
||||
if (top < 1u << (4 * (power - 1))) {
|
||||
/* operation wrapped around */
|
||||
power -= 1;
|
||||
break;
|
||||
}
|
||||
newitems = top - last;
|
||||
lasttotalchars = totalchars;
|
||||
totalchars += newitems * *itemcharsPtr;
|
||||
last = top;
|
||||
if (*indexPtr < totalchars) {
|
||||
break;
|
||||
}
|
||||
power += 1;
|
||||
*itemcharsPtr += 1;
|
||||
*totalitemsPtr += newitems;
|
||||
}
|
||||
|
||||
*indexPtr -= lasttotalchars;
|
||||
/* Determine how many items containing the same number of characters
|
||||
* precede the requested item. */
|
||||
itemoffset = *indexPtr / *itemcharsPtr ;
|
||||
*indexPtr = *indexPtr % *itemcharsPtr;
|
||||
/* Add the number of new characters. */
|
||||
*totalitemsPtr += itemoffset;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
static int indexHexListStringIndexEnd(
|
||||
Tcl_Interp *interp,
|
||||
TCL_UNUSED(Tcl_Obj *),
|
||||
TCL_UNUSED(Tcl_Size),
|
||||
TCL_UNUSED(Tcl_Obj **)
|
||||
) {
|
||||
return indexHexListErrorIndeterminate(interp);
|
||||
}
|
||||
|
||||
static Tcl_Size indexHexListStringLength(
|
||||
TCL_UNUSED(Tcl_Obj *);
|
||||
) {
|
||||
return TCL_INDEX_NONE;
|
||||
}
|
||||
|
||||
static Tcl_Obj* indexHexListStringRange(tclObjTypeInterfaceArgsStringRange) {
|
||||
Tcl_Obj *itemPtr, *item2Ptr, *resPtr;
|
||||
Tcl_Size index = first, status;
|
||||
Tcl_Size itemchars, needed, rangeLength, newStringLength,
|
||||
stringLength, totalitems;
|
||||
|
||||
if (last < first) {
|
||||
return Tcl_NewStringObj("", -1);
|
||||
}
|
||||
|
||||
status = indexHexStringListIndexFromStringIndex(
|
||||
&index, &itemchars, &totalitems);
|
||||
if (status != TCL_OK) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
status = indexHexListObjIndex(NULL, objPtr, totalitems, &itemPtr);
|
||||
if (status != TCL_OK) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
rangeLength = last - first + 1;
|
||||
|
||||
resPtr = Tcl_GetRange(itemPtr, index, index + rangeLength - 1);
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
|
||||
stringLength = Tcl_GetCharLength(resPtr);
|
||||
if (stringLength < rangeLength) {
|
||||
needed = rangeLength - stringLength;
|
||||
while (needed > 0) {
|
||||
totalitems++;
|
||||
status = indexHexListObjIndex(NULL, objPtr, totalitems, &itemPtr);
|
||||
if (status != TCL_OK) {
|
||||
return NULL;
|
||||
}
|
||||
Tcl_AppendToObj(resPtr, " ", 1);
|
||||
stringLength += newStringLength;
|
||||
needed -= 1;
|
||||
if (needed > 0) {
|
||||
newStringLength = Tcl_GetCharLength(itemPtr);
|
||||
if (newStringLength >= needed) {
|
||||
item2Ptr = Tcl_GetRange(itemPtr, 0, needed-1);
|
||||
newStringLength = Tcl_GetCharLength(item2Ptr);
|
||||
Tcl_AppendObjToObj(resPtr, item2Ptr);
|
||||
Tcl_DecrRefCount(item2Ptr);
|
||||
} else {
|
||||
Tcl_AppendObjToObj(resPtr, itemPtr);
|
||||
}
|
||||
stringLength += newStringLength;
|
||||
needed -= newStringLength;
|
||||
}
|
||||
Tcl_DecrRefCount(itemPtr);
|
||||
}
|
||||
}
|
||||
return resPtr;
|
||||
}
|
||||
|
||||
static Tcl_Obj* indexHexListStringRangeEnd(
|
||||
TCL_UNUSED(Tcl_Obj *),/* The Tcl object to find the range of. */
|
||||
TCL_UNUSED(Tcl_Size),/* First index of the range. */
|
||||
TCL_UNUSED(Tcl_Size) /* Last index of the range. */
|
||||
) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
|
||||
static int
|
||||
indexHexListObjGetElements(
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */
|
||||
TCL_UNUSED(Tcl_Obj *),/* List object for which an element array
|
||||
* is to be returned. */
|
||||
TCL_UNUSED(Tcl_Size *),/* Where to store the count of objects
|
||||
* referenced by objv. */
|
||||
TCL_UNUSED(Tcl_Obj ***)/* Where to store the pointer to an
|
||||
* array of */
|
||||
)
|
||||
{
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp,Tcl_NewStringObj("infinite list", -1));
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
indexHexListObjAppendElement(
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */
|
||||
TCL_UNUSED(Tcl_Obj *),/* List object to append objPtr to. */
|
||||
TCL_UNUSED(Tcl_Obj *)/* Object to append to listPtr's list. */
|
||||
)
|
||||
{
|
||||
indexHexListErrorReadOnly(interp);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
indexHexListObjAppendList(
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */
|
||||
TCL_UNUSED(Tcl_Obj *), /* List object to append elements to. */
|
||||
TCL_UNUSED(Tcl_Obj *) /* List obj with elements to append. */
|
||||
)
|
||||
{
|
||||
indexHexListErrorReadOnly(interp);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
indexHexListObjIndex(
|
||||
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
|
||||
TCL_UNUSED(Tcl_Obj *), /* List object to index into. */ \
|
||||
Tcl_Size index, /* Index of element to return. */ \
|
||||
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
|
||||
)
|
||||
{
|
||||
Tcl_Obj *resPtr;
|
||||
resPtr = Tcl_ObjPrintf("%" TCL_T_MODIFIER "x", index);
|
||||
*objPtrPtr = resPtr;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
indexHexListObjIndexEnd(
|
||||
Tcl_Interp * interp,/* Used to report errors if not NULL. */ \
|
||||
TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
|
||||
TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
|
||||
TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
|
||||
)
|
||||
{
|
||||
return indexHexListErrorIndeterminate(interp);
|
||||
}
|
||||
|
||||
|
||||
static int indexHexListObjIsSorted(
|
||||
TCL_UNUSED(Tcl_Interp *), /* Used to report errors */
|
||||
TCL_UNUSED(Tcl_Obj *), /* The list in question */
|
||||
TCL_UNUSED(size_t) /* flags */
|
||||
)
|
||||
{
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
indexHexListObjLength(
|
||||
TCL_UNUSED(Tcl_Interp *), /* Used to report errors if not NULL. */
|
||||
TCL_UNUSED(Tcl_Obj *), /* List object whose #elements to return. */
|
||||
Tcl_Size *lenPtr /* The resulting length is stored here. */
|
||||
)
|
||||
{
|
||||
*lenPtr = -1;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
static Tcl_Obj*
|
||||
indexHexListObjRange(tclObjTypeInterfaceArgsListRange)
|
||||
{
|
||||
Tcl_Obj *itemPtr, *resPtr;
|
||||
Tcl_Size length;
|
||||
int status;
|
||||
resPtr = Tcl_NewListObj(0, NULL);
|
||||
status = Tcl_ListObjLength(interp, listObj, &length);
|
||||
if (!status) {
|
||||
return NULL;
|
||||
}
|
||||
while (rangeStart <= length && rangeStart <= rangeEnd) {
|
||||
indexHexListObjIndex(interp, listObj, rangeStart, &itemPtr);
|
||||
if (
|
||||
Tcl_ListObjAppendElement(interp, resPtr, itemPtr) != TCL_OK
|
||||
) {
|
||||
Tcl_DecrRefCount(resPtr);
|
||||
return NULL;
|
||||
}
|
||||
rangeStart++;
|
||||
}
|
||||
return resPtr;
|
||||
}
|
||||
|
||||
|
||||
static Tcl_Obj*
|
||||
indexHexListObjRangeEnd(tclObjTypeInterfaceArgsListRangeEnd) {
|
||||
if (fromAnchor == 1 || toAnchor == 1) {
|
||||
indexHexListErrorIndeterminate(interp);
|
||||
return NULL;
|
||||
}
|
||||
return indexHexListObjRange(interp, listPtr, fromIdx, toIdx);
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
indexHexListObjReplace(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
|
||||
TCL_UNUSED(Tcl_Obj *), /* List object whose elements to replace. */ \
|
||||
TCL_UNUSED(Tcl_Size), /* Index of first element to replace. */ \
|
||||
TCL_UNUSED(Tcl_Size), /* Number of elements to replace. */ \
|
||||
TCL_UNUSED(Tcl_Size), /* Number of objects to insert. */ \
|
||||
/* An array of objc pointers to Tcl \
|
||||
* objects to insert. */ \
|
||||
TCL_UNUSEDVAR(Tcl_Obj *const insertObjs[])
|
||||
)
|
||||
{
|
||||
indexHexListErrorReadOnly(interp);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
indexHexListObjSetElement(
|
||||
Tcl_Interp *interp, /* Tcl interpreter; used for error reporting
|
||||
* if not NULL. */
|
||||
TCL_UNUSED(Tcl_Obj *), /* List object in which element should be
|
||||
* stored. */
|
||||
TCL_UNUSED(Tcl_Size), /* Index of element to store. */
|
||||
TCL_UNUSED(Tcl_Obj *)/* Tcl object to store in the designated list
|
||||
* element. */
|
||||
)
|
||||
{
|
||||
indexHexListErrorReadOnly(interp);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
static Tcl_Obj * indexHexLsetFlat (
|
||||
Tcl_Interp *interp, /* Tcl interpreter. */ \
|
||||
TCL_UNUSED(Tcl_Obj *), /* Pointer to the list being modified. */ \
|
||||
TCL_UNUSED(Tcl_Size), /* Number of index args. */ \
|
||||
TCL_UNUSEDVAR(Tcl_Obj *const indexArray[]), /* Index args. */ \
|
||||
TCL_UNUSED(Tcl_Obj *) /* Value arg to 'lset' or NULL to 'lpop'. */
|
||||
)
|
||||
{
|
||||
indexHexListErrorReadOnly(interp);
|
||||
return NULL;
|
||||
}
|
||||
@@ -0,0 +1,683 @@
|
||||
/*
|
||||
* tclTestObjInterfce.c --
|
||||
*
|
||||
* This file contains C command functions for the additional Tcl commands
|
||||
* that are used for testing implementations of the Tcl object types.
|
||||
* These commands are not normally included in Tcl applications; they're
|
||||
* only used for testing.
|
||||
*
|
||||
* Copyright © 2021 Nathan Coulter
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include "tcl.h"
|
||||
#include "tclInt.h"
|
||||
|
||||
/*
|
||||
* Prototypes for functions defined later in this file:
|
||||
*/
|
||||
int TestListInteger (
|
||||
ClientData, Tcl_Interp *interp, Tcl_Size argc, Tcl_Obj *const objv[]);
|
||||
static Tcl_Obj* NewTestListInteger();
|
||||
static void DupTestListIntegerInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
|
||||
|
||||
static void FreeTestListIntegerInternalRep(Tcl_Obj *objPtr);
|
||||
static int SetTestListIntegerFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
static void UpdateStringOfTestListInteger(Tcl_Obj *listPtr);
|
||||
|
||||
static int ListIntegerListStringIndex (tclObjTypeInterfaceArgsStringIndex);
|
||||
static int ListIntegerListStringIndexEnd(tclObjTypeInterfaceArgsStringIndexEnd);
|
||||
static Tcl_Size ListIntegerListStringLength(tclObjTypeInterfaceArgsStringLength);
|
||||
/*
|
||||
static int ListIntegerStringListIndexFromStringIndex(
|
||||
Tcl_Size *index, Tcl_Size *itemchars, Tcl_Size *totalitems);
|
||||
*/
|
||||
static Tcl_Obj* ListIntegerListStringRange(tclObjTypeInterfaceArgsStringRange);
|
||||
static Tcl_Obj* ListIntegerListStringRangeEnd(tclObjTypeInterfaceArgsStringRangeEnd);
|
||||
|
||||
static int ListIntegerListObjGetElements(tclObjTypeInterfaceArgsListAll);
|
||||
static int ListIntegerListObjAppendElement(tclObjTypeInterfaceArgsListAppend);
|
||||
static int ListIntegerListObjAppendList(tclObjTypeInterfaceArgsListAppendList);
|
||||
static int ListIntegerListObjIndex(tclObjTypeInterfaceArgsListIndex);
|
||||
static int ListIntegerListObjIndexEnd (tclObjTypeInterfaceArgsListIndexEnd);
|
||||
static int ListIntegerListObjIsSorted(tclObjTypeInterfaceArgsListIsSorted);
|
||||
static int ListIntegerListObjLength(tclObjTypeInterfaceArgsListLength);
|
||||
static Tcl_Obj* ListIntegerListObjRange(tclObjTypeInterfaceArgsListRange);
|
||||
static Tcl_Obj* ListIntegerListObjRangeEnd(tclObjTypeInterfaceArgsListRangeEnd);
|
||||
static int ListIntegerListObjReplace(tclObjTypeInterfaceArgsListReplace);
|
||||
static int ListIntegerListObjReplaceList(tclObjTypeInterfaceArgsListReplaceList);
|
||||
static int ListIntegerListObjSetElement(tclObjTypeInterfaceArgsListSet);
|
||||
static Tcl_Obj * ListIntegerLsetFlat(tclObjTypeInterfaceArgsListSetList);
|
||||
|
||||
static int ErrorMaxElementsExceeded(Tcl_Interp *interp);
|
||||
|
||||
|
||||
ObjInterface ListIntegerInterface = {
|
||||
1,
|
||||
{
|
||||
&ListIntegerListStringIndex,
|
||||
&ListIntegerListStringIndexEnd,
|
||||
&ListIntegerListStringLength,
|
||||
&ListIntegerListStringRange,
|
||||
&ListIntegerListStringRangeEnd
|
||||
},
|
||||
{
|
||||
&ListIntegerListObjGetElements,
|
||||
&ListIntegerListObjAppendElement,
|
||||
&ListIntegerListObjAppendList,
|
||||
&ListIntegerListObjIndex,
|
||||
&ListIntegerListObjIndexEnd,
|
||||
&ListIntegerListObjIsSorted,
|
||||
&ListIntegerListObjLength,
|
||||
&ListIntegerListObjRange,
|
||||
&ListIntegerListObjRangeEnd,
|
||||
&ListIntegerListObjReplace,
|
||||
&ListIntegerListObjReplaceList,
|
||||
NULL,
|
||||
&ListIntegerListObjSetElement,
|
||||
&ListIntegerLsetFlat
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
typedef struct ListInteger {
|
||||
int refCount;
|
||||
int ownstring;
|
||||
int size;
|
||||
int used;
|
||||
int values[1];
|
||||
} ListInteger;
|
||||
|
||||
|
||||
static ListInteger* NewTestListIntegerIntrep();
|
||||
static ListInteger* ListGetInternalRep(Tcl_Obj *listPtr);
|
||||
static void ListIntegerDecrRefCount(ListInteger *listIntegerPtr);
|
||||
|
||||
const ObjectType testListIntegerType = {
|
||||
"testListInteger",
|
||||
FreeTestListIntegerInternalRep, /* freeIntRepProc */
|
||||
DupTestListIntegerInternalRep, /* dupIntRepProc */
|
||||
UpdateStringOfTestListInteger, /* updateStringProc */
|
||||
SetTestListIntegerFromAny, /* setFromAnyProc */
|
||||
2,
|
||||
(Tcl_ObjInterface *)&ListIntegerInterface
|
||||
};
|
||||
|
||||
const Tcl_ObjType *testListIntegerTypePtr = (Tcl_ObjType *)&testListIntegerType;
|
||||
|
||||
|
||||
|
||||
int TcltestObjectInterfaceListIntegerInit(Tcl_Interp *interp) {
|
||||
Tcl_CreateObjCommand2(interp, "testlistinteger", TestListInteger, NULL, NULL);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
int TestListInteger(
|
||||
TCL_UNUSED(void *),
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Size argc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
int status;
|
||||
if (argc != 2) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # arguments", -1));
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
status = Tcl_ConvertToType(interp, objv[1], testListIntegerTypePtr);
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
Tcl_Obj*
|
||||
NewTestListInteger() {
|
||||
Tcl_ObjInternalRep intrep;
|
||||
Tcl_Obj *listPtr = Tcl_NewObj();
|
||||
Tcl_InvalidateStringRep(listPtr);
|
||||
ListInteger *listIntegerPtr = NewTestListIntegerIntrep();
|
||||
intrep.twoPtrValue.ptr1 = listIntegerPtr;
|
||||
Tcl_StoreInternalRep(listPtr, testListIntegerTypePtr, &intrep);
|
||||
return listPtr;
|
||||
}
|
||||
|
||||
|
||||
ListInteger*
|
||||
NewTestListIntegerIntrep() {
|
||||
ListInteger *listIntegerPtr = (ListInteger *)Tcl_Alloc(sizeof(ListInteger));
|
||||
listIntegerPtr->refCount = 1;
|
||||
listIntegerPtr->ownstring = 0;
|
||||
listIntegerPtr->size = 1;
|
||||
listIntegerPtr->used = 0;
|
||||
return listIntegerPtr;
|
||||
}
|
||||
|
||||
static ListInteger* ListGetInternalRep(Tcl_Obj *listPtr) {
|
||||
return (ListInteger *)listPtr->internalRep.twoPtrValue.ptr1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
static void DupTestListIntegerInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) {
|
||||
Tcl_ObjInternalRep intrep;
|
||||
ListInteger *listRepPtr = ListGetInternalRep(srcPtr);
|
||||
listRepPtr->refCount++;
|
||||
intrep.twoPtrValue.ptr1 = listRepPtr;
|
||||
Tcl_StoreInternalRep(copyPtr, testListIntegerTypePtr, &intrep);
|
||||
return;
|
||||
}
|
||||
|
||||
static void FreeTestListIntegerInternalRep(Tcl_Obj *listPtr) {
|
||||
ListInteger *listRepPtr = ListGetInternalRep(listPtr);
|
||||
ListIntegerDecrRefCount(listRepPtr);
|
||||
return;
|
||||
}
|
||||
|
||||
static int SetTestListIntegerFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
|
||||
int status;
|
||||
Tcl_Size i, length;
|
||||
Tcl_Obj *itemPtr, *listPtr;
|
||||
Tcl_ObjInternalRep intrep;
|
||||
ListInteger *listRepPtr;
|
||||
if (TclHasInternalRep(objPtr, testListIntegerTypePtr)) {
|
||||
return TCL_OK;
|
||||
} else {
|
||||
status = Tcl_ListObjLength(interp, objPtr, &length);
|
||||
if (status != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
listPtr = NewTestListInteger();
|
||||
for (i = 0; i < length; i++) {
|
||||
status = Tcl_ListObjIndex(interp, objPtr, i, &itemPtr);
|
||||
if (status != TCL_OK) {
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
return status;
|
||||
}
|
||||
status = ListIntegerListObjReplace(interp, listPtr, i, 0, 1, &itemPtr);
|
||||
if (status != TCL_OK) {
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
return status;
|
||||
}
|
||||
}
|
||||
listRepPtr = ListGetInternalRep(listPtr);
|
||||
intrep.twoPtrValue.ptr1 = listRepPtr;
|
||||
listRepPtr->refCount++;
|
||||
Tcl_StoreInternalRep(objPtr, testListIntegerTypePtr, &intrep);
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
|
||||
static void UpdateStringOfTestListInteger(Tcl_Obj *listPtr) {
|
||||
ListInteger *listRepPtr = ListGetInternalRep(listPtr);
|
||||
int i, num, used = listRepPtr->used;
|
||||
Tcl_Obj *strPtr, *numObjPtr;
|
||||
if (used > 0) {
|
||||
strPtr = Tcl_NewObj();
|
||||
Tcl_IncrRefCount(strPtr);
|
||||
num = listRepPtr->values[0];
|
||||
numObjPtr = Tcl_NewIntObj(num);
|
||||
Tcl_IncrRefCount(numObjPtr);
|
||||
Tcl_AppendFormatToObj(NULL, strPtr, "%d", 1, &numObjPtr);
|
||||
Tcl_DecrRefCount(numObjPtr);
|
||||
for (i = 1; i < used; i++) {
|
||||
num = listRepPtr->values[i];
|
||||
numObjPtr = Tcl_NewIntObj(num);
|
||||
Tcl_IncrRefCount(numObjPtr);
|
||||
Tcl_AppendFormatToObj(NULL, strPtr, " %d", 1, &numObjPtr);
|
||||
Tcl_DecrRefCount(numObjPtr);
|
||||
}
|
||||
listPtr->bytes = strPtr->bytes;
|
||||
listPtr->length = strPtr->length;
|
||||
strPtr->bytes = 0;
|
||||
strPtr->length = 0;
|
||||
Tcl_DecrRefCount(strPtr);
|
||||
} else {
|
||||
Tcl_InitStringRep(listPtr, NULL, 0);
|
||||
}
|
||||
listRepPtr->ownstring = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
static void ListIntegerDecrRefCount(ListInteger *listIntegerPtr) {
|
||||
if (--listIntegerPtr->refCount <= 0) {
|
||||
Tcl_Free(listIntegerPtr);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
static int ListIntegerListStringIndex (
|
||||
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
|
||||
TCL_UNUSED(Tcl_Obj *), /* List object to index into. */ \
|
||||
TCL_UNUSED(Tcl_Size), /* Index of element to return. */ \
|
||||
TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
|
||||
)
|
||||
{
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
static int ListIntegerListStringIndexEnd(
|
||||
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
|
||||
TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
|
||||
TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
|
||||
TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
|
||||
) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
static Tcl_Size ListIntegerListStringLength(
|
||||
TCL_UNUSED(Tcl_Obj *);
|
||||
) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
static int ListIntegerStringListIndexFromStringIndex(
|
||||
TCL_UNUSEDVAR(Tcl_Size *index),
|
||||
TCL_UNUSEDVAR(Tcl_Size *itemchars),
|
||||
TCL_UNUSEDVAR(Tcl_Size *totalitems)
|
||||
) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
*/
|
||||
|
||||
static Tcl_Obj* ListIntegerListStringRange(
|
||||
TCL_UNUSEDVAR(Tcl_Obj *objPtr), /* The Tcl object to find the range of. */
|
||||
TCL_UNUSEDVAR(Tcl_Size first), /* First index of the range. */
|
||||
TCL_UNUSEDVAR(Tcl_Size last) /* Last index of the range. */
|
||||
) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static Tcl_Obj* ListIntegerListStringRangeEnd(
|
||||
TCL_UNUSED(Tcl_Obj *),/* The Tcl object to find the range of. */
|
||||
TCL_UNUSED(Tcl_Size),/* First index of the range. */
|
||||
TCL_UNUSED(Tcl_Size) /* Last index of the range. */
|
||||
) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static int ListIntegerListObjGetElements(
|
||||
TCL_UNUSEDVAR(Tcl_Interp *interp), /* Used to report errors if not NULL. */
|
||||
TCL_UNUSEDVAR(Tcl_Obj *listPtr), /* List object for which an element array
|
||||
* is to be returned. */
|
||||
TCL_UNUSEDVAR(Tcl_Size *objcPtr), /* Where to store the count of objects
|
||||
* referenced by objv. */
|
||||
TCL_UNUSEDVAR(Tcl_Obj ***objvPtr) /* Where to store the pointer to an
|
||||
* array of */
|
||||
) {
|
||||
ListInteger *listRepPtr;
|
||||
listRepPtr = ListGetInternalRep(listPtr);
|
||||
*objcPtr = listRepPtr->used;
|
||||
*objvPtr = listRepPtr->values;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static int ListIntegerListObjAppendElement(tclObjTypeInterfaceArgsListAppend) {
|
||||
int status;
|
||||
Tcl_Size length;
|
||||
status = Tcl_ListObjLength(interp, listPtr, &length);
|
||||
if (status != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
return ListIntegerListObjReplace(interp, listPtr, length, 0, 1, &objPtr);
|
||||
}
|
||||
|
||||
static int ListIntegerListObjAppendList(
|
||||
TCL_UNUSEDVAR(Tcl_Interp *interp), /* Used to report errors if not NULL. */ \
|
||||
TCL_UNUSEDVAR(Tcl_Obj *listPtr), /* List object to append elements to. */ \
|
||||
TCL_UNUSEDVAR(Tcl_Obj *elemListPtr) /* List obj with elements to append. */
|
||||
) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
static int ListIntegerListObjIndex(
|
||||
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
|
||||
Tcl_Obj * listObj,/* List object to index into. */ \
|
||||
Tcl_Size index, /* Index of element to return. */ \
|
||||
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
|
||||
) {
|
||||
ListInteger *listRepPtr = ListGetInternalRep(listObj);
|
||||
Tcl_Size num;
|
||||
if (index >= 0 && index < listRepPtr->used) {
|
||||
num = listRepPtr->values[index];
|
||||
*objPtrPtr = Tcl_NewLongObj(num);
|
||||
} else {
|
||||
*objPtrPtr = NULL;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static int ListIntegerListObjIndexEnd(
|
||||
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
|
||||
TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
|
||||
TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
|
||||
TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
|
||||
) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
static int ListIntegerListObjIsSorted(
|
||||
TCL_UNUSED(Tcl_Interp *), /* Used to report errors */
|
||||
TCL_UNUSED(Tcl_Obj *), /* The list in question */
|
||||
TCL_UNUSED(size_t) /* flags */
|
||||
) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
static int ListIntegerListObjLength(
|
||||
TCL_UNUSED(Tcl_Interp *), /* Used to report errors if not NULL. */
|
||||
Tcl_Obj * listObj, /* List object whose #elements to return. */
|
||||
Tcl_Size *lenPtr /* The resulting length is stored here. */
|
||||
) {
|
||||
ListInteger *listRepPtr = ListGetInternalRep(listObj);
|
||||
*lenPtr = listRepPtr->used;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static Tcl_Obj* ListIntegerListObjRange(tclObjTypeInterfaceArgsListRange) {
|
||||
ListInteger *listRepPtr = ListGetInternalRep(listObj);
|
||||
Tcl_Size i, j, num, used = listRepPtr->used;
|
||||
Tcl_Obj *numObjPtr, *resPtr;
|
||||
|
||||
if ((rangeStart == 0 && rangeEnd >= used - 1) || used == 0) {
|
||||
return listObj;
|
||||
}
|
||||
|
||||
if (Tcl_IsShared(listObj) ||
|
||||
((listRepPtr->refCount > 1))) {
|
||||
if (rangeStart >= used || rangeEnd < rangeStart) {
|
||||
return Tcl_NewObj();
|
||||
} else {
|
||||
resPtr = NewTestListInteger();
|
||||
for (i = rangeStart, j = 0; i <= rangeEnd; i++, j++) {
|
||||
num = listRepPtr->values[i];
|
||||
numObjPtr = Tcl_NewIntObj(num);
|
||||
Tcl_IncrRefCount(numObjPtr);
|
||||
if (ListIntegerListObjReplace(
|
||||
interp, resPtr, j , 0 , 1 ,&numObjPtr) != TCL_OK) {
|
||||
Tcl_DecrRefCount(resPtr);
|
||||
Tcl_DecrRefCount(numObjPtr);
|
||||
return NULL;
|
||||
}
|
||||
Tcl_DecrRefCount(numObjPtr);
|
||||
}
|
||||
return resPtr;
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
static Tcl_Obj* ListIntegerListObjRangeEnd(
|
||||
TCL_UNUSEDVAR(Tcl_Interp * interp), /* Used to report errors */ \
|
||||
TCL_UNUSEDVAR(Tcl_Obj *listPtr), /* List object to take a range from. */ \
|
||||
TCL_UNUSEDVAR(Tcl_Size fromAnchor),/* 0 for start and 1 for end */ \
|
||||
TCL_UNUSEDVAR(Tcl_Size fromIdx), /* Index of first element to include. */ \
|
||||
TCL_UNUSEDVAR(Tcl_Size toAnchor), /* 0 for start and 1 for end */ \
|
||||
TCL_UNUSEDVAR(Tcl_Size toIdx) /* Index of last element to include. */
|
||||
) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
static int ListIntegerListObjReplace(tclObjTypeInterfaceArgsListReplace) {
|
||||
int i, status;
|
||||
Tcl_Obj *tmpListPtr = Tcl_NewObj();
|
||||
Tcl_IncrRefCount(tmpListPtr);
|
||||
for (i = 0; i < numToInsert; i++) {
|
||||
status = Tcl_ListObjAppendElement(interp, tmpListPtr, insertObjs[i]);
|
||||
if (status != TCL_OK) {
|
||||
Tcl_DecrRefCount(tmpListPtr);
|
||||
return status;
|
||||
}
|
||||
}
|
||||
status = ListIntegerListObjReplaceList(
|
||||
interp, listObj, first, numToDelete, tmpListPtr);
|
||||
Tcl_DecrRefCount(tmpListPtr);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
static int ListIntegerListObjReplaceList(tclObjTypeInterfaceArgsListReplaceList) {
|
||||
ListInteger *listRepPtr = ListGetInternalRep(listPtr);
|
||||
ListInteger *newListRepPtr;
|
||||
int changed = 0, itemInt, status;
|
||||
Tcl_Size i, index, newmemsize, itemsLength, j, newsize,
|
||||
newtailindex, newused, size, newtailend, tailindex, tailsize,
|
||||
used;
|
||||
Tcl_Obj *itemPtr;
|
||||
size = listRepPtr->size;
|
||||
used = listRepPtr->used;
|
||||
if (first < used) {
|
||||
tailsize = used - first;
|
||||
} else {
|
||||
tailsize = 0;
|
||||
}
|
||||
|
||||
status = Tcl_ListObjLength(interp, newItemsPtr, &itemsLength);
|
||||
if (status != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* Currently this duplicates checks found in of Tcl_ListObjReplace, but
|
||||
* maybe in the future Tcl remove those checks
|
||||
*/
|
||||
|
||||
if (first >= used) {
|
||||
first = used;
|
||||
} else if (first < 0) {
|
||||
first = 0;
|
||||
}
|
||||
|
||||
if (count > tailsize) {
|
||||
count = tailsize;
|
||||
}
|
||||
|
||||
/* If count == 0 and itemsLength == 0 this routine is logically a no-op,
|
||||
* but any non-canonical string representation must still be invalidated.
|
||||
*/
|
||||
|
||||
/* to do:
|
||||
* Recode this routine to work with incoming of unbounded length
|
||||
*/
|
||||
|
||||
if (used > 0) {
|
||||
tailindex = first + count;
|
||||
newtailindex = first + itemsLength;
|
||||
if (INT_MAX - tailsize - 1 < newtailindex) {
|
||||
return ErrorMaxElementsExceeded(interp);
|
||||
}
|
||||
newused = newtailindex + tailsize;
|
||||
if (itemsLength > 0 && INT_MAX - itemsLength < newused) {
|
||||
return ErrorMaxElementsExceeded(interp);
|
||||
}
|
||||
} else {
|
||||
tailindex = 0;
|
||||
newtailindex = 0;
|
||||
newused = itemsLength;
|
||||
}
|
||||
|
||||
if (newused > size && newused > 1) {
|
||||
newsize = (newused + newused / 5 + 1);
|
||||
if (newsize < size) {
|
||||
return ErrorMaxElementsExceeded(interp);
|
||||
}
|
||||
} else {
|
||||
newsize = size;
|
||||
}
|
||||
|
||||
if (!listRepPtr->ownstring) {
|
||||
/* schedule canonicalization of the string rep */
|
||||
Tcl_InvalidateStringRep(listPtr);
|
||||
listRepPtr->ownstring = 1;
|
||||
}
|
||||
|
||||
if (newused < used) {
|
||||
Tcl_InvalidateStringRep(listPtr);
|
||||
}
|
||||
|
||||
|
||||
newmemsize = sizeof(ListInteger) + newsize * sizeof(int) - sizeof(int);
|
||||
if (listRepPtr->refCount > 1) {
|
||||
Tcl_ObjInternalRep intrep;
|
||||
/* copy only the structure and the head of the old array */
|
||||
int movsize = sizeof(ListInteger)
|
||||
+ ((first + 1) * sizeof(int) - sizeof(int));
|
||||
newListRepPtr = (ListInteger *)Tcl_Alloc(newmemsize);
|
||||
memmove(newListRepPtr, listRepPtr, movsize);
|
||||
newListRepPtr->size = newsize;
|
||||
newListRepPtr->refCount = 1;
|
||||
/* move the tail to its new location to make room for the new additions
|
||||
*/
|
||||
memmove(newListRepPtr->values + newtailindex,
|
||||
listRepPtr->values + tailindex, tailsize * sizeof(int));
|
||||
intrep.twoPtrValue.ptr1 = newListRepPtr;
|
||||
Tcl_StoreInternalRep(listPtr, testListIntegerTypePtr, &intrep);
|
||||
} else {
|
||||
if (newsize > size && newused > 1) {
|
||||
newListRepPtr = (ListInteger *)Tcl_Realloc(listRepPtr, newmemsize);
|
||||
} else {
|
||||
newListRepPtr = listRepPtr;
|
||||
}
|
||||
newListRepPtr->size = newsize;
|
||||
if (tailsize > 0 && tailindex != newtailindex) {
|
||||
/* move the tail to its new location to make room for the new
|
||||
* additions */
|
||||
memmove(newListRepPtr->values + newtailindex,
|
||||
newListRepPtr->values + tailindex, tailsize);
|
||||
}
|
||||
listPtr->internalRep.twoPtrValue.ptr1 = newListRepPtr;
|
||||
}
|
||||
|
||||
i = -1;
|
||||
while (1) {
|
||||
i++;
|
||||
index = first + i;
|
||||
status = Tcl_ListObjIndex(interp, newItemsPtr, i, &itemPtr);
|
||||
if (status != TCL_OK) {
|
||||
return status;
|
||||
}
|
||||
if (itemPtr == NULL) {
|
||||
break;
|
||||
}
|
||||
if (Tcl_GetIntFromObj(interp, itemPtr, &itemInt)
|
||||
== TCL_OK) {
|
||||
if (newListRepPtr->values[index] != itemInt) {
|
||||
changed = 1;
|
||||
newListRepPtr->values[index] = itemInt;
|
||||
}
|
||||
newListRepPtr->values[index] = itemInt;
|
||||
} else {
|
||||
Tcl_Obj *realListPtr;
|
||||
/* Fall back to normal list */
|
||||
realListPtr = Tcl_NewListObj(newsize, NULL);
|
||||
Tcl_IncrRefCount(realListPtr);
|
||||
|
||||
for (j = 0; j < index; j++) {
|
||||
itemPtr = Tcl_NewIntObj(newListRepPtr->values[j]);
|
||||
status = Tcl_ListObjAppendElement(
|
||||
interp, realListPtr, itemPtr);
|
||||
if (status != TCL_OK) {
|
||||
Tcl_DecrRefCount(realListPtr);
|
||||
return status;
|
||||
}
|
||||
}
|
||||
while (1) {
|
||||
if (itemsLength == TCL_LENGTH_NONE) {
|
||||
status = Tcl_ListObjLength(interp, newItemsPtr, &itemsLength);
|
||||
if (status != TCL_OK) {
|
||||
Tcl_DecrRefCount(realListPtr);
|
||||
return status;
|
||||
}
|
||||
}
|
||||
if (itemsLength != TCL_LENGTH_NONE && i >= itemsLength) {
|
||||
break;
|
||||
}
|
||||
status = Tcl_ListObjIndex(interp, newItemsPtr, i, &itemPtr);
|
||||
if (status != TCL_OK) {
|
||||
Tcl_DecrRefCount(realListPtr);
|
||||
return status;
|
||||
}
|
||||
if (itemPtr == NULL) {
|
||||
break;
|
||||
}
|
||||
status = Tcl_ListObjAppendElement(
|
||||
interp, realListPtr, itemPtr);
|
||||
if (status != TCL_OK) {
|
||||
Tcl_DecrRefCount(realListPtr);
|
||||
return status;
|
||||
}
|
||||
i++;
|
||||
}
|
||||
|
||||
newtailend = newtailindex + tailsize;
|
||||
for (i = newtailindex; i < newtailend; i++) {
|
||||
itemPtr = Tcl_NewIntObj(newListRepPtr->values[i]);
|
||||
Tcl_ListObjAppendElement(interp, realListPtr, itemPtr);
|
||||
if (status != TCL_OK) {
|
||||
Tcl_DecrRefCount(realListPtr);
|
||||
return status;
|
||||
}
|
||||
}
|
||||
|
||||
ListIntegerDecrRefCount(newListRepPtr);
|
||||
listPtr->internalRep = realListPtr->internalRep;
|
||||
listPtr->typePtr = realListPtr->typePtr;
|
||||
realListPtr->typePtr = NULL;
|
||||
Tcl_DecrRefCount(realListPtr);
|
||||
/* this might not always be necessary, but probably the best that
|
||||
* can be done in this case */
|
||||
Tcl_InvalidateStringRep(listPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
|
||||
if (changed) {
|
||||
Tcl_InvalidateStringRep(listPtr);
|
||||
}
|
||||
|
||||
/* To make the operation transactional, update "used" only after all
|
||||
* elemnts have been succesfully added.
|
||||
*/
|
||||
newListRepPtr->used = newused;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
static int ListIntegerListObjSetElement(
|
||||
TCL_UNUSED(Tcl_Interp *), /* Tcl interpreter; used for error reporting
|
||||
* if not NULL. */
|
||||
TCL_UNUSED(Tcl_Obj *), /* List object in which element should be
|
||||
* stored. */
|
||||
TCL_UNUSED(Tcl_Size), /* Index of element to store. */
|
||||
TCL_UNUSED(Tcl_Obj *) /* Tcl object to store in the designated list
|
||||
* element. */
|
||||
) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
static Tcl_Obj * ListIntegerLsetFlat(
|
||||
TCL_UNUSED(Tcl_Interp *), /* Tcl interpreter. */ \
|
||||
TCL_UNUSED(Tcl_Obj *), /* Pointer to the list being modified. */ \
|
||||
TCL_UNUSED(Tcl_Size), /* Number of index args. */ \
|
||||
TCL_UNUSEDVAR(Tcl_Obj *const indexArray[]), /* Index args. */ \
|
||||
TCL_UNUSED(Tcl_Obj *)/* Value arg to 'lset' or NULL to 'lpop'. */
|
||||
) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
static int ErrorMaxElementsExceeded(Tcl_Interp *interp) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"max length of a Tcl list (%" TCL_T_MODIFIER "d elements) exceeded",
|
||||
LIST_MAX));
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -1,7 +1,13 @@
|
||||
#ifndef BN_TCL_H_
|
||||
#define BN_TCL_H_
|
||||
|
||||
#include <stdint.h>
|
||||
#ifdef MP_NO_STDINT
|
||||
# ifdef HAVE_STDINT_H
|
||||
# include <stdint.h>
|
||||
# else
|
||||
# include "../compat/stdint.h"
|
||||
# endif
|
||||
#endif
|
||||
#if defined(TCL_NO_TOMMATH_H)
|
||||
typedef size_t mp_digit;
|
||||
typedef int mp_sign;
|
||||
|
||||
+2
-16
@@ -195,7 +195,6 @@ static const unsigned short pageMap[] = {
|
||||
1344, 1344, 1344, 10112, 10144, 1344, 10176, 1344, 10208, 10240, 10272,
|
||||
10304, 10336, 10368, 1344, 1344, 1344, 10400, 10432, 64, 10464, 10496,
|
||||
10528, 4736, 10560, 10592
|
||||
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
|
||||
,10624, 10656, 10688, 3296, 1344, 1344, 1344, 10720, 10752, 10784,
|
||||
10816, 10848, 10880, 10912, 10944, 10976, 3296, 3296, 3296, 3296, 9216,
|
||||
1344, 11008, 11040, 1344, 11072, 11104, 11136, 11168, 1344, 11200,
|
||||
@@ -568,8 +567,6 @@ static const unsigned short pageMap[] = {
|
||||
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
|
||||
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
|
||||
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15520
|
||||
|
||||
#endif /* TCL_UTF_MAX > 3 */
|
||||
};
|
||||
|
||||
/*
|
||||
@@ -1180,7 +1177,6 @@ static const unsigned char groupMap[] = {
|
||||
15, 15, 15, 0, 0, 15, 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14,
|
||||
7, 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14,
|
||||
0, 0
|
||||
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
|
||||
,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
|
||||
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
|
||||
15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
|
||||
@@ -1653,8 +1649,6 @@ static const unsigned char groupMap[] = {
|
||||
15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
|
||||
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
|
||||
|
||||
#endif /* TCL_UTF_MAX > 3 */
|
||||
};
|
||||
|
||||
/*
|
||||
@@ -1702,11 +1696,7 @@ static const int groups[] = {
|
||||
18, 17, 10305, 10370, 10049, 10114, 8769, 8834
|
||||
};
|
||||
|
||||
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
|
||||
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
|
||||
#else
|
||||
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0)
|
||||
#endif
|
||||
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
|
||||
|
||||
/*
|
||||
* The following constants are used to determine the category of a
|
||||
@@ -1761,8 +1751,4 @@ enum {
|
||||
* Unicode character tables.
|
||||
*/
|
||||
|
||||
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
|
||||
# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
|
||||
#else
|
||||
# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
|
||||
#endif
|
||||
# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
|
||||
|
||||
+12
-172
@@ -215,9 +215,7 @@ Tcl_UniCharToUtf(
|
||||
* character (at most 4 bytes).
|
||||
*/
|
||||
{
|
||||
#if TCL_UTF_MAX > 3
|
||||
int flags = ch;
|
||||
#endif
|
||||
|
||||
if (ch >= TCL_COMBINE) {
|
||||
ch &= (TCL_COMBINE - 1);
|
||||
@@ -234,9 +232,7 @@ Tcl_UniCharToUtf(
|
||||
}
|
||||
if (ch <= 0xFFFF) {
|
||||
if (
|
||||
#if TCL_UTF_MAX > 3
|
||||
(flags & TCL_COMBINE) &&
|
||||
#endif
|
||||
((ch & 0xF800) == 0xD800)) {
|
||||
if (ch & 0x0400) {
|
||||
/* Low surrogate */
|
||||
@@ -349,15 +345,6 @@ Tcl_UniCharToUtfDString(
|
||||
p = string;
|
||||
wEnd = uniStr + uniLength;
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Initialize the buffer so that some random data doesn't trick
|
||||
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
|
||||
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
|
||||
* prior non-stateful nature, this call to memset can also be removed.
|
||||
*/
|
||||
memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength);
|
||||
#endif
|
||||
|
||||
for (w = uniStr; w < wEnd; ) {
|
||||
p += Tcl_UniCharToUtf(*w, p);
|
||||
w++;
|
||||
@@ -402,15 +389,6 @@ Tcl_Char16ToUtfDString(
|
||||
p = string;
|
||||
wEnd = uniStr + uniLength;
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Initialize the buffer so that some random data doesn't trick
|
||||
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
|
||||
* Because TCL_COMBINE is used here, memset() is required even when
|
||||
* TCL_UTF_MAX == 4.
|
||||
*/
|
||||
memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength);
|
||||
#endif
|
||||
|
||||
for (w = uniStr; w < wEnd; ) {
|
||||
if (!len && ((*w & 0xFC00) != 0xDC00)) {
|
||||
/* Special case for handling high surrogates. */
|
||||
@@ -447,15 +425,6 @@ Tcl_Char16ToUtfDString(
|
||||
* Tcl_UtfCharComplete() before calling this routine to ensure that
|
||||
* enough bytes remain in the string.
|
||||
*
|
||||
* If TCL_UTF_MAX < 4, special handling of Surrogate pairs is done:
|
||||
* For any UTF-8 string containing a character outside of the BMP, the
|
||||
* first call to this function will fill *chPtr with the high surrogate
|
||||
* and generate a return value of 1. Calling Tcl_UtfToUniChar again
|
||||
* will produce the low surrogate and a return value of 3. Because *chPtr
|
||||
* is used to remember whether the high surrogate is already produced, it
|
||||
* is recommended to initialize the variable it points to as 0 before
|
||||
* the first call to Tcl_UtfToUniChar is done.
|
||||
*
|
||||
* Results:
|
||||
* *chPtr is filled with the Tcl_UniChar, and the return value is the
|
||||
* number of bytes from the UTF-8 string that were consumed.
|
||||
@@ -715,11 +684,11 @@ Tcl_UtfToUniCharDString(
|
||||
endPtr = src + length;
|
||||
optPtr = endPtr - 4;
|
||||
while (p <= optPtr) {
|
||||
p += TclUtfToUCS4(p, &ch);
|
||||
p += Tcl_UtfToUniChar(p, &ch);
|
||||
*w++ = ch;
|
||||
}
|
||||
while ((p < endPtr) && Tcl_UtfCharComplete(p, endPtr-p)) {
|
||||
p += TclUtfToUCS4(p, &ch);
|
||||
p += Tcl_UtfToUniChar(p, &ch);
|
||||
*w++ = ch;
|
||||
}
|
||||
while (p < endPtr) {
|
||||
@@ -965,7 +934,7 @@ Tcl_UtfFindFirst(
|
||||
int ch) /* The Unicode character to search for. */
|
||||
{
|
||||
while (1) {
|
||||
int find, len = TclUtfToUCS4(src, &find);
|
||||
int find, len = Tcl_UtfToUniChar(src, &find);
|
||||
|
||||
if (find == ch) {
|
||||
return src;
|
||||
@@ -1004,7 +973,7 @@ Tcl_UtfFindLast(
|
||||
const char *last = NULL;
|
||||
|
||||
while (1) {
|
||||
int find, len = TclUtfToUCS4(src, &find);
|
||||
int find, len = Tcl_UtfToUniChar(src, &find);
|
||||
|
||||
if (find == ch) {
|
||||
last = src;
|
||||
@@ -1227,13 +1196,7 @@ Tcl_UniCharAtIndex(
|
||||
i = TclUtfToUniChar(src, &ch);
|
||||
src += i;
|
||||
}
|
||||
#if TCL_UTF_MAX < 4
|
||||
if ((ch >= 0xD800) && (i < 3)) {
|
||||
/* Index points at character following high Surrogate */
|
||||
return -1;
|
||||
}
|
||||
#endif
|
||||
TclUtfToUCS4(src, &i);
|
||||
Tcl_UtfToUniChar(src, &i);
|
||||
return i;
|
||||
}
|
||||
|
||||
@@ -1242,10 +1205,8 @@ Tcl_UniCharAtIndex(
|
||||
*
|
||||
* Tcl_UtfAtIndex --
|
||||
*
|
||||
* Returns a pointer to the specified character (not byte) position in
|
||||
* the UTF-8 string. If TCL_UTF_MAX < 4, characters > U+FFFF count as
|
||||
* 2 positions, but then the pointer should never be placed between
|
||||
* the two positions.
|
||||
* Returns a pointer to the specified character (not byte) position in the
|
||||
* UTF-8 string.
|
||||
*
|
||||
* Results:
|
||||
* As above.
|
||||
@@ -1377,7 +1338,7 @@ Tcl_UtfToUpper(
|
||||
|
||||
src = dst = str;
|
||||
while (*src) {
|
||||
len = TclUtfToUCS4(src, &ch);
|
||||
len = Tcl_UtfToUniChar(src, &ch);
|
||||
upChar = Tcl_UniCharToUpper(ch);
|
||||
|
||||
/*
|
||||
@@ -1430,7 +1391,7 @@ Tcl_UtfToLower(
|
||||
|
||||
src = dst = str;
|
||||
while (*src) {
|
||||
len = TclUtfToUCS4(src, &ch);
|
||||
len = Tcl_UtfToUniChar(src, &ch);
|
||||
lowChar = Tcl_UniCharToLower(ch);
|
||||
|
||||
/*
|
||||
@@ -1486,7 +1447,7 @@ Tcl_UtfToTitle(
|
||||
src = dst = str;
|
||||
|
||||
if (*src) {
|
||||
len = TclUtfToUCS4(src, &ch);
|
||||
len = Tcl_UtfToUniChar(src, &ch);
|
||||
titleChar = Tcl_UniCharToTitle(ch);
|
||||
|
||||
if (len < TclUtfCount(titleChar)) {
|
||||
@@ -1498,7 +1459,7 @@ Tcl_UtfToTitle(
|
||||
src += len;
|
||||
}
|
||||
while (*src) {
|
||||
len = TclUtfToUCS4(src, &ch);
|
||||
len = Tcl_UtfToUniChar(src, &ch);
|
||||
lowChar = ch;
|
||||
/* Special exception for Georgian Asomtavruli chars, no titlecase. */
|
||||
if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
|
||||
@@ -1605,16 +1566,6 @@ Tcl_UtfNcmp(
|
||||
cs += TclUtfToUniChar(cs, &ch1);
|
||||
ct += TclUtfToUniChar(ct, &ch2);
|
||||
if (ch1 != ch2) {
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Surrogates always report higher than non-surrogates */
|
||||
if (((ch1 & 0xFC00) == 0xD800)) {
|
||||
if ((ch2 & 0xFC00) != 0xD800) {
|
||||
return ch1;
|
||||
}
|
||||
} else if ((ch2 & 0xFC00) == 0xD800) {
|
||||
return -ch2;
|
||||
}
|
||||
#endif
|
||||
return (ch1 - ch2);
|
||||
}
|
||||
}
|
||||
@@ -1656,16 +1607,6 @@ Tcl_UtfNcasecmp(
|
||||
cs += TclUtfToUniChar(cs, &ch1);
|
||||
ct += TclUtfToUniChar(ct, &ch2);
|
||||
if (ch1 != ch2) {
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Surrogates always report higher than non-surrogates */
|
||||
if (((ch1 & 0xFC00) == 0xD800)) {
|
||||
if ((ch2 & 0xFC00) != 0xD800) {
|
||||
return ch1;
|
||||
}
|
||||
} else if ((ch2 & 0xFC00) == 0xD800) {
|
||||
return -ch2;
|
||||
}
|
||||
#endif
|
||||
ch1 = Tcl_UniCharToLower(ch1);
|
||||
ch2 = Tcl_UniCharToLower(ch2);
|
||||
if (ch1 != ch2) {
|
||||
@@ -1705,16 +1646,6 @@ TclUtfCmp(
|
||||
cs += TclUtfToUniChar(cs, &ch1);
|
||||
ct += TclUtfToUniChar(ct, &ch2);
|
||||
if (ch1 != ch2) {
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Surrogates always report higher than non-surrogates */
|
||||
if (((ch1 & 0xFC00) == 0xD800)) {
|
||||
if ((ch2 & 0xFC00) != 0xD800) {
|
||||
return ch1;
|
||||
}
|
||||
} else if ((ch2 & 0xFC00) == 0xD800) {
|
||||
return -ch2;
|
||||
}
|
||||
#endif
|
||||
return ch1 - ch2;
|
||||
}
|
||||
}
|
||||
@@ -1751,16 +1682,6 @@ TclUtfCasecmp(
|
||||
cs += TclUtfToUniChar(cs, &ch1);
|
||||
ct += TclUtfToUniChar(ct, &ch2);
|
||||
if (ch1 != ch2) {
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* Surrogates always report higher than non-surrogates */
|
||||
if (((ch1 & 0xFC00) == 0xD800)) {
|
||||
if ((ch2 & 0xFC00) != 0xD800) {
|
||||
return ch1;
|
||||
}
|
||||
} else if ((ch2 & 0xFC00) == 0xD800) {
|
||||
return -ch2;
|
||||
}
|
||||
#endif
|
||||
ch1 = Tcl_UniCharToLower(ch1);
|
||||
ch2 = Tcl_UniCharToLower(ch2);
|
||||
if (ch1 != ch2) {
|
||||
@@ -1959,7 +1880,7 @@ TclUniCharNcmp(
|
||||
const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
|
||||
size_t numChars) /* Number of unichars to compare. */
|
||||
{
|
||||
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
|
||||
#if defined(WORDS_BIGENDIAN)
|
||||
/*
|
||||
* We are definitely on a big-endian machine; memcmp() is safe
|
||||
*/
|
||||
@@ -1973,14 +1894,6 @@ TclUniCharNcmp(
|
||||
|
||||
for ( ; numChars != 0; ucs++, uct++, numChars--) {
|
||||
if (*ucs != *uct) {
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* special case for handling upper surrogates */
|
||||
if (((*ucs & 0xFC00) == 0xD800) && ((*uct & 0xFC00) != 0xD800)) {
|
||||
return 1;
|
||||
} else if (((*uct & 0xFC00) == 0xD800)) {
|
||||
return -1;
|
||||
}
|
||||
#endif
|
||||
return (*ucs - *uct);
|
||||
}
|
||||
}
|
||||
@@ -2018,14 +1931,6 @@ TclUniCharNcasecmp(
|
||||
Tcl_UniChar lct = Tcl_UniCharToLower(*uct);
|
||||
|
||||
if (lcs != lct) {
|
||||
#if TCL_UTF_MAX < 4
|
||||
/* special case for handling upper surrogates */
|
||||
if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) {
|
||||
return 1;
|
||||
} else if (((lct & 0xFC00) == 0xD800)) {
|
||||
return -1;
|
||||
}
|
||||
#endif
|
||||
return (lcs - lct);
|
||||
}
|
||||
}
|
||||
@@ -2752,71 +2657,6 @@ TclUniCharMatch(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*---------------------------------------------------------------------------
|
||||
*
|
||||
* TclUtfToUCS4 --
|
||||
*
|
||||
* Extracts the 4-byte codepoint from the leading bytes of the
|
||||
* Modified UTF-8 string "src". This is a utility routine to
|
||||
* contain the surrogate gymnastics in one place.
|
||||
*
|
||||
* The caller must ensure that the source buffer is long enough that this
|
||||
* routine does not run off the end and dereference non-existent memory
|
||||
* looking for trail bytes. If the source buffer is known to be '\0'
|
||||
* terminated, this cannot happen. Otherwise, the caller should call
|
||||
* Tcl_UtfCharComplete() before calling this routine to ensure that
|
||||
* enough bytes remain in the string.
|
||||
*
|
||||
* Results:
|
||||
* Fills *usc4Ptr with the UCS4 code point and returns the number of bytes
|
||||
* consumed from the source string.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*---------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
int
|
||||
TclUtfToUCS4(
|
||||
const char *src, /* The UTF-8 string. */
|
||||
int *ucs4Ptr) /* Filled with the UCS4 codepoint represented
|
||||
* by the UTF-8 string. */
|
||||
{
|
||||
/* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */
|
||||
return Tcl_UtfToUniChar(src, ucs4Ptr);
|
||||
}
|
||||
|
||||
int
|
||||
TclUniCharToUCS4(
|
||||
const Tcl_UniChar *src, /* The Tcl_UniChar string. */
|
||||
int *ucs4Ptr) /* Filled with the UCS4 codepoint represented
|
||||
* by the Tcl_UniChar string. */
|
||||
{
|
||||
if (((src[0] & 0xFC00) == 0xD800) && ((src[1] & 0xFC00) == 0xDC00)) {
|
||||
*ucs4Ptr = (((src[0] & 0x3FF) << 10) | (src[1] & 0x3FF)) + 0x10000;
|
||||
return 2;
|
||||
}
|
||||
*ucs4Ptr = src[0];
|
||||
return 1;
|
||||
}
|
||||
|
||||
const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *src, const Tcl_UniChar *ptr) {
|
||||
if (src <= ptr + 1) {
|
||||
return ptr;
|
||||
}
|
||||
if (((src[-1] & 0xFC00) == 0xDC00) && ((src[-2] & 0xFC00) == 0xD800)) {
|
||||
return src - 2;
|
||||
}
|
||||
return src - 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
|
||||
+75
-61
@@ -129,16 +129,10 @@ static const Tcl_ObjType endOffsetType = {
|
||||
NULL, /* dupIntRepProc */
|
||||
NULL, /* updateStringProc */
|
||||
NULL, /* setFromAnyProc */
|
||||
TCL_OBJTYPE_V1(TclLengthOne)
|
||||
0
|
||||
};
|
||||
|
||||
Tcl_Size
|
||||
TclLengthOne(
|
||||
TCL_UNUSED(Tcl_Obj *))
|
||||
{
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* * STRING REPRESENTATION OF LISTS * * *
|
||||
*
|
||||
@@ -1572,8 +1566,7 @@ Tcl_Merge(
|
||||
{
|
||||
#define LOCAL_SIZE 64
|
||||
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
|
||||
Tcl_Size i;
|
||||
size_t bytesNeeded = 0;
|
||||
Tcl_Size i, bytesNeeded = 0;
|
||||
char *result, *dst;
|
||||
|
||||
/*
|
||||
@@ -1582,9 +1575,6 @@ Tcl_Merge(
|
||||
*/
|
||||
|
||||
if (argc <= 0) {
|
||||
if (argc < 0) {
|
||||
Tcl_Panic("Tcl_Merge called with negative argc (%" TCL_SIZE_MODIFIER "d)", argc);
|
||||
}
|
||||
result = (char *)Tcl_Alloc(1);
|
||||
result[0] = '\0';
|
||||
return result;
|
||||
@@ -1672,7 +1662,7 @@ TclTrimRight(
|
||||
pp = Tcl_UtfPrev(p, bytes);
|
||||
do {
|
||||
pp += pInc;
|
||||
pInc = TclUtfToUCS4(pp, &ch1);
|
||||
pInc = Tcl_UtfToUniChar(pp, &ch1);
|
||||
} while (pp + pInc < p);
|
||||
|
||||
/*
|
||||
@@ -1680,7 +1670,7 @@ TclTrimRight(
|
||||
*/
|
||||
|
||||
do {
|
||||
pInc = TclUtfToUCS4(q, &ch2);
|
||||
pInc = Tcl_UtfToUniChar(q, &ch2);
|
||||
|
||||
if (ch1 == ch2) {
|
||||
break;
|
||||
@@ -1745,7 +1735,7 @@ TclTrimLeft(
|
||||
*/
|
||||
|
||||
do {
|
||||
Tcl_Size pInc = TclUtfToUCS4(p, &ch1);
|
||||
Tcl_Size pInc = Tcl_UtfToUniChar(p, &ch1);
|
||||
const char *q = trim;
|
||||
Tcl_Size bytesLeft = numTrim;
|
||||
|
||||
@@ -1754,7 +1744,7 @@ TclTrimLeft(
|
||||
*/
|
||||
|
||||
do {
|
||||
Tcl_Size qInc = TclUtfToUCS4(q, &ch2);
|
||||
Tcl_Size qInc = Tcl_UtfToUniChar(q, &ch2);
|
||||
|
||||
if (ch1 == ch2) {
|
||||
break;
|
||||
@@ -1821,7 +1811,7 @@ TclTrim(
|
||||
if (numBytes > 0) {
|
||||
int ch;
|
||||
const char *first = bytes + trimLeft;
|
||||
bytes += TclUtfToUCS4(first, &ch);
|
||||
bytes += Tcl_UtfToUniChar(first, &ch);
|
||||
numBytes -= (bytes - first);
|
||||
|
||||
if (numBytes > 0) {
|
||||
@@ -1977,8 +1967,7 @@ Tcl_ConcatObj(
|
||||
Tcl_Size length;
|
||||
|
||||
objPtr = objv[i];
|
||||
if (TclListObjIsCanonical(objPtr) ||
|
||||
TclObjTypeHasProc(objPtr,indexProc)) {
|
||||
if (TclListObjIsCanonical(objPtr)) {
|
||||
continue;
|
||||
}
|
||||
(void)Tcl_GetStringFromObj(objPtr, &length);
|
||||
@@ -1990,8 +1979,7 @@ Tcl_ConcatObj(
|
||||
resPtr = NULL;
|
||||
for (i = 0; i < objc; i++) {
|
||||
objPtr = objv[i];
|
||||
if (!TclListObjIsCanonical(objPtr) &&
|
||||
!TclObjTypeHasProc(objPtr,indexProc)) {
|
||||
if (!TclListObjIsCanonical(objPtr)) {
|
||||
continue;
|
||||
}
|
||||
if (resPtr) {
|
||||
@@ -2005,12 +1993,14 @@ Tcl_ConcatObj(
|
||||
!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
|
||||
/* Abandon ship! */
|
||||
Tcl_DecrRefCount(resPtr);
|
||||
Tcl_BounceRefCount(elemPtr); // could be an abstract list element
|
||||
goto slow;
|
||||
}
|
||||
Tcl_BounceRefCount(elemPtr); // could be an an abstract list element
|
||||
} else {
|
||||
resPtr = TclListObjCopy(NULL, objPtr);
|
||||
resPtr = TclDuplicatePureObj(
|
||||
NULL, objPtr, tclListType);
|
||||
if (!resPtr) {
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (!resPtr) {
|
||||
@@ -2151,7 +2141,7 @@ Tcl_StringCaseMatch(
|
||||
ch2 = (int)
|
||||
(nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
|
||||
} else {
|
||||
TclUtfToUCS4(pattern, &ch2);
|
||||
Tcl_UtfToUniChar(pattern, &ch2);
|
||||
if (nocase) {
|
||||
ch2 = Tcl_UniCharToLower(ch2);
|
||||
}
|
||||
@@ -2167,7 +2157,7 @@ Tcl_StringCaseMatch(
|
||||
if ((p != '[') && (p != '?') && (p != '\\')) {
|
||||
if (nocase) {
|
||||
while (*str) {
|
||||
charLen = TclUtfToUCS4(str, &ch1);
|
||||
charLen = Tcl_UtfToUniChar(str, &ch1);
|
||||
if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
|
||||
break;
|
||||
}
|
||||
@@ -2181,7 +2171,7 @@ Tcl_StringCaseMatch(
|
||||
*/
|
||||
|
||||
while (*str) {
|
||||
charLen = TclUtfToUCS4(str, &ch1);
|
||||
charLen = Tcl_UtfToUniChar(str, &ch1);
|
||||
if (ch2 == ch1) {
|
||||
break;
|
||||
}
|
||||
@@ -2195,7 +2185,7 @@ Tcl_StringCaseMatch(
|
||||
if (*str == '\0') {
|
||||
return 0;
|
||||
}
|
||||
str += TclUtfToUCS4(str, &ch1);
|
||||
str += Tcl_UtfToUniChar(str, &ch1);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2206,7 +2196,7 @@ Tcl_StringCaseMatch(
|
||||
|
||||
if (p == '?') {
|
||||
pattern++;
|
||||
str += TclUtfToUCS4(str, &ch1);
|
||||
str += Tcl_UtfToUniChar(str, &ch1);
|
||||
continue;
|
||||
}
|
||||
|
||||
@@ -2225,7 +2215,7 @@ Tcl_StringCaseMatch(
|
||||
(nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
|
||||
str++;
|
||||
} else {
|
||||
str += TclUtfToUCS4(str, &ch1);
|
||||
str += Tcl_UtfToUniChar(str, &ch1);
|
||||
if (nocase) {
|
||||
ch1 = Tcl_UniCharToLower(ch1);
|
||||
}
|
||||
@@ -2239,7 +2229,7 @@ Tcl_StringCaseMatch(
|
||||
? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
|
||||
pattern++;
|
||||
} else {
|
||||
pattern += TclUtfToUCS4(pattern, &startChar);
|
||||
pattern += Tcl_UtfToUniChar(pattern, &startChar);
|
||||
if (nocase) {
|
||||
startChar = Tcl_UniCharToLower(startChar);
|
||||
}
|
||||
@@ -2254,7 +2244,7 @@ Tcl_StringCaseMatch(
|
||||
? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
|
||||
pattern++;
|
||||
} else {
|
||||
pattern += TclUtfToUCS4(pattern, &endChar);
|
||||
pattern += Tcl_UtfToUniChar(pattern, &endChar);
|
||||
if (nocase) {
|
||||
endChar = Tcl_UniCharToLower(endChar);
|
||||
}
|
||||
@@ -2302,8 +2292,8 @@ Tcl_StringCaseMatch(
|
||||
* each string match.
|
||||
*/
|
||||
|
||||
str += TclUtfToUCS4(str, &ch1);
|
||||
pattern += TclUtfToUCS4(pattern, &ch2);
|
||||
str += Tcl_UtfToUniChar(str, &ch1);
|
||||
pattern += Tcl_UtfToUniChar(pattern, &ch2);
|
||||
if (nocase) {
|
||||
if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
|
||||
return 0;
|
||||
@@ -2751,7 +2741,8 @@ Tcl_DStringAppendElement(
|
||||
newSize += 1; /* For terminating nul */
|
||||
if (newSize > dsPtr->spaceAvl) {
|
||||
if (dsPtr->string == dsPtr->staticSpace) {
|
||||
char *newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
|
||||
char *newString;
|
||||
newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
|
||||
memcpy(newString, dsPtr->string, dsPtr->length);
|
||||
dsPtr->string = newString;
|
||||
} else {
|
||||
@@ -2764,7 +2755,7 @@ Tcl_DStringAppendElement(
|
||||
offset = element - dsPtr->string;
|
||||
}
|
||||
dsPtr->string =
|
||||
(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
|
||||
(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
|
||||
if (offset >= 0) {
|
||||
element = dsPtr->string + offset;
|
||||
}
|
||||
@@ -2937,7 +2928,7 @@ Tcl_DStringGetResult(
|
||||
* of interp. */
|
||||
{
|
||||
Tcl_Obj *obj = Tcl_GetObjResult(interp);
|
||||
const char *bytes = TclGetString(obj);
|
||||
char *bytes = TclGetString(obj);
|
||||
|
||||
Tcl_DStringFree(dsPtr);
|
||||
Tcl_DStringAppend(dsPtr, bytes, obj->length);
|
||||
@@ -3378,9 +3369,6 @@ GetWideForIndex(
|
||||
if (numType == TCL_NUMBER_INT) {
|
||||
/* objPtr holds an integer in the signed wide range */
|
||||
*widePtr = *(Tcl_WideInt *)cd;
|
||||
if ((*widePtr < 0)) {
|
||||
*widePtr = (endValue == -1) ? WIDE_MIN : -1;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
if (numType == TCL_NUMBER_BIG) {
|
||||
@@ -3449,15 +3437,11 @@ Tcl_GetIntForIndex(
|
||||
if (indexPtr != NULL) {
|
||||
/* Note: check against TCL_SIZE_MAX needed for 32-bit builds */
|
||||
if (wide >= 0 && wide <= TCL_SIZE_MAX) {
|
||||
*indexPtr = (Tcl_Size)wide; /* A valid index */
|
||||
*indexPtr = (Tcl_Size)wide;
|
||||
} else if (wide > TCL_SIZE_MAX) {
|
||||
*indexPtr = TCL_SIZE_MAX; /* Beyond max possible index */
|
||||
} else if (wide < -1-TCL_SIZE_MAX) {
|
||||
*indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */
|
||||
} else if ((wide < 0) && (endValue >= 0)) {
|
||||
*indexPtr = TCL_INDEX_NONE; /* No clue why this special case */
|
||||
} else {
|
||||
*indexPtr = (Tcl_Size) wide;
|
||||
*indexPtr = TCL_SIZE_MAX;
|
||||
} else {
|
||||
*indexPtr = TCL_INDEX_NONE;
|
||||
}
|
||||
}
|
||||
return TCL_OK;
|
||||
@@ -3517,13 +3501,10 @@ GetEndOffsetFromObj(
|
||||
|
||||
/* Value doesn't start with "e" */
|
||||
|
||||
/* If we reach here, the string rep of objPtr exists. */
|
||||
|
||||
/*
|
||||
* The valid index syntax does not include any value that is
|
||||
* a list of more than one element. This is necessary so that
|
||||
* lists of index values can be reliably distinguished from any
|
||||
* single index value.
|
||||
* So that lists of index values can be reliably distinguished from
|
||||
* any single index value, the valid index syntax does not include
|
||||
* any value that is a list of more than one element.
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -3641,6 +3622,7 @@ GetEndOffsetFromObj(
|
||||
/* Doesn't start with "end" */
|
||||
goto parseError;
|
||||
}
|
||||
|
||||
if (length > 4) {
|
||||
int t;
|
||||
|
||||
@@ -3698,15 +3680,14 @@ GetEndOffsetFromObj(
|
||||
|
||||
if (offset == WIDE_MAX) {
|
||||
/*
|
||||
* Encodes end+1. This is distinguished from end+n as noted
|
||||
* in function header.
|
||||
* Encodes end+1. This is distinguished from end+n as noted above
|
||||
* NOTE: this may wrap around if the caller passes (as lset does)
|
||||
* listLen-1 as endValue and and listLen is 0. The -1 will be
|
||||
* interpreted as FF...FF and adding 1 will result in 0 which
|
||||
* is what we want. Callers like lset which pass in listLen-1 == -1
|
||||
* as endValue will have to adjust accordingly.
|
||||
* is what we want. 2's complements shenanigans but it is what
|
||||
* it is ...
|
||||
*/
|
||||
*widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1;
|
||||
*widePtr = endValue + 1;
|
||||
} else if (offset == WIDE_MIN) {
|
||||
/* -1 - position before first */
|
||||
*widePtr = -1;
|
||||
@@ -3749,7 +3730,7 @@ GetEndOffsetFromObj(
|
||||
*
|
||||
* Parse objPtr to determine if it is an index value. Two cases
|
||||
* are possible. The value objPtr might be parsed as an absolute
|
||||
* index value in the Tcl_Size range. Note that this includes
|
||||
* index value in the Tcl_Size range. This includes
|
||||
* index values that are integers as presented and it includes index
|
||||
* arithmetic expressions.
|
||||
*
|
||||
@@ -3965,6 +3946,39 @@ TclIndexDecode(
|
||||
return TCL_INDEX_NONE;
|
||||
}
|
||||
|
||||
int TclIndexIsFromEnd(Tcl_Size index) {
|
||||
return index <= 0;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclIndexLast --
|
||||
*
|
||||
* Determine the last index for an array of length "length", where -1 means N is
|
||||
* not bounded.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
Tcl_Size
|
||||
TclIndexLast (Tcl_Size length) {
|
||||
return Tcl_LengthIsFinite(length) ? length - 1 : TCL_INDEX_NONE;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_LengthIsFinite --
|
||||
*
|
||||
* True if length is Finite.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
int
|
||||
Tcl_LengthIsFinite(Tcl_Size length) {
|
||||
return length != TCL_LENGTH_NONE;
|
||||
}
|
||||
|
||||
/*
|
||||
*------------------------------------------------------------------------
|
||||
*
|
||||
|
||||
+11
-12
@@ -245,8 +245,7 @@ static Tcl_DupInternalRepProc DupParsedVarName;
|
||||
|
||||
static const Tcl_ObjType localVarNameType = {
|
||||
"localVarName",
|
||||
FreeLocalVarName, DupLocalVarName, NULL, NULL,
|
||||
TCL_OBJTYPE_V0
|
||||
FreeLocalVarName, DupLocalVarName, NULL, NULL, TCL_OBJTYPE_V0
|
||||
};
|
||||
|
||||
#define LocalSetInternalRep(objPtr, index, namePtr) \
|
||||
@@ -269,8 +268,7 @@ static const Tcl_ObjType localVarNameType = {
|
||||
|
||||
static const Tcl_ObjType parsedVarNameType = {
|
||||
"parsedVarName",
|
||||
FreeParsedVarName, DupParsedVarName, NULL, NULL,
|
||||
TCL_OBJTYPE_V0
|
||||
FreeParsedVarName, DupParsedVarName, NULL, NULL, TCL_OBJTYPE_V0
|
||||
};
|
||||
|
||||
#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \
|
||||
@@ -378,7 +376,7 @@ CleanupVar(
|
||||
{
|
||||
if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
|
||||
&& !TclIsVarTraced(varPtr)
|
||||
&& (VarHashRefCount(varPtr) == (Tcl_Size)
|
||||
&& (VarHashRefCount(varPtr) == (unsigned)
|
||||
!TclIsVarDeadHash(varPtr))) {
|
||||
if (VarHashRefCount(varPtr) == 0) {
|
||||
Tcl_Free(varPtr);
|
||||
@@ -388,7 +386,7 @@ CleanupVar(
|
||||
}
|
||||
if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
|
||||
TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
|
||||
(VarHashRefCount(arrayPtr) == (Tcl_Size)
|
||||
(VarHashRefCount(arrayPtr) == (unsigned)
|
||||
!TclIsVarDeadHash(arrayPtr))) {
|
||||
if (VarHashRefCount(arrayPtr) == 0) {
|
||||
Tcl_Free(arrayPtr);
|
||||
@@ -843,8 +841,8 @@ TclLookupSimpleVar(
|
||||
* the variable. */
|
||||
Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
|
||||
ResolverScheme *resPtr;
|
||||
int isNew, result;
|
||||
Tcl_Size i, varLen;
|
||||
int isNew, i, result;
|
||||
Tcl_Size varLen;
|
||||
const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen);
|
||||
|
||||
varPtr = NULL;
|
||||
@@ -969,7 +967,7 @@ TclLookupSimpleVar(
|
||||
}
|
||||
}
|
||||
} else { /* Local var: look in frame varFramePtr. */
|
||||
Tcl_Size localCt = varFramePtr->numCompiledLocals;
|
||||
int localCt = varFramePtr->numCompiledLocals;
|
||||
|
||||
if (localCt > 0) {
|
||||
Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
|
||||
@@ -3099,7 +3097,7 @@ ArrayForNRCmd(
|
||||
* loop) don't vanish.
|
||||
*/
|
||||
|
||||
varListObj = TclListObjCopy(NULL, objv[1]);
|
||||
varListObj = TclDuplicatePureObj(interp, objv[1], tclListType);
|
||||
if (!varListObj) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -4075,7 +4073,8 @@ ArraySetCmd(
|
||||
* the loop and return an error.
|
||||
*/
|
||||
|
||||
copyListObj = TclListObjCopy(NULL, arrayElemObj);
|
||||
copyListObj =
|
||||
TclDuplicatePureObj(interp, arrayElemObj, tclListType);
|
||||
if (!copyListObj) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -5422,7 +5421,7 @@ TclDeleteCompiledLocalVars(
|
||||
* assigned local variables to delete. */
|
||||
{
|
||||
Var *varPtr;
|
||||
Tcl_Size numLocals, i;
|
||||
size_t numLocals, i;
|
||||
Tcl_Obj **namePtrPtr;
|
||||
|
||||
numLocals = framePtr->numCompiledLocals;
|
||||
|
||||
+9
-4
@@ -273,11 +273,15 @@ static struct {
|
||||
* they are believed to not be UTF-8; only
|
||||
* written to from Tcl code in a trusted
|
||||
* interpreter, so not protected by mutex. */
|
||||
Tcl_Encoding utf8; /* The UTF-8 encoding that we prefer to use
|
||||
* for the strings (especially filenames)
|
||||
* embedded in a ZIP. Other encodings are used
|
||||
* dynamically. */
|
||||
int idCount; /* Counter for channel names */
|
||||
Tcl_HashTable fileHash; /* File name to ZipEntry mapping */
|
||||
Tcl_HashTable zipHash; /* Mount to ZipFile mapping */
|
||||
} ZipFS = {
|
||||
0, 0, 0, DEFAULT_WRITE_MAX_SIZE, NULL, 0,
|
||||
0, 0, 0, DEFAULT_WRITE_MAX_SIZE, NULL, NULL, 0,
|
||||
{0,{0,0,0,0},0,0,0,0,0,0,0,0,0},
|
||||
{0,{0,0,0,0},0,0,0,0,0,0,0,0,0}
|
||||
};
|
||||
@@ -739,7 +743,7 @@ DecodeZipEntryText(
|
||||
|
||||
while (1) {
|
||||
int srcRead, dstWrote;
|
||||
int result = Tcl_ExternalToUtf(NULL, tclUtf8Encoding, src, srcLen, flags,
|
||||
int result = Tcl_ExternalToUtf(NULL, ZipFS.utf8, src, srcLen, flags,
|
||||
&state, dst, dstLen, &srcRead, &dstWrote, NULL);
|
||||
int soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
|
||||
|
||||
@@ -1856,6 +1860,7 @@ ZipfsSetup(void)
|
||||
ZipFS.fallbackEntryEncoding = (char *)
|
||||
Tcl_Alloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1);
|
||||
strcpy(ZipFS.fallbackEntryEncoding, ZIPFS_FALLBACK_ENCODING);
|
||||
ZipFS.utf8 = Tcl_GetEncoding(NULL, "utf-8");
|
||||
ZipFS.initialized = 1;
|
||||
Tcl_CreateExitHandler(ZipfsExitHandler, NULL);
|
||||
}
|
||||
@@ -2536,7 +2541,7 @@ ZipAddFile(
|
||||
* crazy enough to embed NULs in filenames, they deserve what they get!
|
||||
*/
|
||||
|
||||
zpathExt = Tcl_UtfToExternalDString(tclUtf8Encoding, zpathTcl, -1, &zpathDs);
|
||||
zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, -1, &zpathDs);
|
||||
zpathlen = strlen(zpathExt);
|
||||
if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
@@ -3205,7 +3210,7 @@ ZipFSMkZipOrImg(
|
||||
}
|
||||
z = (ZipEntry *) Tcl_GetHashValue(hPtr);
|
||||
|
||||
name = Tcl_UtfToExternalDString(tclUtf8Encoding, z->name, TCL_INDEX_NONE, &ds);
|
||||
name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, TCL_INDEX_NONE, &ds);
|
||||
len = Tcl_DStringLength(&ds);
|
||||
SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
|
||||
z, len);
|
||||
|
||||
+3
-24
@@ -1746,9 +1746,6 @@ proc http::OpenSocket {token DoLater} {
|
||||
}
|
||||
fconfigure $sock -translation {auto crlf} \
|
||||
-buffersize $state(-blocksize)
|
||||
if {[package vsatisfies [package provide Tcl] 9.0-]} {
|
||||
fconfigure $sock -profile tcl8
|
||||
}
|
||||
##Log socket opened, DONE fconfigure - token $token
|
||||
}
|
||||
|
||||
@@ -2167,9 +2164,6 @@ proc http::Connected {token proto phost srvurl} {
|
||||
lassign [fconfigure $sock -translation] trRead trWrite
|
||||
fconfigure $sock -translation [list $trRead crlf] \
|
||||
-buffersize $state(-blocksize)
|
||||
if {[package vsatisfies [package provide Tcl] 9.0-]} {
|
||||
fconfigure $sock -profile tcl8
|
||||
}
|
||||
|
||||
# The following is disallowed in safe interpreters, but the socket is
|
||||
# already in non-blocking mode in that case.
|
||||
@@ -2560,9 +2554,6 @@ proc http::ReceiveResponse {token} {
|
||||
lassign [fconfigure $sock -translation] trRead trWrite
|
||||
fconfigure $sock -translation [list auto $trWrite] \
|
||||
-buffersize $state(-blocksize)
|
||||
if {[package vsatisfies [package provide Tcl] 9.0-]} {
|
||||
fconfigure $sock -profile tcl8
|
||||
}
|
||||
Log ^D$tk begin receiving response - token $token
|
||||
|
||||
coroutine ${token}--EventCoroutine http::Event $sock $token
|
||||
@@ -4554,11 +4545,7 @@ proc http::Eot {token {reason {}}} {
|
||||
|
||||
set enc [CharsetToEncoding $state(charset)]
|
||||
if {$enc ne "binary"} {
|
||||
if {[package vsatisfies [package provide Tcl] 9.0-]} {
|
||||
set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)]
|
||||
} else {
|
||||
set state(body) [encoding convertfrom $enc $state(body)]
|
||||
}
|
||||
set state(body) [encoding convertfrom $enc $state(body)]
|
||||
}
|
||||
|
||||
# Translate text line endings.
|
||||
@@ -4641,11 +4628,7 @@ proc http::GuessType {token} {
|
||||
if {$enc eq "binary"} {
|
||||
return 0
|
||||
}
|
||||
if {[package vsatisfies [package provide Tcl] 9.0-]} {
|
||||
set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)]
|
||||
} else {
|
||||
set state(body) [encoding convertfrom $enc $state(body)]
|
||||
}
|
||||
set state(body) [encoding convertfrom $enc $state(body)]
|
||||
set state(body) [string map {\r\n \n \r \n} $state(body)]
|
||||
set state(type) application/xml
|
||||
set state(binary) 0
|
||||
@@ -4726,11 +4709,7 @@ proc http::quoteString {string} {
|
||||
# a pre-computed map and [string map] to do the conversion (much faster
|
||||
# than [regsub]/[subst]). [Bug 1020491]
|
||||
|
||||
if {[package vsatisfies [package provide Tcl] 9.0-]} {
|
||||
set string [encoding convertto -profile tcl8 $http(-urlencoding) $string]
|
||||
} else {
|
||||
set string [encoding convertto $http(-urlencoding) $string]
|
||||
}
|
||||
set string [encoding convertto $http(-urlencoding) $string]
|
||||
return [string map $formMap $string]
|
||||
}
|
||||
|
||||
|
||||
+14
-19
@@ -29,7 +29,6 @@ namespace eval tcltest {
|
||||
# yourself. You don't need tcltest to wrap it for you.
|
||||
variable version [package provide Tcl]
|
||||
variable patchLevel [info patchlevel]
|
||||
variable fullutf [package vsatisfies $version 8.7-]
|
||||
|
||||
##### Export the public tcltest procs; several categories
|
||||
#
|
||||
@@ -401,7 +400,7 @@ namespace eval tcltest {
|
||||
default {
|
||||
set outputChannel [open $filename a]
|
||||
if {[package vsatisfies [package provide Tcl] 8.7-]} {
|
||||
fconfigure $outputChannel -profile tcl8 -encoding utf-8
|
||||
fconfigure $outputChannel -encoding utf-8
|
||||
}
|
||||
set ChannelsWeOpened($outputChannel) 1
|
||||
|
||||
@@ -448,7 +447,7 @@ namespace eval tcltest {
|
||||
default {
|
||||
set errorChannel [open $filename a]
|
||||
if {[package vsatisfies [package provide Tcl] 8.7-]} {
|
||||
fconfigure $errorChannel -profile tcl8 -encoding utf-8
|
||||
fconfigure $errorChannel -encoding utf-8
|
||||
}
|
||||
set ChannelsWeOpened($errorChannel) 1
|
||||
|
||||
@@ -793,7 +792,7 @@ namespace eval tcltest {
|
||||
if {$Option(-loadfile) eq {}} {return}
|
||||
set tmp [open $Option(-loadfile) r]
|
||||
if {[package vsatisfies [package provide Tcl] 8.7-]} {
|
||||
fconfigure $tmp -profile tcl8 -encoding utf-8
|
||||
fconfigure $tmp -encoding utf-8
|
||||
}
|
||||
loadScript [read $tmp]
|
||||
close $tmp
|
||||
@@ -1135,6 +1134,7 @@ proc tcltest::SafeFetch {n1 n2 op} {
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# tcltest::Asciify --
|
||||
#
|
||||
# Transforms the passed string to contain only printable ascii characters.
|
||||
@@ -1151,17 +1151,16 @@ proc tcltest::SafeFetch {n1 n2 op} {
|
||||
# None.
|
||||
|
||||
proc tcltest::Asciify {s} {
|
||||
variable fullutf
|
||||
set print ""
|
||||
foreach c [split $s ""] {
|
||||
if {[string is print $c] && (($c <= "\x7E") || ($c == "\n"))} {
|
||||
append print $c
|
||||
} elseif {$c < "\u0100"} {
|
||||
} elseif {$c <= "\xFF"} {
|
||||
append print \\x[format %02X [scan $c %c]]
|
||||
} elseif {$fullutf && ($c >= "\U10000")} {
|
||||
append print \\U[format %08X [scan $c %c]]
|
||||
} else {
|
||||
} elseif {$c <= "\xFFFF"} {
|
||||
append print \\u[format %04X [scan $c %c]]
|
||||
} else {
|
||||
append print \\U[format %08X [scan $c %c]]
|
||||
}
|
||||
}
|
||||
return $print
|
||||
@@ -1373,7 +1372,7 @@ proc tcltest::DefineConstraintInitializers {} {
|
||||
set code 0
|
||||
if {![catch {set f [open "|[list [interpreter]]" w]}]} {
|
||||
if {[package vsatisfies [package provide Tcl] 8.7-]} {
|
||||
fconfigure $f -profile tcl8 -encoding utf-8
|
||||
fconfigure $f -encoding utf-8
|
||||
}
|
||||
if {![catch {puts $f exit}]} {
|
||||
if {![catch {close $f}]} {
|
||||
@@ -2223,7 +2222,7 @@ proc tcltest::test {name description args} {
|
||||
if {[file readable $testFile]} {
|
||||
set testFd [open $testFile r]
|
||||
if {[package vsatisfies [package provide Tcl] 8.7-]} {
|
||||
fconfigure $testFd -profile tcl8 -encoding utf-8
|
||||
fconfigure $testFd -encoding utf-8
|
||||
}
|
||||
set testLine [expr {[lsearch -regexp \
|
||||
[split [read $testFd] "\n"] \
|
||||
@@ -2254,11 +2253,7 @@ proc tcltest::test {name description args} {
|
||||
if {$scriptCompare} {
|
||||
puts [outputChannel] "---- Error testing result: $scriptMatch"
|
||||
} else {
|
||||
if {[catch {
|
||||
puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
|
||||
} errMsg]} {
|
||||
puts [outputChannel] "\n---- Result was:\n<error printing result: $errMsg>"
|
||||
}
|
||||
puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
|
||||
puts [outputChannel] "---- Result should have been\
|
||||
($match matching):\n[Asciify $result]"
|
||||
}
|
||||
@@ -2938,7 +2933,7 @@ proc tcltest::runAllTests { {shell ""} } {
|
||||
incr numTestFiles
|
||||
set pipeFd [open $cmd "r"]
|
||||
if {[package vsatisfies [package provide Tcl] 8.7-]} {
|
||||
fconfigure $pipeFd -profile tcl8 -encoding utf-8
|
||||
fconfigure $pipeFd -encoding utf-8
|
||||
}
|
||||
while {[gets $pipeFd line] >= 0} {
|
||||
if {[regexp [join {
|
||||
@@ -3138,7 +3133,7 @@ proc tcltest::makeFile {contents name {directory ""}} {
|
||||
set fd [open $fullName w]
|
||||
fconfigure $fd -translation lf
|
||||
if {[package vsatisfies [package provide Tcl] 8.7-]} {
|
||||
fconfigure $fd -profile tcl8 -encoding utf-8
|
||||
fconfigure $fd -encoding utf-8
|
||||
}
|
||||
if {[string index $contents end] eq "\n"} {
|
||||
puts -nonewline $fd $contents
|
||||
@@ -3289,7 +3284,7 @@ proc tcltest::viewFile {name {directory ""}} {
|
||||
set fullName [file join $directory $name]
|
||||
set f [open $fullName]
|
||||
if {[package vsatisfies [package provide Tcl] 8.7-]} {
|
||||
fconfigure $f -profile tcl8 -encoding utf-8
|
||||
fconfigure $f -encoding utf-8
|
||||
}
|
||||
set data [read -nonewline $f]
|
||||
close $f
|
||||
|
||||
@@ -4,7 +4,10 @@
|
||||
#ifndef BN_H_
|
||||
#define BN_H_
|
||||
|
||||
#include <stdint.h>
|
||||
#if !defined(MP_NO_STDINT) && !defined(_STDINT_H) && !defined(_STDINT_H_) \
|
||||
&& !defined(__CLANG_STDINT_H) && !defined(_STDINT)
|
||||
# include <stdint.h>
|
||||
#endif
|
||||
#include <stddef.h>
|
||||
#include <limits.h>
|
||||
|
||||
|
||||
@@ -4,7 +4,13 @@
|
||||
#ifndef TOMMATH_PRIV_H_
|
||||
#define TOMMATH_PRIV_H_
|
||||
|
||||
#include <stdint.h>
|
||||
#ifdef MP_NO_STDINT
|
||||
#ifdef HAVE_STDINT_H
|
||||
# include <stdint.h>
|
||||
#else
|
||||
# include "../compat/stdint.h"
|
||||
#endif
|
||||
#endif
|
||||
#include "tclTomMath.h"
|
||||
#include "tommath_class.h"
|
||||
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user