Check-in [745d651613]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Merge trunk
Timelines: family | ancestors | descendants | both | novem
Files: files | file ages | folders
SHA3-256: 745d651613b1c48cbd8ef344f02c678b86722f9e32f7420652a6d1ea25f2208f
User & Date: jan.nijtmans 2018-10-19 16:09:51.417
Context
2018-10-21
21:36
Merge trunk check-in: 4b47c09997 user: jan.nijtmans tags: novem
2018-10-19
16:09
Merge trunk check-in: 745d651613 user: jan.nijtmans tags: novem
15:53
Merge 8.7 check-in: 8c57795bed user: jan.nijtmans tags: trunk
2018-08-28
20:37
merge trunk check-in: 4dd4fa8b91 user: jan.nijtmans tags: novem
Changes
Unified Diff Ignore Whitespace Patch
Deleted .fossil-settings/crnl-glob.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
compat/zlib/contrib/vstudio/readme.txt
compat/zlib/contrib/vstudio/*/zlib.rc
compat/zlib/win32/*.txt
compat/zlib/win64/*.txt
libtommath/*.dsp
libtommath/*.sln
libtommath/*.vcproj
tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/rules-ext.vc
win/targets.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






































Changes to ChangeLog.2007.
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
	an expr syntax error (masked by a [catch]).

	* generic/tclCompCmds.c (TclCompileReturnCmd):	Added crash protection
	to handle callers other than TclCompileScript() failing to meet the
	initialization assumptions of the TIP 280 code in CompileWord().

	* generic/tclCompExpr.c:	Suppress the attempt to convert to
	numeric when pre-compiling a constant expresion indicates an error.

2007-08-22  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c (TEBC): disable the new shortcut to frequent
	INSTs for debug builds. REVERTED (collision with alternative fix)

2007-08-21  Don Porter	<dgp@users.sourceforge.net>







|







1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
	an expr syntax error (masked by a [catch]).

	* generic/tclCompCmds.c (TclCompileReturnCmd):	Added crash protection
	to handle callers other than TclCompileScript() failing to meet the
	initialization assumptions of the TIP 280 code in CompileWord().

	* generic/tclCompExpr.c:	Suppress the attempt to convert to
	numeric when pre-compiling a constant expression indicates an error.

2007-08-22  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c (TEBC): disable the new shortcut to frequent
	INSTs for debug builds. REVERTED (collision with alternative fix)

2007-08-21  Don Porter	<dgp@users.sourceforge.net>
Changes to compat/opendir.c.
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
    register int fd;
    char *myname;

    myname = ((*name == '\0') ? "." : name);
    if ((fd = open(myname, 0, 0)) == -1) {
	return NULL;
    }
    dirp = (DIR *) ckalloc(sizeof(DIR));
    if (dirp == NULL) {
	/* unreachable? */
	close(fd);
	return NULL;
    }
    dirp->dd_fd = fd;
    dirp->dd_loc = 0;







|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
    register int fd;
    char *myname;

    myname = ((*name == '\0') ? "." : name);
    if ((fd = open(myname, 0, 0)) == -1) {
	return NULL;
    }
    dirp = (DIR *) Tcl_Alloc(sizeof(DIR));
    if (dirp == NULL) {
	/* unreachable? */
	close(fd);
	return NULL;
    }
    dirp->dd_fd = fd;
    dirp->dd_loc = 0;
102
103
104
105
106
107
108
109
110
void
closedir(
    register DIR *dirp)
{
    close(dirp->dd_fd);
    dirp->dd_fd = -1;
    dirp->dd_loc = 0;
    ckfree(dirp);
}







|

102
103
104
105
106
107
108
109
110
void
closedir(
    register DIR *dirp)
{
    close(dirp->dd_fd);
    dirp->dd_fd = -1;
    dirp->dd_loc = 0;
    Tcl_Free(dirp);
}
Changes to compat/waitpid.c.
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
	result = waitPtr->pid;
	*statusPtr = *((int *) &waitPtr->status);
	if (prevPtr == NULL) {
	    deadList = waitPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = waitPtr->nextPtr;
	}
	ckfree(waitPtr);
	return result;
    }

    /*
     * Wait for any process to stop or exit. If it's an acceptable one then
     * return it to the caller; otherwise store information about it in the
     * list of exited processes and try again. On systems that have only wait







|







96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
	result = waitPtr->pid;
	*statusPtr = *((int *) &waitPtr->status);
	if (prevPtr == NULL) {
	    deadList = waitPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = waitPtr->nextPtr;
	}
	Tcl_Free(waitPtr);
	return result;
    }

    /*
     * Wait for any process to stop or exit. If it's an acceptable one then
     * return it to the caller; otherwise store information about it in the
     * list of exited processes and try again. On systems that have only wait
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
    saveInfo:
	for (waitPtr = deadList; waitPtr != NULL; waitPtr = waitPtr->nextPtr) {
	    if (waitPtr->pid == result) {
		waitPtr->status = status;
		goto waitAgain;
	    }
	}
	waitPtr = (WaitInfo *) ckalloc(sizeof(WaitInfo));
	waitPtr->pid = result;
	waitPtr->status = status;
	waitPtr->nextPtr = deadList;
	deadList = waitPtr;

    waitAgain:
	continue;
    }
}







|









152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
    saveInfo:
	for (waitPtr = deadList; waitPtr != NULL; waitPtr = waitPtr->nextPtr) {
	    if (waitPtr->pid == result) {
		waitPtr->status = status;
		goto waitAgain;
	    }
	}
	waitPtr = (WaitInfo *) Tcl_Alloc(sizeof(WaitInfo));
	waitPtr->pid = result;
	waitPtr->status = status;
	waitPtr->nextPtr = deadList;
	deadList = waitPtr;

    waitAgain:
	continue;
    }
}
Changes to compat/zlib/contrib/minizip/minizip.c.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
         Modifications of Unzip for Zip64
         Copyright (C) 2007-2008 Even Rouault

         Modifications for Zip64 support on both zip and unzip
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
*/


#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
        #ifndef __USE_FILE_OFFSET64
                #define __USE_FILE_OFFSET64
        #endif
        #ifndef __USE_LARGEFILE64
                #define __USE_LARGEFILE64
        #endif
        #ifndef _LARGEFILE64_SOURCE
                #define _LARGEFILE64_SOURCE
        #endif
        #ifndef _FILE_OFFSET_BIT
                #define _FILE_OFFSET_BIT 64
        #endif
#endif

#ifdef __APPLE__
// In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
#define FTELLO_FUNC(stream) ftello(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin)
#else
#define FOPEN_FUNC(filename, mode) fopen64(filename, mode)
#define FTELLO_FUNC(stream) ftello64(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
#endif



#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <errno.h>
#include <fcntl.h>








<















|










|
<







8
9
10
11
12
13
14

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

42
43
44
45
46
47
48
         Modifications of Unzip for Zip64
         Copyright (C) 2007-2008 Even Rouault

         Modifications for Zip64 support on both zip and unzip
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
*/


#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
        #ifndef __USE_FILE_OFFSET64
                #define __USE_FILE_OFFSET64
        #endif
        #ifndef __USE_LARGEFILE64
                #define __USE_LARGEFILE64
        #endif
        #ifndef _LARGEFILE64_SOURCE
                #define _LARGEFILE64_SOURCE
        #endif
        #ifndef _FILE_OFFSET_BIT
                #define _FILE_OFFSET_BIT 64
        #endif
#endif

#if defined(__APPLE__) || defined(IOAPI_NO_64)
// In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
#define FTELLO_FUNC(stream) ftello(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin)
#else
#define FOPEN_FUNC(filename, mode) fopen64(filename, mode)
#define FTELLO_FUNC(stream) ftello64(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
#endif

#include "tinydir.h"

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <errno.h>
#include <fcntl.h>

168
169
170
171
172
173
174

175
176
177
178
179
180
181
    printf("MiniZip 1.1, demo of zLib + MiniZip64 package, written by Gilles Vollant\n");
    printf("more info on MiniZip at http://www.winimage.com/zLibDll/minizip.html\n\n");
}

void do_help()
{
    printf("Usage : minizip [-o] [-a] [-0 to -9] [-p password] [-j] file.zip [files_to_add]\n\n" \

           "  -o  Overwrite existing file.zip\n" \
           "  -a  Append to existing file.zip\n" \
           "  -0  Store only\n" \
           "  -1  Compress faster\n" \
           "  -9  Compress better\n\n" \
           "  -j  exclude path. store only the file name.\n\n");
}







>







166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
    printf("MiniZip 1.1, demo of zLib + MiniZip64 package, written by Gilles Vollant\n");
    printf("more info on MiniZip at http://www.winimage.com/zLibDll/minizip.html\n\n");
}

void do_help()
{
    printf("Usage : minizip [-o] [-a] [-0 to -9] [-p password] [-j] file.zip [files_to_add]\n\n" \
           "  -r  Scan directories recursively\n" \
           "  -o  Overwrite existing file.zip\n" \
           "  -a  Append to existing file.zip\n" \
           "  -0  Store only\n" \
           "  -1  Compress faster\n" \
           "  -9  Compress better\n\n" \
           "  -j  exclude path. store only the file name.\n\n");
}
238
239
240
241
242
243
244
245












































































































































246
247
248
249
250

251
252
253
254
255
256
257
258
     largeFile = 1;

                fclose(pFile);
  }

 return largeFile;
}













































































































































int main(argc,argv)
    int argc;
    char *argv[];
{
    int i;

    int opt_overwrite=0;
    int opt_compress_level=Z_DEFAULT_COMPRESSION;
    int opt_exclude_path=0;
    int zipfilenamearg = 0;
    char filename_try[MAXFILENAME+16];
    int zipok;
    int err=0;
    int size_buf=0;








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





>
|







237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
     largeFile = 1;

                fclose(pFile);
  }

 return largeFile;
}

void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
    FILE * fin;
    int size_read;
    const char *savefilenameinzip;
    zip_fileinfo zi;
    unsigned long crcFile=0;
    int zip64 = 0;
    int err=0;
    int size_buf=WRITEBUFFERSIZE;
    unsigned char buf[WRITEBUFFERSIZE];
    zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
    zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
    zi.dosDate = 0;
    zi.internal_fa = 0;
    zi.external_fa = 0;
    filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);

/*
    err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
                     NULL,0,NULL,0,NULL / * comment * /,
                     (opt_compress_level != 0) ? Z_DEFLATED : 0,
                     opt_compress_level);
*/
    if ((password != NULL) && (err==ZIP_OK))
        err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);

    zip64 = isLargeFile(filenameinzip);

   /* The path name saved, should not include a leading slash. */
   /*if it did, windows/xp and dynazip couldn't read the zip file. */
     savefilenameinzip = filenameinzip;
     while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
     {
         savefilenameinzip++;
     }

     /*should the zip file contain any path at all?*/
     if( opt_exclude_path )
     {
         const char *tmpptr;
         const char *lastslash = 0;
         for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
         {
             if( *tmpptr == '\\' || *tmpptr == '/')
             {
                 lastslash = tmpptr;
             }
         }
         if( lastslash != NULL )
         {
             savefilenameinzip = lastslash+1; // base filename follows last slash.
         }
     }

     /**/
    err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
                     NULL,0,NULL,0,NULL /* comment*/,
                     (opt_compress_level != 0) ? Z_DEFLATED : 0,
                     opt_compress_level,0,
                     /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
                     -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
                     password,crcFile, zip64);

    if (err != ZIP_OK)
        printf("error in opening %s in zipfile\n",filenameinzip);
    else
    {
        fin = FOPEN_FUNC(filenameinzip,"rb");
        if (fin==NULL)
        {
            err=ZIP_ERRNO;
            printf("error in opening %s for reading\n",filenameinzip);
        }
    }

    if (err == ZIP_OK)
        do
        {
            err = ZIP_OK;
            size_read = (int)fread(buf,1,size_buf,fin);
            if (size_read < size_buf)
                if (feof(fin)==0)
            {
                printf("error in reading %s\n",filenameinzip);
                err = ZIP_ERRNO;
            }

            if (size_read>0)
            {
                err = zipWriteInFileInZip (zf,buf,size_read);
                if (err<0)
                {
                    printf("error in writing %s in the zipfile\n",
                                     filenameinzip);
                }

            }
        } while ((err == ZIP_OK) && (size_read>0));

    if (fin)
        fclose(fin);

    if (err<0)
        err=ZIP_ERRNO;
    else
    {
        err = zipCloseFileInZip(zf);
        if (err!=ZIP_OK)
            printf("error in closing %s in the zipfile\n",
                        filenameinzip);
    }
}


void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
    tinydir_dir dir;
    int i;
    char newname[512];

    tinydir_open_sorted(&dir, filenameinzip);

    for (i = 0; i < dir.n_files; i++)
    {
        tinydir_file file;
        tinydir_readfile_n(&dir, &file, i);
        if(strcmp(file.name,".")==0) continue;
        if(strcmp(file.name,"..")==0) continue;
        sprintf(newname,"%s/%s",dir.path,file.name);
        if (file.is_dir)
        {
            addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
        } else {
            addFileToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
        }
    }

    tinydir_close(&dir);
}


int main(argc,argv)
    int argc;
    char *argv[];
{
    int i;
    int opt_recursive=0;
    int opt_overwrite=1;
    int opt_compress_level=Z_DEFAULT_COMPRESSION;
    int opt_exclude_path=0;
    int zipfilenamearg = 0;
    char filename_try[MAXFILENAME+16];
    int zipok;
    int err=0;
    int size_buf=0;
281
282
283
284
285
286
287
288

289
290
291
292
293
294
295
                        opt_overwrite = 1;
                    if ((c=='a') || (c=='A'))
                        opt_overwrite = 2;
                    if ((c>='0') && (c<='9'))
                        opt_compress_level = c-'0';
                    if ((c=='j') || (c=='J'))
                        opt_exclude_path = 1;


                    if (((c=='p') || (c=='P')) && (i+1<argc))
                    {
                        password=argv[i+1];
                        i++;
                    }
                }
            }







|
>







421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
                        opt_overwrite = 1;
                    if ((c=='a') || (c=='A'))
                        opt_overwrite = 2;
                    if ((c>='0') && (c<='9'))
                        opt_compress_level = c-'0';
                    if ((c=='j') || (c=='J'))
                        opt_exclude_path = 1;
                    if ((c=='r') || (c=='R'))
                        opt_recursive = 1;
                    if (((c=='p') || (c=='P')) && (i+1<argc))
                    {
                        password=argv[i+1];
                        i++;
                    }
                }
            }
388
389
390
391
392
393
394

395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512

        for (i=zipfilenamearg+1;(i<argc) && (err==ZIP_OK);i++)
        {
            if (!((((*(argv[i]))=='-') || ((*(argv[i]))=='/')) &&
                  ((argv[i][1]=='o') || (argv[i][1]=='O') ||
                   (argv[i][1]=='a') || (argv[i][1]=='A') ||
                   (argv[i][1]=='p') || (argv[i][1]=='P') ||

                   ((argv[i][1]>='0') || (argv[i][1]<='9'))) &&
                  (strlen(argv[i]) == 2)))
            {
                FILE * fin;
                int size_read;
                const char* filenameinzip = argv[i];
                const char *savefilenameinzip;
                zip_fileinfo zi;
                unsigned long crcFile=0;
                int zip64 = 0;

                zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
                zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
                zi.dosDate = 0;
                zi.internal_fa = 0;
                zi.external_fa = 0;
                filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);

/*
                err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
                                 NULL,0,NULL,0,NULL / * comment * /,
                                 (opt_compress_level != 0) ? Z_DEFLATED : 0,
                                 opt_compress_level);
*/
                if ((password != NULL) && (err==ZIP_OK))
                    err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);

                zip64 = isLargeFile(filenameinzip);

                                                         /* The path name saved, should not include a leading slash. */
               /*if it did, windows/xp and dynazip couldn't read the zip file. */
                 savefilenameinzip = filenameinzip;
                 while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
                 {
                     savefilenameinzip++;
                 }

                 /*should the zip file contain any path at all?*/
                 if( opt_exclude_path )
                 {
                     const char *tmpptr;
                     const char *lastslash = 0;
                     for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
                     {
                         if( *tmpptr == '\\' || *tmpptr == '/')
                         {
                             lastslash = tmpptr;
                         }
                     }
                     if( lastslash != NULL )
                     {
                         savefilenameinzip = lastslash+1; // base filename follows last slash.
                     }
                 }

                 /**/
                err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
                                 NULL,0,NULL,0,NULL /* comment*/,
                                 (opt_compress_level != 0) ? Z_DEFLATED : 0,
                                 opt_compress_level,0,
                                 /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
                                 -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
                                 password,crcFile, zip64);

                if (err != ZIP_OK)
                    printf("error in opening %s in zipfile\n",filenameinzip);
                else
                {
                    fin = FOPEN_FUNC(filenameinzip,"rb");
                    if (fin==NULL)
                    {
                        err=ZIP_ERRNO;
                        printf("error in opening %s for reading\n",filenameinzip);
                    }
                }

                if (err == ZIP_OK)
                    do
                    {
                        err = ZIP_OK;
                        size_read = (int)fread(buf,1,size_buf,fin);
                        if (size_read < size_buf)
                            if (feof(fin)==0)
                        {
                            printf("error in reading %s\n",filenameinzip);
                            err = ZIP_ERRNO;
                        }

                        if (size_read>0)
                        {
                            err = zipWriteInFileInZip (zf,buf,size_read);
                            if (err<0)
                            {
                                printf("error in writing %s in the zipfile\n",
                                                 filenameinzip);
                            }

                        }
                    } while ((err == ZIP_OK) && (size_read>0));

                if (fin)
                    fclose(fin);

                if (err<0)
                    err=ZIP_ERRNO;
                else
                {
                    err = zipCloseFileInZip(zf);
                    if (err!=ZIP_OK)
                        printf("error in closing %s in the zipfile\n",
                                    filenameinzip);
                }
            }
        }
        errclose = zipClose(zf,NULL);
        if (errclose != ZIP_OK)
            printf("error in closing %s\n",filename_try);
    }







>



<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







529
530
531
532
533
534
535
536
537
538
539







540











541











































542








543



































544
545
546
547
548
549
550

        for (i=zipfilenamearg+1;(i<argc) && (err==ZIP_OK);i++)
        {
            if (!((((*(argv[i]))=='-') || ((*(argv[i]))=='/')) &&
                  ((argv[i][1]=='o') || (argv[i][1]=='O') ||
                   (argv[i][1]=='a') || (argv[i][1]=='A') ||
                   (argv[i][1]=='p') || (argv[i][1]=='P') ||
                   (argv[i][1]=='r') || (argv[i][1]=='R') ||
                   ((argv[i][1]>='0') || (argv[i][1]<='9'))) &&
                  (strlen(argv[i]) == 2)))
            {







                if(opt_recursive) {











                    addPathToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);











































                } else {








                    addFileToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);



































                }
            }
        }
        errclose = zipClose(zf,NULL);
        if (errclose != ZIP_OK)
            printf("error in closing %s\n",filename_try);
    }
Added compat/zlib/contrib/minizip/tinydir.h.
































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
/*
Copyright (c) 2013-2017, tinydir authors:
- Cong Xu
- Lautis Sun
- Baudouin Feildel
- Andargor <andargor@yahoo.com>
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.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT OWNER OR CONTRIBUTORS 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.
*/
#ifndef TINYDIR_H
#define TINYDIR_H

#ifdef __cplusplus
extern "C" {
#endif

#if ((defined _UNICODE) && !(defined UNICODE))
#define UNICODE
#endif

#if ((defined UNICODE) && !(defined _UNICODE))
#define _UNICODE
#endif

#include <errno.h>
#include <stdlib.h>
#include <string.h>
#ifdef _MSC_VER
# define WIN32_LEAN_AND_MEAN
# include <windows.h>
# include <tchar.h>
# pragma warning(push)
# pragma warning (disable : 4996)
#else
# include <dirent.h>
# include <libgen.h>
# include <sys/stat.h>
# include <stddef.h>
#endif
#ifdef __MINGW32__
# include <tchar.h>
#endif


/* types */

/* Windows UNICODE wide character support */
#if defined _MSC_VER || defined __MINGW32__
# define _tinydir_char_t TCHAR
# define TINYDIR_STRING(s) _TEXT(s)
# define _tinydir_strlen _tcslen
# define _tinydir_strcpy _tcscpy
# define _tinydir_strcat _tcscat
# define _tinydir_strcmp _tcscmp
# define _tinydir_strrchr _tcsrchr
# define _tinydir_strncmp _tcsncmp
#else
# define _tinydir_char_t char
# define TINYDIR_STRING(s) s
# define _tinydir_strlen strlen
# define _tinydir_strcpy strcpy
# define _tinydir_strcat strcat
# define _tinydir_strcmp strcmp
# define _tinydir_strrchr strrchr
# define _tinydir_strncmp strncmp
#endif

#if (defined _MSC_VER || defined __MINGW32__)
# include <windows.h>
# define _TINYDIR_PATH_MAX MAX_PATH
#elif defined  __linux__
# include <limits.h>
# define _TINYDIR_PATH_MAX PATH_MAX
#elif defined(__unix__) || (defined(__APPLE__) && defined(__MACH__))
# include <sys/param.h>
# if defined(BSD)
#  include <limits.h>
#  define _TINYDIR_PATH_MAX PATH_MAX
# endif
#endif

#ifndef _TINYDIR_PATH_MAX
#define _TINYDIR_PATH_MAX 4096
#endif

#ifdef _MSC_VER
/* extra chars for the "\\*" mask */
# define _TINYDIR_PATH_EXTRA 2
#else
# define _TINYDIR_PATH_EXTRA 0
#endif

#define _TINYDIR_FILENAME_MAX 256

#if (defined _MSC_VER || defined __MINGW32__)
#define _TINYDIR_DRIVE_MAX 3
#endif

#ifdef _MSC_VER
# define _TINYDIR_FUNC static __inline
#elif !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L
# define _TINYDIR_FUNC static __inline__
#else
# define _TINYDIR_FUNC static inline
#endif

/* readdir_r usage; define TINYDIR_USE_READDIR_R to use it (if supported) */
#ifdef TINYDIR_USE_READDIR_R

/* readdir_r is a POSIX-only function, and may not be available under various
 * environments/settings, e.g. MinGW. Use readdir fallback */
#if _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE ||\
	_POSIX_SOURCE
# define _TINYDIR_HAS_READDIR_R
#endif
#if _POSIX_C_SOURCE >= 200112L
# define _TINYDIR_HAS_FPATHCONF
# include <unistd.h>
#endif
#if _BSD_SOURCE || _SVID_SOURCE || \
	(_POSIX_C_SOURCE >= 200809L || _XOPEN_SOURCE >= 700)
# define _TINYDIR_HAS_DIRFD
# include <sys/types.h>
#endif
#if defined _TINYDIR_HAS_FPATHCONF && defined _TINYDIR_HAS_DIRFD &&\
	defined _PC_NAME_MAX
# define _TINYDIR_USE_FPATHCONF
#endif
#if defined __MINGW32__ || !defined _TINYDIR_HAS_READDIR_R ||\
	!(defined _TINYDIR_USE_FPATHCONF || defined NAME_MAX)
# define _TINYDIR_USE_READDIR
#endif

/* Use readdir by default */
#else
# define _TINYDIR_USE_READDIR
#endif

/* MINGW32 has two versions of dirent, ASCII and UNICODE*/
#ifndef _MSC_VER
#if (defined __MINGW32__) && (defined _UNICODE)
#define _TINYDIR_DIR _WDIR
#define _tinydir_dirent _wdirent
#define _tinydir_opendir _wopendir
#define _tinydir_readdir _wreaddir
#define _tinydir_closedir _wclosedir
#else
#define _TINYDIR_DIR DIR
#define _tinydir_dirent dirent
#define _tinydir_opendir opendir
#define _tinydir_readdir readdir
#define _tinydir_closedir closedir
#endif
#endif

/* Allow user to use a custom allocator by defining _TINYDIR_MALLOC and _TINYDIR_FREE. */
#if    defined(_TINYDIR_MALLOC) &&  defined(_TINYDIR_FREE)
#elif !defined(_TINYDIR_MALLOC) && !defined(_TINYDIR_FREE)
#else
#error "Either define both alloc and free or none of them!"
#endif

#if !defined(_TINYDIR_MALLOC)
	#define _TINYDIR_MALLOC(_size) malloc(_size)
	#define _TINYDIR_FREE(_ptr)    free(_ptr)
#endif /* !defined(_TINYDIR_MALLOC) */

typedef struct tinydir_file
{
	_tinydir_char_t path[_TINYDIR_PATH_MAX];
	_tinydir_char_t name[_TINYDIR_FILENAME_MAX];
	_tinydir_char_t *extension;
	int is_dir;
	int is_reg;

#ifndef _MSC_VER
#ifdef __MINGW32__
	struct _stat _s;
#else
	struct stat _s;
#endif
#endif
} tinydir_file;

typedef struct tinydir_dir
{
	_tinydir_char_t path[_TINYDIR_PATH_MAX];
	int has_next;
	size_t n_files;

	tinydir_file *_files;
#ifdef _MSC_VER
	HANDLE _h;
	WIN32_FIND_DATA _f;
#else
	_TINYDIR_DIR *_d;
	struct _tinydir_dirent *_e;
#ifndef _TINYDIR_USE_READDIR
	struct _tinydir_dirent *_ep;
#endif
#endif
} tinydir_dir;


/* declarations */

_TINYDIR_FUNC
int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path);
_TINYDIR_FUNC
int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path);
_TINYDIR_FUNC
void tinydir_close(tinydir_dir *dir);

_TINYDIR_FUNC
int tinydir_next(tinydir_dir *dir);
_TINYDIR_FUNC
int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file);
_TINYDIR_FUNC
int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i);
_TINYDIR_FUNC
int tinydir_open_subdir_n(tinydir_dir *dir, size_t i);

_TINYDIR_FUNC
int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path);
_TINYDIR_FUNC
void _tinydir_get_ext(tinydir_file *file);
_TINYDIR_FUNC
int _tinydir_file_cmp(const void *a, const void *b);
#ifndef _MSC_VER
#ifndef _TINYDIR_USE_READDIR
_TINYDIR_FUNC
size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp);
#endif
#endif


/* definitions*/

_TINYDIR_FUNC
int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path)
{
#ifndef _MSC_VER
#ifndef _TINYDIR_USE_READDIR
	int error;
	int size;	/* using int size */
#endif
#else
	_tinydir_char_t path_buf[_TINYDIR_PATH_MAX];
#endif
	_tinydir_char_t *pathp;

	if (dir == NULL || path == NULL || _tinydir_strlen(path) == 0)
	{
		errno = EINVAL;
		return -1;
	}
	if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
	{
		errno = ENAMETOOLONG;
		return -1;
	}

	/* initialise dir */
	dir->_files = NULL;
#ifdef _MSC_VER
	dir->_h = INVALID_HANDLE_VALUE;
#else
	dir->_d = NULL;
#ifndef _TINYDIR_USE_READDIR
	dir->_ep = NULL;
#endif
#endif
	tinydir_close(dir);

	_tinydir_strcpy(dir->path, path);
	/* Remove trailing slashes */
	pathp = &dir->path[_tinydir_strlen(dir->path) - 1];
	while (pathp != dir->path && (*pathp == TINYDIR_STRING('\\') || *pathp == TINYDIR_STRING('/')))
	{
		*pathp = TINYDIR_STRING('\0');
		pathp++;
	}
#ifdef _MSC_VER
	_tinydir_strcpy(path_buf, dir->path);
	_tinydir_strcat(path_buf, TINYDIR_STRING("\\*"));
#if (defined WINAPI_FAMILY) && (WINAPI_FAMILY != WINAPI_FAMILY_DESKTOP_APP)
	dir->_h = FindFirstFileEx(path_buf, FindExInfoStandard, &dir->_f, FindExSearchNameMatch, NULL, 0);
#else
	dir->_h = FindFirstFile(path_buf, &dir->_f);
#endif
	if (dir->_h == INVALID_HANDLE_VALUE)
	{
		errno = ENOENT;
#else
	dir->_d = _tinydir_opendir(path);
	if (dir->_d == NULL)
	{
#endif
		goto bail;
	}

	/* read first file */
	dir->has_next = 1;
#ifndef _MSC_VER
#ifdef _TINYDIR_USE_READDIR
	dir->_e = _tinydir_readdir(dir->_d);
#else
	/* allocate dirent buffer for readdir_r */
	size = _tinydir_dirent_buf_size(dir->_d); /* conversion to int */
	if (size == -1) return -1;
	dir->_ep = (struct _tinydir_dirent*)_TINYDIR_MALLOC(size);
	if (dir->_ep == NULL) return -1;

	error = readdir_r(dir->_d, dir->_ep, &dir->_e);
	if (error != 0) return -1;
#endif
	if (dir->_e == NULL)
	{
		dir->has_next = 0;
	}
#endif

	return 0;

bail:
	tinydir_close(dir);
	return -1;
}

_TINYDIR_FUNC
int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path)
{
	/* Count the number of files first, to pre-allocate the files array */
	size_t n_files = 0;
	if (tinydir_open(dir, path) == -1)
	{
		return -1;
	}
	while (dir->has_next)
	{
		n_files++;
		if (tinydir_next(dir) == -1)
		{
			goto bail;
		}
	}
	tinydir_close(dir);

	if (tinydir_open(dir, path) == -1)
	{
		return -1;
	}

	dir->n_files = 0;
	dir->_files = (tinydir_file *)_TINYDIR_MALLOC(sizeof *dir->_files * n_files);
	if (dir->_files == NULL)
	{
		goto bail;
	}
	while (dir->has_next)
	{
		tinydir_file *p_file;
		dir->n_files++;

		p_file = &dir->_files[dir->n_files - 1];
		if (tinydir_readfile(dir, p_file) == -1)
		{
			goto bail;
		}

		if (tinydir_next(dir) == -1)
		{
			goto bail;
		}

		/* Just in case the number of files has changed between the first and
		second reads, terminate without writing into unallocated memory */
		if (dir->n_files == n_files)
		{
			break;
		}
	}

	qsort(dir->_files, dir->n_files, sizeof(tinydir_file), _tinydir_file_cmp);

	return 0;

bail:
	tinydir_close(dir);
	return -1;
}

_TINYDIR_FUNC
void tinydir_close(tinydir_dir *dir)
{
	if (dir == NULL)
	{
		return;
	}

	memset(dir->path, 0, sizeof(dir->path));
	dir->has_next = 0;
	dir->n_files = 0;
	_TINYDIR_FREE(dir->_files);
	dir->_files = NULL;
#ifdef _MSC_VER
	if (dir->_h != INVALID_HANDLE_VALUE)
	{
		FindClose(dir->_h);
	}
	dir->_h = INVALID_HANDLE_VALUE;
#else
	if (dir->_d)
	{
		_tinydir_closedir(dir->_d);
	}
	dir->_d = NULL;
	dir->_e = NULL;
#ifndef _TINYDIR_USE_READDIR
	_TINYDIR_FREE(dir->_ep);
	dir->_ep = NULL;
#endif
#endif
}

_TINYDIR_FUNC
int tinydir_next(tinydir_dir *dir)
{
	if (dir == NULL)
	{
		errno = EINVAL;
		return -1;
	}
	if (!dir->has_next)
	{
		errno = ENOENT;
		return -1;
	}

#ifdef _MSC_VER
	if (FindNextFile(dir->_h, &dir->_f) == 0)
#else
#ifdef _TINYDIR_USE_READDIR
	dir->_e = _tinydir_readdir(dir->_d);
#else
	if (dir->_ep == NULL)
	{
		return -1;
	}
	if (readdir_r(dir->_d, dir->_ep, &dir->_e) != 0)
	{
		return -1;
	}
#endif
	if (dir->_e == NULL)
#endif
	{
		dir->has_next = 0;
#ifdef _MSC_VER
		if (GetLastError() != ERROR_SUCCESS &&
			GetLastError() != ERROR_NO_MORE_FILES)
		{
			tinydir_close(dir);
			errno = EIO;
			return -1;
		}
#endif
	}

	return 0;
}

_TINYDIR_FUNC
int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file)
{
	if (dir == NULL || file == NULL)
	{
		errno = EINVAL;
		return -1;
	}
#ifdef _MSC_VER
	if (dir->_h == INVALID_HANDLE_VALUE)
#else
	if (dir->_e == NULL)
#endif
	{
		errno = ENOENT;
		return -1;
	}
	if (_tinydir_strlen(dir->path) +
		_tinydir_strlen(
#ifdef _MSC_VER
			dir->_f.cFileName
#else
			dir->_e->d_name
#endif
		) + 1 + _TINYDIR_PATH_EXTRA >=
		_TINYDIR_PATH_MAX)
	{
		/* the path for the file will be too long */
		errno = ENAMETOOLONG;
		return -1;
	}
	if (_tinydir_strlen(
#ifdef _MSC_VER
			dir->_f.cFileName
#else
			dir->_e->d_name
#endif
		) >= _TINYDIR_FILENAME_MAX)
	{
		errno = ENAMETOOLONG;
		return -1;
	}

	_tinydir_strcpy(file->path, dir->path);
	_tinydir_strcat(file->path, TINYDIR_STRING("/"));
	_tinydir_strcpy(file->name,
#ifdef _MSC_VER
		dir->_f.cFileName
#else
		dir->_e->d_name
#endif
	);
	_tinydir_strcat(file->path, file->name);
#ifndef _MSC_VER
#ifdef __MINGW32__
	if (_tstat(
#else
	if (stat(
#endif
		file->path, &file->_s) == -1)
	{
		return -1;
	}
#endif
	_tinydir_get_ext(file);

	file->is_dir =
#ifdef _MSC_VER
		!!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
#else
		S_ISDIR(file->_s.st_mode);
#endif
	file->is_reg =
#ifdef _MSC_VER
		!!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NORMAL) ||
		(
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DEVICE) &&
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) &&
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_ENCRYPTED) &&
#ifdef FILE_ATTRIBUTE_INTEGRITY_STREAM
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_INTEGRITY_STREAM) &&
#endif
#ifdef FILE_ATTRIBUTE_NO_SCRUB_DATA
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NO_SCRUB_DATA) &&
#endif
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_OFFLINE) &&
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_TEMPORARY));
#else
		S_ISREG(file->_s.st_mode);
#endif

	return 0;
}

_TINYDIR_FUNC
int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i)
{
	if (dir == NULL || file == NULL)
	{
		errno = EINVAL;
		return -1;
	}
	if (i >= dir->n_files)
	{
		errno = ENOENT;
		return -1;
	}

	memcpy(file, &dir->_files[i], sizeof(tinydir_file));
	_tinydir_get_ext(file);

	return 0;
}

_TINYDIR_FUNC
int tinydir_open_subdir_n(tinydir_dir *dir, size_t i)
{
	_tinydir_char_t path[_TINYDIR_PATH_MAX];
	if (dir == NULL)
	{
		errno = EINVAL;
		return -1;
	}
	if (i >= dir->n_files || !dir->_files[i].is_dir)
	{
		errno = ENOENT;
		return -1;
	}

	_tinydir_strcpy(path, dir->_files[i].path);
	tinydir_close(dir);
	if (tinydir_open_sorted(dir, path) == -1)
	{
		return -1;
	}

	return 0;
}

/* Open a single file given its path */
_TINYDIR_FUNC
int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path)
{
	tinydir_dir dir;
	int result = 0;
	int found = 0;
	_tinydir_char_t dir_name_buf[_TINYDIR_PATH_MAX];
	_tinydir_char_t file_name_buf[_TINYDIR_FILENAME_MAX];
	_tinydir_char_t *dir_name;
	_tinydir_char_t *base_name;
#if (defined _MSC_VER || defined __MINGW32__)
	_tinydir_char_t drive_buf[_TINYDIR_PATH_MAX];
	_tinydir_char_t ext_buf[_TINYDIR_FILENAME_MAX];
#endif

	if (file == NULL || path == NULL || _tinydir_strlen(path) == 0)
	{
		errno = EINVAL;
		return -1;
	}
	if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
	{
		errno = ENAMETOOLONG;
		return -1;
	}

	/* Get the parent path */
#if (defined _MSC_VER || defined __MINGW32__)
#if ((defined _MSC_VER) && (_MSC_VER >= 1400))
		_tsplitpath_s(
			path,
			drive_buf, _TINYDIR_DRIVE_MAX,
			dir_name_buf, _TINYDIR_FILENAME_MAX,
			file_name_buf, _TINYDIR_FILENAME_MAX,
			ext_buf, _TINYDIR_FILENAME_MAX);
#else
		_tsplitpath(
			path,
			drive_buf,
			dir_name_buf,
			file_name_buf,
			ext_buf);
#endif

/* _splitpath_s not work fine with only filename and widechar support */
#ifdef _UNICODE
		if (drive_buf[0] == L'\xFEFE')
			drive_buf[0] = '\0';
		if (dir_name_buf[0] == L'\xFEFE')
			dir_name_buf[0] = '\0';
#endif

	if (errno)
	{
		errno = EINVAL;
		return -1;
	}
	/* Emulate the behavior of dirname by returning "." for dir name if it's
	empty */
	if (drive_buf[0] == '\0' && dir_name_buf[0] == '\0')
	{
		_tinydir_strcpy(dir_name_buf, TINYDIR_STRING("."));
	}
	/* Concatenate the drive letter and dir name to form full dir name */
	_tinydir_strcat(drive_buf, dir_name_buf);
	dir_name = drive_buf;
	/* Concatenate the file name and extension to form base name */
	_tinydir_strcat(file_name_buf, ext_buf);
	base_name = file_name_buf;
#else
	_tinydir_strcpy(dir_name_buf, path);
	dir_name = dirname(dir_name_buf);
	_tinydir_strcpy(file_name_buf, path);
	base_name =basename(file_name_buf);
#endif

	/* Open the parent directory */
	if (tinydir_open(&dir, dir_name) == -1)
	{
		return -1;
	}

	/* Read through the parent directory and look for the file */
	while (dir.has_next)
	{
		if (tinydir_readfile(&dir, file) == -1)
		{
			result = -1;
			goto bail;
		}
		if (_tinydir_strcmp(file->name, base_name) == 0)
		{
			/* File found */
			found = 1;
			break;
		}
		tinydir_next(&dir);
	}
	if (!found)
	{
		result = -1;
		errno = ENOENT;
	}

bail:
	tinydir_close(&dir);
	return result;
}

_TINYDIR_FUNC
void _tinydir_get_ext(tinydir_file *file)
{
	_tinydir_char_t *period = _tinydir_strrchr(file->name, TINYDIR_STRING('.'));
	if (period == NULL)
	{
		file->extension = &(file->name[_tinydir_strlen(file->name)]);
	}
	else
	{
		file->extension = period + 1;
	}
}

_TINYDIR_FUNC
int _tinydir_file_cmp(const void *a, const void *b)
{
	const tinydir_file *fa = (const tinydir_file *)a;
	const tinydir_file *fb = (const tinydir_file *)b;
	if (fa->is_dir != fb->is_dir)
	{
		return -(fa->is_dir - fb->is_dir);
	}
	return _tinydir_strncmp(fa->name, fb->name, _TINYDIR_FILENAME_MAX);
}

#ifndef _MSC_VER
#ifndef _TINYDIR_USE_READDIR
/*
The following authored by Ben Hutchings <ben@decadent.org.uk>
from https://womble.decadent.org.uk/readdir_r-advisory.html
*/
/* Calculate the required buffer size (in bytes) for directory      *
* entries read from the given directory handle.  Return -1 if this  *
* this cannot be done.                                              *
*                                                                   *
* This code does not trust values of NAME_MAX that are less than    *
* 255, since some systems (including at least HP-UX) incorrectly    *
* define it to be a smaller value.                                  */
_TINYDIR_FUNC
size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp)
{
	long name_max;
	size_t name_end;
	/* parameter may be unused */
	(void)dirp;

#if defined _TINYDIR_USE_FPATHCONF
	name_max = fpathconf(dirfd(dirp), _PC_NAME_MAX);
	if (name_max == -1)
#if defined(NAME_MAX)
		name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
#else
		return (size_t)(-1);
#endif
#elif defined(NAME_MAX)
 	name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
#else
#error "buffer size for readdir_r cannot be determined"
#endif
	name_end = (size_t)offsetof(struct _tinydir_dirent, d_name) + name_max + 1;
	return (name_end > sizeof(struct _tinydir_dirent) ?
		name_end : sizeof(struct _tinydir_dirent));
}
#endif
#endif

#ifdef __cplusplus
}
#endif

# if defined (_MSC_VER)
# pragma warning(pop)
# endif

#endif
compat/zlib/win32/zdll.lib became a regular file.

cannot compute difference between binary files

Changes to doc/AddErrInfo.3.
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
this points to the first byte of an array of \fIlength\fR bytes
containing a string to append to the \fB\-errorinfo\fR return option.
This byte array may contain embedded null bytes
unless \fIlength\fR is negative.
.AP Tcl_Obj *objPtr in
A message to be appended to the \fB\-errorinfo\fR return option
in the form of a Tcl_Obj value.
.AP int length in
The number of bytes to copy from \fImessage\fR when
appending to the \fB\-errorinfo\fR return option.
If negative, all bytes up to the first null byte are used.
.AP Tcl_Obj *errorObjPtr in
The \fB\-errorcode\fR return option will be set to this value.
.AP char *element in
String to record as one element of the \fB\-errorcode\fR return option.
Last \fIelement\fR argument must be NULL.
.AP va_list argList in
An argument list which must have been initialized using







|


|







54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
this points to the first byte of an array of \fIlength\fR bytes
containing a string to append to the \fB\-errorinfo\fR return option.
This byte array may contain embedded null bytes
unless \fIlength\fR is negative.
.AP Tcl_Obj *objPtr in
A message to be appended to the \fB\-errorinfo\fR return option
in the form of a Tcl_Obj value.
.AP size_t length in
The number of bytes to copy from \fImessage\fR when
appending to the \fB\-errorinfo\fR return option.
If (size_t)-1, all bytes up to the first null byte are used.
.AP Tcl_Obj *errorObjPtr in
The \fB\-errorcode\fR return option will be set to this value.
.AP char *element in
String to record as one element of the \fB\-errorcode\fR return option.
Last \fIelement\fR argument must be NULL.
.AP va_list argList in
An argument list which must have been initialized using
Changes to doc/Alloc.3.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
char *
\fBTcl_Alloc\fR(\fIsize\fR)
.sp
void
\fBTcl_Free\fR(\fIptr\fR)
.sp
char *
\fBTcl_Realloc\fR(\fIptr, size\fR)
.sp
char *
\fBTcl_AttemptAlloc\fR(\fIsize\fR)
.sp
char *
\fBTcl_AttemptRealloc\fR(\fIptr, size\fR)
.sp
char *
\fBckalloc\fR(\fIsize\fR)
.sp
void
\fBckfree\fR(\fIptr\fR)
.sp
char *
\fBckrealloc\fR(\fIptr, size\fR)
.sp
char *
\fBattemptckalloc\fR(\fIsize\fR)
.sp
char *
\fBattemptckrealloc\fR(\fIptr, size\fR)
.SH ARGUMENTS
.AS char *size
.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.
.BE










|










|


|


<
<
<
<
<
<
|
<
<
<
|
<
<
<
<
<
<







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27






28



29






30
31
32
33
34
35
36
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc \- allocate or free heap memory
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
char *
\fBTcl_Alloc\fR(\fIsize\fR)
.sp
void
\fBTcl_Free\fR(\fIptr\fR)
.sp
void *
\fBTcl_Realloc\fR(\fIptr, size\fR)
.sp
void *
\fBTcl_AttemptAlloc\fR(\fIsize\fR)
.sp






void *



\fBTcl_AttemptRealloc\fR(\fIptr, size\fR)






.SH ARGUMENTS
.AS char *size
.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.
.BE
75
76
77
78
79
80
81
82
83
84
85
86


87
88
89
90
91
92
function to \fBTcl_Alloc\fR and \fBTcl_Realloc\fR, except that
\fBTcl_AttemptAlloc\fR and \fBTcl_AttemptRealloc\fR will not cause the Tcl
interpreter to \fBpanic\fR if the memory allocation fails.  If the
allocation fails, these functions will return NULL.  Note that on some
platforms, but not all, attempting to allocate a zero-sized block of
memory will also cause these functions to return NULL.
.PP
The procedures \fBckalloc\fR, \fBckfree\fR, \fBckrealloc\fR,
\fBattemptckalloc\fR, and \fBattemptckrealloc\fR are implemented
as macros.  Normally, they are synonyms for the corresponding
procedures documented on this page.  When Tcl and all modules
calling Tcl are compiled with \fBTCL_MEM_DEBUG\fR defined, however,


these macros are redefined to be special debugging versions
of these procedures.  To support Tcl's memory debugging within a
module, use the macros rather than direct calls to \fBTcl_Alloc\fR, etc.

.SH KEYWORDS
alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG







<
<
<
<
|
>
>
|
<
<



60
61
62
63
64
65
66




67
68
69
70


71
72
73
function to \fBTcl_Alloc\fR and \fBTcl_Realloc\fR, except that
\fBTcl_AttemptAlloc\fR and \fBTcl_AttemptRealloc\fR will not cause the Tcl
interpreter to \fBpanic\fR if the memory allocation fails.  If the
allocation fails, these functions will return NULL.  Note that on some
platforms, but not all, attempting to allocate a zero-sized block of
memory will also cause these functions to return NULL.
.PP




When a module or Tcl itself is compiled with \fBTCL_MEM_DEBUG\fR defined,
the procedures \fBTcl_Alloc\fR, \fBTcl_Free\fR, \fBTcl_Realloc\fR,
\fBTcl_AttemptAlloc\fR, and \fBTcl_AttempRealloc\fR are implemented
as macros, redefined to be special debugging versions of these procedures.



.SH KEYWORDS
alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG
Changes to doc/AssocData.3.
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
.BS
.SH NAME
Tcl_GetAssocData, Tcl_SetAssocData, Tcl_DeleteAssocData \- manage associations of string keys and user specified data with Tcl interpreters
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
ClientData
\fBTcl_GetAssocData\fR(\fIinterp, key, delProcPtr\fR)
.sp
\fBTcl_SetAssocData\fR(\fIinterp, key, delProc, clientData\fR)
.sp
\fBTcl_DeleteAssocData\fR(\fIinterp, key\fR)
.SH ARGUMENTS
.AS Tcl_InterpDeleteProc **delProcPtr
.AP Tcl_Interp *interp in
Interpreter in which to execute the specified command.
.AP "const char" *key in
Key for association with which to store data or from which to delete or
retrieve data.  Typically the module prefix for a package.
.AP Tcl_InterpDeleteProc *delProc in
Procedure to call when \fIinterp\fR is deleted.
.AP Tcl_InterpDeleteProc **delProcPtr in
Pointer to location in which to store address of current deletion procedure
for association.  Ignored if NULL.
.AP ClientData clientData in
Arbitrary one-word value associated with the given key in this
interpreter.  This data is owned by the caller.
.BE

.SH DESCRIPTION
.PP
These procedures allow extensions to associate their own data with







|

















|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
.BS
.SH NAME
Tcl_GetAssocData, Tcl_SetAssocData, Tcl_DeleteAssocData \- manage associations of string keys and user specified data with Tcl interpreters
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void *
\fBTcl_GetAssocData\fR(\fIinterp, key, delProcPtr\fR)
.sp
\fBTcl_SetAssocData\fR(\fIinterp, key, delProc, clientData\fR)
.sp
\fBTcl_DeleteAssocData\fR(\fIinterp, key\fR)
.SH ARGUMENTS
.AS Tcl_InterpDeleteProc **delProcPtr
.AP Tcl_Interp *interp in
Interpreter in which to execute the specified command.
.AP "const char" *key in
Key for association with which to store data or from which to delete or
retrieve data.  Typically the module prefix for a package.
.AP Tcl_InterpDeleteProc *delProc in
Procedure to call when \fIinterp\fR is deleted.
.AP Tcl_InterpDeleteProc **delProcPtr in
Pointer to location in which to store address of current deletion procedure
for association.  Ignored if NULL.
.AP void *clientData in
Arbitrary one-word value associated with the given key in this
interpreter.  This data is owned by the caller.
.BE

.SH DESCRIPTION
.PP
These procedures allow extensions to associate their own data with
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
If the \fIdeleteProc\fR argument is non-NULL it specifies the address of a
procedure to invoke if the interpreter is deleted before the association
is deleted.  \fIDeleteProc\fR should have arguments and result that match
the type \fBTcl_InterpDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_InterpDeleteProc\fR(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
When \fIdeleteProc\fR is invoked the \fIclientData\fR and \fIinterp\fR
arguments will be the same as the corresponding arguments passed to
\fBTcl_SetAssocData\fR.
The deletion procedure will \fInot\fR be invoked if the association







|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
If the \fIdeleteProc\fR argument is non-NULL it specifies the address of a
procedure to invoke if the interpreter is deleted before the association
is deleted.  \fIDeleteProc\fR should have arguments and result that match
the type \fBTcl_InterpDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_InterpDeleteProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
When \fIdeleteProc\fR is invoked the \fIclientData\fR and \fIinterp\fR
arguments will be the same as the corresponding arguments passed to
\fBTcl_SetAssocData\fR.
The deletion procedure will \fInot\fR be invoked if the association
Changes to doc/Async.3.
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
.sp
int
\fBTcl_AsyncReady\fR()
.SH ARGUMENTS
.AS Tcl_AsyncHandler clientData
.AP Tcl_AsyncProc *proc in
Procedure to invoke to handle an asynchronous event.
.AP ClientData clientData in
One-word value to pass to \fIproc\fR.
.AP Tcl_AsyncHandler async in
Token for asynchronous event handler.
.AP Tcl_Interp *interp in
Tcl interpreter in which command was being evaluated when handler was
invoked, or NULL if handler was invoked when there was no interpreter
active.







|







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
.sp
int
\fBTcl_AsyncReady\fR()
.SH ARGUMENTS
.AS Tcl_AsyncHandler clientData
.AP Tcl_AsyncProc *proc in
Procedure to invoke to handle an asynchronous event.
.AP void *clientData in
One-word value to pass to \fIproc\fR.
.AP Tcl_AsyncHandler async in
Token for asynchronous event handler.
.AP Tcl_Interp *interp in
Tcl interpreter in which command was being evaluated when handler was
invoked, or NULL if handler was invoked when there was no interpreter
active.
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
the world is in a safe state, and \fIproc\fR can then carry out
the actions associated with the asynchronous event.
\fIProc\fR should have arguments and result that match the
type \fBTcl_AsyncProc\fR:
.PP
.CS
typedef int \fBTcl_AsyncProc\fR(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIcode\fR);
.CE
.PP
The \fIclientData\fR will be the same as the \fIclientData\fR
argument passed to \fBTcl_AsyncCreate\fR when the handler was
created.







|







80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
the world is in a safe state, and \fIproc\fR can then carry out
the actions associated with the asynchronous event.
\fIProc\fR should have arguments and result that match the
type \fBTcl_AsyncProc\fR:
.PP
.CS
typedef int \fBTcl_AsyncProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIcode\fR);
.CE
.PP
The \fIclientData\fR will be the same as the \fIclientData\fR
argument passed to \fBTcl_AsyncCreate\fR when the handler was
created.
Changes to doc/ByteArrObj.3.
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
unsigned char *
\fBTcl_SetByteArrayLength\fR(\fIobjPtr, length\fR)
.SH ARGUMENTS
.AS "const unsigned char" *lengthPtr in/out
.AP "const unsigned char" *bytes in
The array of bytes used to initialize or set a byte-array value. May be NULL
even if \fIlength\fR is non-zero.
.AP int length in
The length of the array of bytes.  It must be >= 0.
.AP Tcl_Obj *objPtr in/out
For \fBTcl_SetByteArrayObj\fR, this points to the value to be converted to
byte-array type.  For \fBTcl_GetByteArrayFromObj\fR and
\fBTcl_SetByteArrayLength\fR, this points to the value from which to get
the byte-array value; if \fIobjPtr\fR does not already point to a byte-array
value, it will be converted to one.
.AP int *lengthPtr out







|
|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
unsigned char *
\fBTcl_SetByteArrayLength\fR(\fIobjPtr, length\fR)
.SH ARGUMENTS
.AS "const unsigned char" *lengthPtr in/out
.AP "const unsigned char" *bytes in
The array of bytes used to initialize or set a byte-array value. May be NULL
even if \fIlength\fR is non-zero.
.AP size_t length in
The length of the array of bytes.
.AP Tcl_Obj *objPtr in/out
For \fBTcl_SetByteArrayObj\fR, this points to the value to be converted to
byte-array type.  For \fBTcl_GetByteArrayFromObj\fR and
\fBTcl_SetByteArrayLength\fR, this points to the value from which to get
the byte-array value; if \fIobjPtr\fR does not already point to a byte-array
value, it will be converted to one.
.AP int *lengthPtr out
Changes to doc/CallDel.3.
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
\fBTcl_DontCallWhenDeleted\fR(\fIinterp\fR, \fIproc\fR, \fIclientData\fR)
.SH ARGUMENTS
.AS Tcl_InterpDeleteProc clientData
.AP Tcl_Interp *interp in
Interpreter with which to associated callback.
.AP Tcl_InterpDeleteProc *proc in
Procedure to call when \fIinterp\fR is deleted.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CallWhenDeleted\fR arranges for \fIproc\fR to be called by
\fBTcl_DeleteInterp\fR if/when \fIinterp\fR is deleted at some future
time.  \fIProc\fR will be invoked just before the interpreter
is deleted, but the interpreter will still be valid at the
time of the call.
\fIProc\fR should have arguments and result that match the
type \fBTcl_InterpDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_InterpDeleteProc\fR(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters are
copies of the \fIclientData\fR and \fIinterp\fR arguments given
to \fBTcl_CallWhenDeleted\fR.
Typically, \fIclientData\fR points to an application-specific







|














|







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
\fBTcl_DontCallWhenDeleted\fR(\fIinterp\fR, \fIproc\fR, \fIclientData\fR)
.SH ARGUMENTS
.AS Tcl_InterpDeleteProc clientData
.AP Tcl_Interp *interp in
Interpreter with which to associated callback.
.AP Tcl_InterpDeleteProc *proc in
Procedure to call when \fIinterp\fR is deleted.
.AP void *clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CallWhenDeleted\fR arranges for \fIproc\fR to be called by
\fBTcl_DeleteInterp\fR if/when \fIinterp\fR is deleted at some future
time.  \fIProc\fR will be invoked just before the interpreter
is deleted, but the interpreter will still be valid at the
time of the call.
\fIProc\fR should have arguments and result that match the
type \fBTcl_InterpDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_InterpDeleteProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters are
copies of the \fIclientData\fR and \fIinterp\fR arguments given
to \fBTcl_CallWhenDeleted\fR.
Typically, \fIclientData\fR points to an application-specific
Changes to doc/Cancel.3.
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
not NULL, this object will have its reference count decremented before
\fBTcl_CancelEval\fR returns.
.AP int flags in
ORed combination of flag bits that specify additional options.
For \fBTcl_CancelEval\fR, only \fBTCL_CANCEL_UNWIND\fR is currently
supported.  For \fBTcl_Canceled\fR, only \fBTCL_LEAVE_ERR_MSG\fR and
\fBTCL_CANCEL_UNWIND\fR are currently supported.
.AP ClientData clientData in
Currently reserved for future use.
It should be set to NULL.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CancelEval\fR cancels or unwinds the script in progress soon after
the next invocation of asynchronous handlers, causing \fBTCL_ERROR\fR to be







|







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
not NULL, this object will have its reference count decremented before
\fBTcl_CancelEval\fR returns.
.AP int flags in
ORed combination of flag bits that specify additional options.
For \fBTcl_CancelEval\fR, only \fBTCL_CANCEL_UNWIND\fR is currently
supported.  For \fBTcl_Canceled\fR, only \fBTCL_LEAVE_ERR_MSG\fR and
\fBTCL_CANCEL_UNWIND\fR are currently supported.
.AP void *clientData in
Currently reserved for future use.
It should be set to NULL.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CancelEval\fR cancels or unwinds the script in progress soon after
the next invocation of asynchronous handlers, causing \fBTCL_ERROR\fR to be
Changes to doc/ChnlStack.3.
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
.sp
.SH ARGUMENTS
.AS Tcl_ChannelType clientData
.AP Tcl_Interp *interp in
Interpreter for error reporting.
.AP "const Tcl_ChannelType" *typePtr in
The new channel I/O procedures to use for \fIchannel\fR.
.AP ClientData clientData in
Arbitrary one-word value to pass to channel I/O procedures.
.AP int mask in
Conditions under which \fIchannel\fR will be used: OR-ed combination of
\fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR.
This can be a subset of the operations currently allowed on \fIchannel\fR.
.AP Tcl_Channel channel in
An existing Tcl channel such as returned by \fBTcl_CreateChannel\fR.







|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
.sp
.SH ARGUMENTS
.AS Tcl_ChannelType clientData
.AP Tcl_Interp *interp in
Interpreter for error reporting.
.AP "const Tcl_ChannelType" *typePtr in
The new channel I/O procedures to use for \fIchannel\fR.
.AP void *clientData in
Arbitrary one-word value to pass to channel I/O procedures.
.AP int mask in
Conditions under which \fIchannel\fR will be used: OR-ed combination of
\fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR.
This can be a subset of the operations currently allowed on \fIchannel\fR.
.AP Tcl_Channel channel in
An existing Tcl channel such as returned by \fBTcl_CreateChannel\fR.
Changes to doc/Class.3.
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
.sp
Tcl_Object
\fBTcl_CopyObjectInstance\fR(\fIinterp, object, name, nsName\fR)
.sp
int
\fBTcl_ObjectDeleted\fR(\fIobject\fR)
.sp
ClientData
\fBTcl_ObjectGetMetadata\fR(\fIobject, metaTypePtr\fR)
.sp
\fBTcl_ObjectSetMetadata\fR(\fIobject, metaTypePtr, metadata\fR)
.sp
ClientData
\fBTcl_ClassGetMetadata\fR(\fIclass, metaTypePtr\fR)
.sp
\fBTcl_ClassSetMetadata\fR(\fIclass, metaTypePtr, metadata\fR)
.sp
Tcl_ObjectMapMethodNameProc
\fBTcl_ObjectGetMethodNameMapper\fR(\fIobject\fR)
.sp
\fBTcl_ObjectSetMethodNameMapper\fR(\fIobject\fR, \fImethodNameMapper\fR)
.SH ARGUMENTS
.AS ClientData metadata in/out
.AP Tcl_Interp *interp in/out
Interpreter providing the context for looking up or creating an object, and
into whose result error messages will be written on failure.
.AP Tcl_Obj *objPtr in
The name of the object to look up.
.AP Tcl_Object object in
Reference to the object to operate upon.







|




|









|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
.sp
Tcl_Object
\fBTcl_CopyObjectInstance\fR(\fIinterp, object, name, nsName\fR)
.sp
int
\fBTcl_ObjectDeleted\fR(\fIobject\fR)
.sp
void *
\fBTcl_ObjectGetMetadata\fR(\fIobject, metaTypePtr\fR)
.sp
\fBTcl_ObjectSetMetadata\fR(\fIobject, metaTypePtr, metadata\fR)
.sp
void *
\fBTcl_ClassGetMetadata\fR(\fIclass, metaTypePtr\fR)
.sp
\fBTcl_ClassSetMetadata\fR(\fIclass, metaTypePtr, metadata\fR)
.sp
Tcl_ObjectMapMethodNameProc
\fBTcl_ObjectGetMethodNameMapper\fR(\fIobject\fR)
.sp
\fBTcl_ObjectSetMethodNameMapper\fR(\fIobject\fR, \fImethodNameMapper\fR)
.SH ARGUMENTS
.AS void *metadata in/out
.AP Tcl_Interp *interp in/out
Interpreter providing the context for looking up or creating an object, and
into whose result error messages will be written on failure.
.AP Tcl_Obj *objPtr in
The name of the object to look up.
.AP Tcl_Object object in
Reference to the object to operate upon.
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
The arguments to the command to create the instance of the class.
.AP int skip in
The number of arguments at the start of the argument array, \fIobjv\fR, that
are not arguments to any constructors.
.AP Tcl_ObjectMetadataType *metaTypePtr in
The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or
retrieved with \fBTcl_ClassGetMetadata\fR.
.AP ClientData metadata in
An item of metadata to attach to the class, or NULL to remove the metadata
associated with a particular \fImetaTypePtr\fR.
.AP "Tcl_ObjectMapMethodNameProc" "methodNameMapper" in
A pointer to a function to call to adjust the mapping of objects and method
names to implementations, or NULL when no such mapping is required.
.BE
.SH DESCRIPTION







|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
The arguments to the command to create the instance of the class.
.AP int skip in
The number of arguments at the start of the argument array, \fIobjv\fR, that
are not arguments to any constructors.
.AP Tcl_ObjectMetadataType *metaTypePtr in
The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or
retrieved with \fBTcl_ClassGetMetadata\fR.
.AP void *metadata in
An item of metadata to attach to the class, or NULL to remove the metadata
associated with a particular \fImetaTypePtr\fR.
.AP "Tcl_ObjectMapMethodNameProc" "methodNameMapper" in
A pointer to a function to call to adjust the mapping of objects and method
names to implementations, or NULL when no such mapping is required.
.BE
.SH DESCRIPTION
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
.SS "TCL_OBJECTMETADATADELETEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used to delete metadata associated with
a class or object.
.PP
.CS
typedef void \fBTcl_ObjectMetadataDeleteProc\fR(
        ClientData \fImetadata\fR);
.CE
.PP
The \fImetadata\fR argument gives the address of the metadata to be
deleted.
.SS "TCL_CLONEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used to create copies of metadata
associated with a class or object.
.PP
.CS
typedef int \fBTcl_CloneProc\fR(
        Tcl_Interp *\fIinterp\fR,
        ClientData \fIsrcMetadata\fR,
        ClientData *\fIdstMetadataPtr\fR);
.CE
.PP
The \fIinterp\fR argument gives a place to write an error message when the
attempt to clone the object is to fail, in which case the clone procedure must
also return TCL_ERROR; it should return TCL_OK otherwise.
The \fIsrcMetadata\fR argument gives the address of the metadata to be cloned,
and the cloned metadata should be written into the variable pointed to by







|












|
|







167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
.SS "TCL_OBJECTMETADATADELETEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used to delete metadata associated with
a class or object.
.PP
.CS
typedef void \fBTcl_ObjectMetadataDeleteProc\fR(
        void *\fImetadata\fR);
.CE
.PP
The \fImetadata\fR argument gives the address of the metadata to be
deleted.
.SS "TCL_CLONEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used to create copies of metadata
associated with a class or object.
.PP
.CS
typedef int \fBTcl_CloneProc\fR(
        Tcl_Interp *\fIinterp\fR,
        void *\fIsrcMetadata\fR,
        void **\fIdstMetadataPtr\fR);
.CE
.PP
The \fIinterp\fR argument gives a place to write an error message when the
attempt to clone the object is to fail, in which case the clone procedure must
also return TCL_ERROR; it should return TCL_OK otherwise.
The \fIsrcMetadata\fR argument gives the address of the metadata to be cloned,
and the cloned metadata should be written into the variable pointed to by
Changes to doc/CrtChannel.3.
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Channel
\fBTcl_CreateChannel\fR(\fItypePtr, channelName, instanceData, mask\fR)
.sp
ClientData
\fBTcl_GetChannelInstanceData\fR(\fIchannel\fR)
.sp
const Tcl_ChannelType *
\fBTcl_GetChannelType\fR(\fIchannel\fR)
.sp
const char *
\fBTcl_GetChannelName\fR(\fIchannel\fR)







|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Channel
\fBTcl_CreateChannel\fR(\fItypePtr, channelName, instanceData, mask\fR)
.sp
void *
\fBTcl_GetChannelInstanceData\fR(\fIchannel\fR)
.sp
const Tcl_ChannelType *
\fBTcl_GetChannelType\fR(\fIchannel\fR)
.sp
const char *
\fBTcl_GetChannelName\fR(\fIchannel\fR)
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
can be called to perform I/O and other functions on the channel.
.AP "const char" *channelName in
The name of this channel, such as \fBfile3\fR; must not be in use
by any other channel. Can be NULL, in which case the channel is
created without a name. If the created channel is assigned to one
of the standard channels (\fBstdin\fR, \fBstdout\fR or \fBstderr\fR),
the assigned channel name will be the name of the standard channel.
.AP ClientData instanceData in
Arbitrary one-word value to be associated with this channel.  This
value is passed to procedures in \fItypePtr\fR when they are invoked.
.AP int mask in
OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
whether a channel is readable and writable.
.AP Tcl_Channel channel in
The channel to operate on.
.AP int direction in
\fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR
means the output handle is wanted.
.AP ClientData *handlePtr out
Points to the location where the desired OS-specific handle should be
stored.
.AP int size in
The size, in bytes, of buffers to allocate in this channel.
.AP int mask in
An OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
and \fBTCL_EXCEPTION\fR that indicates events that have occurred on







|










|







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
can be called to perform I/O and other functions on the channel.
.AP "const char" *channelName in
The name of this channel, such as \fBfile3\fR; must not be in use
by any other channel. Can be NULL, in which case the channel is
created without a name. If the created channel is assigned to one
of the standard channels (\fBstdin\fR, \fBstdout\fR or \fBstderr\fR),
the assigned channel name will be the name of the standard channel.
.AP void *instanceData in
Arbitrary one-word value to be associated with this channel.  This
value is passed to procedures in \fItypePtr\fR when they are invoked.
.AP int mask in
OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
whether a channel is readable and writable.
.AP Tcl_Channel channel in
The channel to operate on.
.AP int direction in
\fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR
means the output handle is wanted.
.AP void **handlePtr out
Points to the location where the desired OS-specific handle should be
stored.
.AP int size in
The size, in bytes, of buffers to allocate in this channel.
.AP int mask in
An OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
and \fBTCL_EXCEPTION\fR that indicates events that have occurred on
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
.PP
The \fIblockModeProc\fR field contains the address of a function called by
the generic layer to set blocking and nonblocking mode on the device.
\fIBlockModeProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverBlockModeProc\fR(
        ClientData \fIinstanceData\fR,
        int \fImode\fR);
.CE
.PP
The \fIinstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created.  The \fImode\fR
argument is either \fBTCL_MODE_BLOCKING\fR or \fBTCL_MODE_NONBLOCKING\fR to
set the device into blocking or nonblocking mode. The function should







|







395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
.PP
The \fIblockModeProc\fR field contains the address of a function called by
the generic layer to set blocking and nonblocking mode on the device.
\fIBlockModeProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverBlockModeProc\fR(
        void *\fIinstanceData\fR,
        int \fImode\fR);
.CE
.PP
The \fIinstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created.  The \fImode\fR
argument is either \fBTCL_MODE_BLOCKING\fR or \fBTCL_MODE_NONBLOCKING\fR to
set the device into blocking or nonblocking mode. The function should
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
.PP
The \fIcloseProc\fR field contains the address of a function called by the
generic layer to clean up driver-related information when the channel is
closed. \fICloseProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverCloseProc\fR(
        ClientData \fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIinstanceData\fR argument is the same as the value provided to
\fBTcl_CreateChannel\fR when the channel was created. The function should
release any storage maintained by the channel driver for this channel, and
close the input and output devices encapsulated by this channel. All queued







|







430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
.PP
The \fIcloseProc\fR field contains the address of a function called by the
generic layer to clean up driver-related information when the channel is
closed. \fICloseProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverCloseProc\fR(
        void *\fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIinstanceData\fR argument is the same as the value provided to
\fBTcl_CreateChannel\fR when the channel was created. The function should
release any storage maintained by the channel driver for this channel, and
close the input and output devices encapsulated by this channel. All queued
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
Alternatively, channels that support closing the read and write sides
independently may set \fIcloseProc\fR to \fBTCL_CLOSE2PROC\fR and set
\fIclose2Proc\fR to the address of a function that matches the
following prototype:
.PP
.CS
typedef int \fBTcl_DriverClose2Proc\fR(
        ClientData \fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclose2Proc\fR will be called with \fIflags\fR set to an OR'ed
combination of \fBTCL_CLOSE_READ\fR or \fBTCL_CLOSE_WRITE\fR to
indicate that the driver should close the read and/or write side of







|







452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
Alternatively, channels that support closing the read and write sides
independently may set \fIcloseProc\fR to \fBTCL_CLOSE2PROC\fR and set
\fIclose2Proc\fR to the address of a function that matches the
following prototype:
.PP
.CS
typedef int \fBTcl_DriverClose2Proc\fR(
        void *\fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclose2Proc\fR will be called with \fIflags\fR set to an OR'ed
combination of \fBTCL_CLOSE_READ\fR or \fBTCL_CLOSE_WRITE\fR to
indicate that the driver should close the read and/or write side of
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
.PP
The \fIinputProc\fR field contains the address of a function called by the
generic layer to read data from the file or device and store it in an
internal buffer. \fIInputProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverInputProc\fR(
        ClientData \fIinstanceData\fR,
        char *\fIbuf\fR,
        int \fIbufSize\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when the channel was created.  The \fIbuf\fR







|







483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
.PP
The \fIinputProc\fR field contains the address of a function called by the
generic layer to read data from the file or device and store it in an
internal buffer. \fIInputProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverInputProc\fR(
        void *\fIinstanceData\fR,
        char *\fIbuf\fR,
        int \fIbufSize\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when the channel was created.  The \fIbuf\fR
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
.PP
The \fIoutputProc\fR field contains the address of a function called by the
generic layer to transfer data from an internal buffer to the output device.
\fIOutputProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverOutputProc\fR(
        ClientData \fIinstanceData\fR,
        const char *\fIbuf\fR,
        int \fItoWrite\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when the channel was created. The \fIbuf\fR







|







527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
.PP
The \fIoutputProc\fR field contains the address of a function called by the
generic layer to transfer data from an internal buffer to the output device.
\fIOutputProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverOutputProc\fR(
        void *\fIinstanceData\fR,
        const char *\fIbuf\fR,
        int \fItoWrite\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when the channel was created. The \fIbuf\fR
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
The \fIseekProc\fR field contains the address of a function called by the
generic layer to move the access point at which subsequent input or output
operations will be applied. \fISeekProc\fR must match the following
prototype:
.PP
.CS
typedef int \fBTcl_DriverSeekProc\fR(
        ClientData \fIinstanceData\fR,
        long \fIoffset\fR,
        int \fIseekMode\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
The \fIinstanceData\fR argument is the same as the value given to
\fBTcl_CreateChannel\fR when this channel was created.  \fIOffset\fR and







|







566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
The \fIseekProc\fR field contains the address of a function called by the
generic layer to move the access point at which subsequent input or output
operations will be applied. \fISeekProc\fR must match the following
prototype:
.PP
.CS
typedef int \fBTcl_DriverSeekProc\fR(
        void *\fIinstanceData\fR,
        long \fIoffset\fR,
        int \fIseekMode\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
The \fIinstanceData\fR argument is the same as the value given to
\fBTcl_CreateChannel\fR when this channel was created.  \fIOffset\fR and
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
within files larger than 2GB.  The \fIwideSeekProc\fR will be called
in preference to the \fIseekProc\fR, but both must be defined if the
\fIwideSeekProc\fR is defined.  \fIWideSeekProc\fR must match the
following prototype:
.PP
.CS
typedef Tcl_WideInt \fBTcl_DriverWideSeekProc\fR(
        ClientData \fIinstanceData\fR,
        Tcl_WideInt \fIoffset\fR,
        int \fIseekMode\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
The arguments and return values mean the same thing as with
\fIseekProc\fR above, except that the type of offsets and the return







|







596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
within files larger than 2GB.  The \fIwideSeekProc\fR will be called
in preference to the \fIseekProc\fR, but both must be defined if the
\fIwideSeekProc\fR is defined.  \fIWideSeekProc\fR must match the
following prototype:
.PP
.CS
typedef Tcl_WideInt \fBTcl_DriverWideSeekProc\fR(
        void *\fIinstanceData\fR,
        Tcl_WideInt \fIoffset\fR,
        int \fIseekMode\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
The arguments and return values mean the same thing as with
\fIseekProc\fR above, except that the type of offsets and the return
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
.PP
The \fIsetOptionProc\fR field contains the address of a function called by
the generic layer to set a channel type specific option on a channel.
\fIsetOptionProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverSetOptionProc\fR(
        ClientData \fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR,
        const char *\fIoptionName\fR,
        const char *\fInewValue\fR);
.CE
.PP
\fIoptionName\fR is the name of an option to set, and \fInewValue\fR is
the new value for that option, as a string. The \fIinstanceData\fR is the







|







618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
.PP
The \fIsetOptionProc\fR field contains the address of a function called by
the generic layer to set a channel type specific option on a channel.
\fIsetOptionProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverSetOptionProc\fR(
        void *\fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR,
        const char *\fIoptionName\fR,
        const char *\fInewValue\fR);
.CE
.PP
\fIoptionName\fR is the name of an option to set, and \fInewValue\fR is
the new value for that option, as a string. The \fIinstanceData\fR is the
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
.PP
The \fIgetOptionProc\fR field contains the address of a function called by
the generic layer to get the value of a channel type specific option on a
channel. \fIgetOptionProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverGetOptionProc\fR(
        ClientData \fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR,
        const char *\fIoptionName\fR,
        Tcl_DString *\fIoptionValue\fR);
.CE
.PP
\fIOptionName\fR is the name of an option supported by this type of
channel. If the option name is not NULL, the function stores its current







|







659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
.PP
The \fIgetOptionProc\fR field contains the address of a function called by
the generic layer to get the value of a channel type specific option on a
channel. \fIgetOptionProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverGetOptionProc\fR(
        void *\fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR,
        const char *\fIoptionName\fR,
        Tcl_DString *\fIoptionValue\fR);
.CE
.PP
\fIOptionName\fR is the name of an option supported by this type of
channel. If the option name is not NULL, the function stores its current
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
The \fIwatchProc\fR field contains the address of a function called
by the generic layer to initialize the event notification mechanism to
notice events of interest on this channel.
\fIWatchProc\fR should match the following prototype:
.PP
.CS
typedef void \fBTcl_DriverWatchProc\fR(
        ClientData \fIinstanceData\fR,
        int \fImask\fR);
.CE
.PP
The \fIinstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created. The \fImask\fR
argument is an OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
and \fBTCL_EXCEPTION\fR; it indicates events the caller is interested in







|







697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
The \fIwatchProc\fR field contains the address of a function called
by the generic layer to initialize the event notification mechanism to
notice events of interest on this channel.
\fIWatchProc\fR should match the following prototype:
.PP
.CS
typedef void \fBTcl_DriverWatchProc\fR(
        void *\fIinstanceData\fR,
        int \fImask\fR);
.CE
.PP
The \fIinstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created. The \fImask\fR
argument is an OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
and \fBTCL_EXCEPTION\fR; it indicates events the caller is interested in
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
.PP
The \fIgetHandleProc\fR field contains the address of a function called by
the generic layer to retrieve a device-specific handle from the channel.
\fIGetHandleProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverGetHandleProc\fR(
        ClientData \fIinstanceData\fR,
        int \fIdirection\fR,
        ClientData *\fIhandlePtr\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created. The \fIdirection\fR
argument is either \fBTCL_READABLE\fR to retrieve the handle used
for input, or \fBTCL_WRITABLE\fR to retrieve the handle used for
output.







|

|







728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
.PP
The \fIgetHandleProc\fR field contains the address of a function called by
the generic layer to retrieve a device-specific handle from the channel.
\fIGetHandleProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverGetHandleProc\fR(
        void *\fIinstanceData\fR,
        int \fIdirection\fR,
        void **\fIhandlePtr\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created. The \fIdirection\fR
argument is either \fBTCL_READABLE\fR to retrieve the handle used
for input, or \fBTCL_WRITABLE\fR to retrieve the handle used for
output.
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
.PP
The \fIflushProc\fR field is currently reserved for future use.
It should be set to NULL.
\fIFlushProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverFlushProc\fR(
        ClientData \fIinstanceData\fR);
.CE
.PP
This value can be retrieved with \fBTcl_ChannelFlushProc\fR, which returns
a pointer to the function.
.SS HANDLERPROC
.PP
The \fIhandlerProc\fR field contains the address of a function called by
the generic layer to notify the channel that an event occurred.  It should
be defined for stacked channel drivers that wish to be notified of events
that occur on the underlying (stacked) channel.
\fIHandlerProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverHandlerProc\fR(
        ClientData \fIinstanceData\fR,
        int \fIinterestMask\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR
when this channel was created.  The \fIinterestMask\fR is an OR-ed
combination of \fBTCL_READABLE\fR or \fBTCL_WRITABLE\fR; it indicates what
type of event occurred on this channel.







|














|







757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
.PP
The \fIflushProc\fR field is currently reserved for future use.
It should be set to NULL.
\fIFlushProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverFlushProc\fR(
        void *\fIinstanceData\fR);
.CE
.PP
This value can be retrieved with \fBTcl_ChannelFlushProc\fR, which returns
a pointer to the function.
.SS HANDLERPROC
.PP
The \fIhandlerProc\fR field contains the address of a function called by
the generic layer to notify the channel that an event occurred.  It should
be defined for stacked channel drivers that wish to be notified of events
that occur on the underlying (stacked) channel.
\fIHandlerProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverHandlerProc\fR(
        void *\fIinstanceData\fR,
        int \fIinterestMask\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR
when this channel was created.  The \fIinterestMask\fR is an OR-ed
combination of \fBTCL_READABLE\fR or \fBTCL_WRITABLE\fR; it indicates what
type of event occurred on this channel.
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
The action \fITCL_CHANNEL_THREAD_INSERT\fR is used to notify the
driver that it should update or initialize any thread-specific data it
might be maintaining using the calling thread as the associate. See
\fBTcl_CutChannel\fR and \fBTcl_SpliceChannel\fR for more detail.
.PP
.CS
typedef void \fBTcl_DriverThreadActionProc\fR(
        ClientData \fIinstanceData\fR,
        int \fIaction\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created.
.PP
These values can be retrieved with \fBTcl_ChannelThreadActionProc\fR,
which returns a pointer to the function.
.SS "TRUNCATEPROC"
.PP
The \fItruncateProc\fR field contains the address of the function
called by the generic layer when a channel is truncated to some
length. It can be NULL.
.PP
.CS
typedef int \fBTcl_DriverTruncateProc\fR(
        ClientData \fIinstanceData\fR,
        Tcl_WideInt \fIlength\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created, and
\fIlength\fR is the new length of the underlying file, which should
not be negative. The result should be 0 on success or an errno code







|
















|







801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
The action \fITCL_CHANNEL_THREAD_INSERT\fR is used to notify the
driver that it should update or initialize any thread-specific data it
might be maintaining using the calling thread as the associate. See
\fBTcl_CutChannel\fR and \fBTcl_SpliceChannel\fR for more detail.
.PP
.CS
typedef void \fBTcl_DriverThreadActionProc\fR(
        void *\fIinstanceData\fR,
        int \fIaction\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created.
.PP
These values can be retrieved with \fBTcl_ChannelThreadActionProc\fR,
which returns a pointer to the function.
.SS "TRUNCATEPROC"
.PP
The \fItruncateProc\fR field contains the address of the function
called by the generic layer when a channel is truncated to some
length. It can be NULL.
.PP
.CS
typedef int \fBTcl_DriverTruncateProc\fR(
        void *\fIinstanceData\fR,
        Tcl_WideInt \fIlength\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created, and
\fIlength\fR is the new length of the underlying file, which should
not be negative. The result should be 0 on success or an errno code
Changes to doc/CrtChnlHdlr.3.
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
.AP int mask in
Conditions under which \fIproc\fR should be called: OR-ed combination of
\fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR. Specify
a zero value to temporarily disable an existing handler.
.AP Tcl_FileProc *proc in
Procedure to invoke whenever the channel indicated by \fIchannel\fR meets
the conditions specified by \fImask\fR.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CreateChannelHandler\fR arranges for \fIproc\fR to be called in the
future whenever input or output becomes possible on the channel identified
by \fIchannel\fR, or whenever an exceptional condition exists for
\fIchannel\fR. The conditions of interest under which \fIproc\fR will be
invoked are specified by the \fImask\fR argument.
See the manual entry for \fBfileevent\fR for a precise description of
what it means for a channel to be readable or writable.
\fIProc\fR must conform to the following prototype:
.PP
.CS
typedef void \fBTcl_ChannelProc\fR(
        ClientData \fIclientData\fR,
        int \fImask\fR);
.CE
.PP
The \fIclientData\fR argument is the same as the value passed to
\fBTcl_CreateChannelHandler\fR when the handler was created. Typically,
\fIclientData\fR points to a data structure containing application-specific
information about the channel. \fIMask\fR is an integer mask indicating







|















|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
.AP int mask in
Conditions under which \fIproc\fR should be called: OR-ed combination of
\fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR. Specify
a zero value to temporarily disable an existing handler.
.AP Tcl_FileProc *proc in
Procedure to invoke whenever the channel indicated by \fIchannel\fR meets
the conditions specified by \fImask\fR.
.AP void *clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CreateChannelHandler\fR arranges for \fIproc\fR to be called in the
future whenever input or output becomes possible on the channel identified
by \fIchannel\fR, or whenever an exceptional condition exists for
\fIchannel\fR. The conditions of interest under which \fIproc\fR will be
invoked are specified by the \fImask\fR argument.
See the manual entry for \fBfileevent\fR for a precise description of
what it means for a channel to be readable or writable.
\fIProc\fR must conform to the following prototype:
.PP
.CS
typedef void \fBTcl_ChannelProc\fR(
        void *\fIclientData\fR,
        int \fImask\fR);
.CE
.PP
The \fIclientData\fR argument is the same as the value passed to
\fBTcl_CreateChannelHandler\fR when the handler was created. Typically,
\fIclientData\fR points to a data structure containing application-specific
information about the channel. \fIMask\fR is an integer mask indicating
Changes to doc/CrtCloseHdlr.3.
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
.sp
.SH ARGUMENTS
.AS Tcl_CloseProc clientData
.AP Tcl_Channel channel in
The channel for which to create or delete a close callback.
.AP Tcl_CloseProc *proc in
The procedure to call as the callback.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CreateCloseHandler\fR arranges for \fIproc\fR to be called when
\fIchannel\fR is closed with \fBTcl_Close\fR or
\fBTcl_UnregisterChannel\fR, or using the Tcl \fBclose\fR command.
\fIProc\fR should match the following prototype:
.PP
.CS
typedef void \fBTcl_CloseProc\fR(
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR is the same as the value provided in the call to
\fBTcl_CreateCloseHandler\fR.
.PP
\fBTcl_DeleteCloseHandler\fR removes a close callback for \fIchannel\fR.
The \fIproc\fR and \fIclientData\fR identify which close callback to







|











|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
.sp
.SH ARGUMENTS
.AS Tcl_CloseProc clientData
.AP Tcl_Channel channel in
The channel for which to create or delete a close callback.
.AP Tcl_CloseProc *proc in
The procedure to call as the callback.
.AP void *clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CreateCloseHandler\fR arranges for \fIproc\fR to be called when
\fIchannel\fR is closed with \fBTcl_Close\fR or
\fBTcl_UnregisterChannel\fR, or using the Tcl \fBclose\fR command.
\fIProc\fR should match the following prototype:
.PP
.CS
typedef void \fBTcl_CloseProc\fR(
        void *\fIclientData\fR);
.CE
.PP
The \fIclientData\fR is the same as the value provided in the call to
\fBTcl_CreateCloseHandler\fR.
.PP
\fBTcl_DeleteCloseHandler\fR removes a close callback for \fIchannel\fR.
The \fIproc\fR and \fIclientData\fR identify which close callback to
Changes to doc/CrtCommand.3.
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
.AP Tcl_Interp *interp in
Interpreter in which to create new command.
.AP "const char" *cmdName in
Name of command.
.AP Tcl_CmdProc *proc in
Implementation of new command:  \fIproc\fR will be called whenever
\fIcmdName\fR is invoked as a command.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in
Procedure to call before \fIcmdName\fR is deleted from the interpreter;
allows for command-specific cleanup.  If NULL, then no procedure is
called before the command is deleted.
.BE
.SH DESCRIPTION







|







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
.AP Tcl_Interp *interp in
Interpreter in which to create new command.
.AP "const char" *cmdName in
Name of command.
.AP Tcl_CmdProc *proc in
Implementation of new command:  \fIproc\fR will be called whenever
\fIcmdName\fR is invoked as a command.
.AP voie *clientData in
Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in
Procedure to call before \fIcmdName\fR is deleted from the interpreter;
allows for command-specific cleanup.  If NULL, then no procedure is
called before the command is deleted.
.BE
.SH DESCRIPTION
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
the process of being deleted, then it does not create a new command
and it returns NULL.
\fIProc\fR should have arguments and result that match the type
\fBTcl_CmdProc\fR:
.PP
.CS
typedef int \fBTcl_CmdProc\fR(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIargc\fR,
        const char *\fIargv\fR[]);
.CE
.PP
When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
parameters will be copies of the \fIclientData\fR and \fIinterp\fR







|







71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
the process of being deleted, then it does not create a new command
and it returns NULL.
\fIProc\fR should have arguments and result that match the type
\fBTcl_CmdProc\fR:
.PP
.CS
typedef int \fBTcl_CmdProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIargc\fR,
        const char *\fIargv\fR[]);
.CE
.PP
When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
parameters will be copies of the \fIclientData\fR and \fIinterp\fR
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
\fIDeleteProc\fR is invoked before the command is deleted, and gives the
application an opportunity to release any structures associated
with the command.  \fIDeleteProc\fR should have arguments and
result that match the type \fBTcl_CmdDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_CmdDeleteProc\fR(
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument passed to \fBTcl_CreateCommand\fR.
.SH "SEE ALSO"
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_GetCommandInfo,
Tcl_SetCommandInfo, Tcl_GetCommandName, Tcl_SetObjResult
.SH KEYWORDS
bind, command, create, delete, interpreter, namespace







|









127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
\fIDeleteProc\fR is invoked before the command is deleted, and gives the
application an opportunity to release any structures associated
with the command.  \fIDeleteProc\fR should have arguments and
result that match the type \fBTcl_CmdDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_CmdDeleteProc\fR(
        void *\fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument passed to \fBTcl_CreateCommand\fR.
.SH "SEE ALSO"
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_GetCommandInfo,
Tcl_SetCommandInfo, Tcl_GetCommandName, Tcl_SetObjResult
.SH KEYWORDS
bind, command, create, delete, interpreter, namespace
Changes to doc/CrtFileHdlr.3.
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Conditions under which \fIproc\fR should be called:
OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR,
and \fBTCL_EXCEPTION\fR.  May be set to 0 to temporarily disable
a handler.
.AP Tcl_FileProc *proc in
Procedure to invoke whenever the file or device indicated
by \fIfile\fR meets the conditions specified by \fImask\fR.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CreateFileHandler\fR arranges for \fIproc\fR to be
invoked in the future whenever I/O becomes possible on a file
or an exceptional condition exists for the file.  The file







|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Conditions under which \fIproc\fR should be called:
OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR,
and \fBTCL_EXCEPTION\fR.  May be set to 0 to temporarily disable
a handler.
.AP Tcl_FileProc *proc in
Procedure to invoke whenever the file or device indicated
by \fIfile\fR meets the conditions specified by \fImask\fR.
.AP void *clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CreateFileHandler\fR arranges for \fIproc\fR to be
invoked in the future whenever I/O becomes possible on a file
or an exceptional condition exists for the file.  The file
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
as \fBvwait\fR.
.PP
\fIProc\fR should have arguments and result that match the
type \fBTcl_FileProc\fR:
.PP
.CS
typedef void \fBTcl_FileProc\fR(
        ClientData \fIclientData\fR,
        int \fImask\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a copy
of the \fIclientData\fR
argument given to \fBTcl_CreateFileHandler\fR when the callback
was created.  Typically, \fIclientData\fR points to a data







|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
as \fBvwait\fR.
.PP
\fIProc\fR should have arguments and result that match the
type \fBTcl_FileProc\fR:
.PP
.CS
typedef void \fBTcl_FileProc\fR(
        void *\fIclientData\fR,
        int \fImask\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a copy
of the \fIclientData\fR
argument given to \fBTcl_CreateFileHandler\fR when the callback
was created.  Typically, \fIclientData\fR points to a data
Changes to doc/CrtObjCmd.3.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Command
\fBTcl_CreateObjCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
.sp










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj Tcl_RegisterCommandTypeName, Tcl_GetCommandTypeName \- implement new commands in C
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Command
\fBTcl_CreateObjCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
.sp
38
39
40
41
42
43
44








45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67



68
69
70
71
72
73
74
\fBTcl_GetCommandName\fR(\fIinterp, token\fR)
.sp
void
\fBTcl_GetCommandFullName\fR(\fIinterp, token, objPtr\fR)
.sp
Tcl_Command
\fBTcl_GetCommandFromObj\fR(\fIinterp, objPtr\fR)








.SH ARGUMENTS
.AS Tcl_CmdDeleteProc *deleteProc in/out
.AP Tcl_Interp *interp in
Interpreter in which to create a new command or that contains a command.
.AP char *cmdName in
Name of command.
.AP Tcl_ObjCmdProc *proc in
Implementation of the new command: \fIproc\fR will be called whenever
\fIcmdName\fR is invoked as a command.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in
Procedure to call before \fIcmdName\fR is deleted from the interpreter;
allows for command-specific cleanup. If NULL, then no procedure is
called before the command is deleted.
.AP Tcl_Command token in
Token for command, returned by previous call to \fBTcl_CreateObjCommand\fR.
The command must not have been deleted.
.AP Tcl_CmdInfo *infoPtr in/out
Pointer to structure containing various information about a
Tcl command.
.AP Tcl_Obj *objPtr in
Value containing the name of a Tcl command.



.BE
.SH DESCRIPTION
.PP
\fBTcl_CreateObjCommand\fR defines a new command in \fIinterp\fR
and associates it with procedure \fIproc\fR
such that whenever \fIname\fR is
invoked as a Tcl command (e.g., via a call to \fBTcl_EvalObjEx\fR)







>
>
>
>
>
>
>
>









|













>
>
>







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
\fBTcl_GetCommandName\fR(\fIinterp, token\fR)
.sp
void
\fBTcl_GetCommandFullName\fR(\fIinterp, token, objPtr\fR)
.sp
Tcl_Command
\fBTcl_GetCommandFromObj\fR(\fIinterp, objPtr\fR)
.sp
.VS "info cmdtype feature"
void
\fBTcl_RegisterCommandTypeName\fR(\fIproc, typeName\fR)
.sp
const char *
\fBTcl_GetCommandTypeName\fR(\fItoken\fR)
.VE "info cmdtype feature"
.SH ARGUMENTS
.AS Tcl_CmdDeleteProc *deleteProc in/out
.AP Tcl_Interp *interp in
Interpreter in which to create a new command or that contains a command.
.AP char *cmdName in
Name of command.
.AP Tcl_ObjCmdProc *proc in
Implementation of the new command: \fIproc\fR will be called whenever
\fIcmdName\fR is invoked as a command.
.AP void *clientData in
Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in
Procedure to call before \fIcmdName\fR is deleted from the interpreter;
allows for command-specific cleanup. If NULL, then no procedure is
called before the command is deleted.
.AP Tcl_Command token in
Token for command, returned by previous call to \fBTcl_CreateObjCommand\fR.
The command must not have been deleted.
.AP Tcl_CmdInfo *infoPtr in/out
Pointer to structure containing various information about a
Tcl command.
.AP Tcl_Obj *objPtr in
Value containing the name of a Tcl command.
.AP "const char" *typeName in
Indicates the name of the type of command implementation associated
with a particular \fIproc\fR, or NULL to break the association.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CreateObjCommand\fR defines a new command in \fIinterp\fR
and associates it with procedure \fIproc\fR
such that whenever \fIname\fR is
invoked as a Tcl command (e.g., via a call to \fBTcl_EvalObjEx\fR)
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
the process of being deleted, then it does not create a new command
and it returns NULL.
\fIproc\fR should have arguments and result that match the type
\fBTcl_ObjCmdProc\fR:
.PP
.CS
typedef int \fBTcl_ObjCmdProc\fR(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIobjc\fR,
        Tcl_Obj *const \fIobjv\fR[]);
.CE
.PP
When \fIproc\fR is invoked, the \fIclientData\fR and \fIinterp\fR parameters
will be copies of the \fIclientData\fR and \fIinterp\fR arguments given to







|







98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
the process of being deleted, then it does not create a new command
and it returns NULL.
\fIproc\fR should have arguments and result that match the type
\fBTcl_ObjCmdProc\fR:
.PP
.CS
typedef int \fBTcl_ObjCmdProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIobjc\fR,
        Tcl_Obj *const \fIobjv\fR[]);
.CE
.PP
When \fIproc\fR is invoked, the \fIclientData\fR and \fIinterp\fR parameters
will be copies of the \fIclientData\fR and \fIinterp\fR arguments given to
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
\fIDeleteProc\fR is invoked before the command is deleted, and gives the
application an opportunity to release any structures associated
with the command.  \fIDeleteProc\fR should have arguments and
result that match the type \fBTcl_CmdDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_CmdDeleteProc\fR(
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument passed to \fBTcl_CreateObjCommand\fR.
.PP
\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
Once the call completes, attempts to invoke \fIcmdName\fR in







|







171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
\fIDeleteProc\fR is invoked before the command is deleted, and gives the
application an opportunity to release any structures associated
with the command.  \fIDeleteProc\fR should have arguments and
result that match the type \fBTcl_CmdDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_CmdDeleteProc\fR(
        void *\fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument passed to \fBTcl_CreateObjCommand\fR.
.PP
\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
Once the call completes, attempts to invoke \fIcmdName\fR in
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
pointed to by \fIinfoPtr\fR and returns 1.
A \fBTcl_CmdInfo\fR structure has the following fields:
.PP
.CS
typedef struct Tcl_CmdInfo {
    int \fIisNativeObjectProc\fR;
    Tcl_ObjCmdProc *\fIobjProc\fR;
    ClientData \fIobjClientData\fR;
    Tcl_CmdProc *\fIproc\fR;
    ClientData \fIclientData\fR;
    Tcl_CmdDeleteProc *\fIdeleteProc\fR;
    ClientData \fIdeleteData\fR;
    Tcl_Namespace *\fInamespacePtr\fR;
} \fBTcl_CmdInfo\fR;
.CE
.PP
The \fIisNativeObjectProc\fR field has the value 1
if \fBTcl_CreateObjCommand\fR was called to register the command;
it is 0 if only \fBTcl_CreateCommand\fR was called.







|

|

|







213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
pointed to by \fIinfoPtr\fR and returns 1.
A \fBTcl_CmdInfo\fR structure has the following fields:
.PP
.CS
typedef struct Tcl_CmdInfo {
    int \fIisNativeObjectProc\fR;
    Tcl_ObjCmdProc *\fIobjProc\fR;
    void *\fIobjClientData\fR;
    Tcl_CmdProc *\fIproc\fR;
    void *\fIclientData\fR;
    Tcl_CmdDeleteProc *\fIdeleteProc\fR;
    void *\fIdeleteData\fR;
    Tcl_Namespace *\fInamespacePtr\fR;
} \fBTcl_CmdInfo\fR;
.CE
.PP
The \fIisNativeObjectProc\fR field has the value 1
if \fBTcl_CreateObjCommand\fR was called to register the command;
it is 0 if only \fBTcl_CreateCommand\fR was called.
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
that implements the command.
If \fBTcl_CreateCommand\fR was called for this command,
this is the procedure passed to it;
otherwise, this is a compatibility procedure
registered by \fBTcl_CreateObjCommand\fR
that simply calls the command's
value-based procedure after converting its string arguments to Tcl values.
The field \fIdeleteData\fR is the ClientData value
to pass to \fIdeleteProc\fR;  it is normally the same as
\fIclientData\fR but may be set independently using the
\fBTcl_SetCommandInfo\fR procedure.
The field \fInamespacePtr\fR holds a pointer to the
Tcl_Namespace that contains the command.
.PP
\fBTcl_GetCommandInfoFromToken\fR is identical to
\fBTcl_GetCommandInfo\fR except that it uses a command token returned
from \fBTcl_CreateObjCommand\fR in place of the command name.  If the
\fItoken\fR parameter is NULL, it returns 0; otherwise, it returns 1
and fills in the structure designated by \fIinfoPtr\fR.
.PP
\fBTcl_SetCommandInfo\fR is used to modify the procedures and
ClientData values associated with a command.
Its \fIcmdName\fR argument is the name of a command in \fIinterp\fR.
\fIcmdName\fR may include \fB::\fR namespace qualifiers
to identify a command in a particular namespace.
If this command does not exist then \fBTcl_SetCommandInfo\fR returns 0.
Otherwise, it copies the information from \fI*infoPtr\fR to
Tcl's internal structure for the command and returns 1.
.PP
\fBTcl_SetCommandInfoFromToken\fR is identical to
\fBTcl_SetCommandInfo\fR except that it takes a command token as
returned by \fBTcl_CreateObjCommand\fR instead of the command name.
If the \fItoken\fR parameter is NULL, it returns 0.  Otherwise, it
copies the information from \fI*infoPtr\fR to Tcl's internal structure
for the command and returns 1.
.PP
Note that \fBTcl_SetCommandInfo\fR and
\fBTcl_SetCommandInfoFromToken\fR both allow the ClientData for a
command's deletion procedure to be given a different value than the
ClientData for its command procedure.
.PP
Note that neither \fBTcl_SetCommandInfo\fR nor
\fBTcl_SetCommandInfoFromToken\fR will change a command's namespace.
Use \fBTcl_Eval\fR to call the \fBrename\fR command to do that.
.PP
\fBTcl_GetCommandName\fR provides a mechanism for tracking commands
that have been renamed.







|













|















|

|







243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
that implements the command.
If \fBTcl_CreateCommand\fR was called for this command,
this is the procedure passed to it;
otherwise, this is a compatibility procedure
registered by \fBTcl_CreateObjCommand\fR
that simply calls the command's
value-based procedure after converting its string arguments to Tcl values.
The field \fIdeleteData\fR is the clientData value
to pass to \fIdeleteProc\fR;  it is normally the same as
\fIclientData\fR but may be set independently using the
\fBTcl_SetCommandInfo\fR procedure.
The field \fInamespacePtr\fR holds a pointer to the
Tcl_Namespace that contains the command.
.PP
\fBTcl_GetCommandInfoFromToken\fR is identical to
\fBTcl_GetCommandInfo\fR except that it uses a command token returned
from \fBTcl_CreateObjCommand\fR in place of the command name.  If the
\fItoken\fR parameter is NULL, it returns 0; otherwise, it returns 1
and fills in the structure designated by \fIinfoPtr\fR.
.PP
\fBTcl_SetCommandInfo\fR is used to modify the procedures and
clientData values associated with a command.
Its \fIcmdName\fR argument is the name of a command in \fIinterp\fR.
\fIcmdName\fR may include \fB::\fR namespace qualifiers
to identify a command in a particular namespace.
If this command does not exist then \fBTcl_SetCommandInfo\fR returns 0.
Otherwise, it copies the information from \fI*infoPtr\fR to
Tcl's internal structure for the command and returns 1.
.PP
\fBTcl_SetCommandInfoFromToken\fR is identical to
\fBTcl_SetCommandInfo\fR except that it takes a command token as
returned by \fBTcl_CreateObjCommand\fR instead of the command name.
If the \fItoken\fR parameter is NULL, it returns 0.  Otherwise, it
copies the information from \fI*infoPtr\fR to Tcl's internal structure
for the command and returns 1.
.PP
Note that \fBTcl_SetCommandInfo\fR and
\fBTcl_SetCommandInfoFromToken\fR both allow the clientData for a
command's deletion procedure to be given a different value than the
clientData for its command procedure.
.PP
Note that neither \fBTcl_SetCommandInfo\fR nor
\fBTcl_SetCommandInfoFromToken\fR will change a command's namespace.
Use \fBTcl_Eval\fR to call the \fBrename\fR command to do that.
.PP
\fBTcl_GetCommandName\fR provides a mechanism for tracking commands
that have been renamed.
292
293
294
295
296
297
298
















299
300
301
302
The name, including all namespace prefixes,
is appended to the value specified by \fIobjPtr\fR.
.PP
\fBTcl_GetCommandFromObj\fR returns a token for the command
specified by the name in a \fBTcl_Obj\fR.
The command name is resolved relative to the current namespace.
Returns NULL if the command is not found.
















.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3)
.SH KEYWORDS
bind, command, create, delete, namespace, value







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
The name, including all namespace prefixes,
is appended to the value specified by \fIobjPtr\fR.
.PP
\fBTcl_GetCommandFromObj\fR returns a token for the command
specified by the name in a \fBTcl_Obj\fR.
The command name is resolved relative to the current namespace.
Returns NULL if the command is not found.
.PP
.VS "info cmdtype feature"
\fBTcl_RegisterCommandTypeName\fR is used to associate a name (the
\fItypeName\fR argument) with a particular implementation function so that it
can then be looked up with \fBTcl_GetCommandTypeName\fR, which in turn is
called with a command token that information is wanted for and which returns
the name of the type that was registered for the implementation function used
for that command. (The lookup functionality is surfaced virtually directly in Tcl via
\fBinfo cmdtype\fR.) If there is no function registered for a particular
function, the result will be the string literal
.QW \fBnative\fR .
The registration of a name can be undone by registering a mapping to NULL
instead. The result from \fBTcl_GetCommandTypeName\fR will be exactly that
string which was registered, and not a copy; use of a compile-time constant
string is \fIstrongly recommended\fR.
.VE "info cmdtype feature"
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3)
.SH KEYWORDS
bind, command, create, delete, namespace, value
Changes to doc/CrtTimerHdlr.3.
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
\fBTcl_DeleteTimerHandler\fR(\fItoken\fR)
.SH ARGUMENTS
.AS Tcl_TimerToken milliseconds
.AP int milliseconds  in
How many milliseconds to wait before invoking \fIproc\fR.
.AP Tcl_TimerProc *proc in
Procedure to invoke after \fImilliseconds\fR have elapsed.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.AP Tcl_TimerToken token in
Token for previously created timer handler (the return value
from some previous call to \fBTcl_CreateTimerHandler\fR).
.BE
.SH DESCRIPTION
.PP







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
\fBTcl_DeleteTimerHandler\fR(\fItoken\fR)
.SH ARGUMENTS
.AS Tcl_TimerToken milliseconds
.AP int milliseconds  in
How many milliseconds to wait before invoking \fIproc\fR.
.AP Tcl_TimerProc *proc in
Procedure to invoke after \fImilliseconds\fR have elapsed.
.AP void *clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.AP Tcl_TimerToken token in
Token for previously created timer handler (the return value
from some previous call to \fBTcl_CreateTimerHandler\fR).
.BE
.SH DESCRIPTION
.PP
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
\fIproc\fR, then the call to \fIproc\fR will be delayed.
.PP
\fIProc\fR should have arguments and return value that match
the type \fBTcl_TimerProc\fR:
.PP
.CS
typedef void \fBTcl_TimerProc\fR(
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a
copy of the \fIclientData\fR argument given to
\fBTcl_CreateTimerHandler\fR when the callback
was created.  Typically, \fIclientData\fR points to a data
structure containing application-specific information about







|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
\fIproc\fR, then the call to \fIproc\fR will be delayed.
.PP
\fIProc\fR should have arguments and return value that match
the type \fBTcl_TimerProc\fR:
.PP
.CS
typedef void \fBTcl_TimerProc\fR(
        void *\fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a
copy of the \fIclientData\fR argument given to
\fBTcl_CreateTimerHandler\fR when the callback
was created.  Typically, \fIclientData\fR points to a data
structure containing application-specific information about
Changes to doc/CrtTrace.3.
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Flags governing the trace execution.  See below for details.
.AP Tcl_CmdObjTraceProc *objProc in
Procedure to call for each command that is executed.  See below for
details of the calling sequence.
.AP Tcl_CmdTraceProc *proc in
Procedure to call for each command that is executed.  See below for
details on the calling sequence.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR.
.AP Tcl_CmdObjTraceDeleteProc *deleteProc in
Procedure to call when the trace is deleted.  See below for details of
the calling sequence.  A NULL pointer is permissible and results in no
callback when the trace is deleted.
.AP Tcl_Trace trace in
Token for trace to be removed (return value from previous call







|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Flags governing the trace execution.  See below for details.
.AP Tcl_CmdObjTraceProc *objProc in
Procedure to call for each command that is executed.  See below for
details of the calling sequence.
.AP Tcl_CmdTraceProc *proc in
Procedure to call for each command that is executed.  See below for
details on the calling sequence.
.AP void *clientData in
Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR.
.AP Tcl_CmdObjTraceDeleteProc *deleteProc in
Procedure to call when the trace is deleted.  See below for details of
the calling sequence.  A NULL pointer is permissible and results in no
callback when the trace is deleted.
.AP Tcl_Trace trace in
Token for trace to be removed (return value from previous call
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
interpreter.
.PP
\fIobjProc\fR should have arguments and result that match the type,
\fBTcl_CmdObjTraceProc\fR:
.PP
.CS
typedef int \fBTcl_CmdObjTraceProc\fR(
        \fBClientData\fR \fIclientData\fR,
        \fBTcl_Interp\fR* \fIinterp\fR,
        int \fIlevel\fR,
        const char *\fIcommand\fR,
        \fBTcl_Command\fR \fIcommandToken\fR,
        int \fIobjc\fR,
        \fBTcl_Obj\fR *const \fIobjv\fR[]);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters are copies of the
corresponding arguments given to \fBTcl_CreateTrace\fR.
\fIClientData\fR typically points to an application-specific data
structure that describes what to do when \fIobjProc\fR is invoked.  The
\fIlevel\fR parameter gives the nesting level of the command (1 for
top-level commands passed to \fBTcl_Eval\fR by the application, 2 for
the next-level commands passed to \fBTcl_Eval\fR as part of parsing or
interpreting level-1 commands, and so on). The \fIcommand\fR parameter
points to a string containing the text of the command, before any
argument substitution.  The \fIcommandToken\fR parameter is a Tcl







|










|







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
interpreter.
.PP
\fIobjProc\fR should have arguments and result that match the type,
\fBTcl_CmdObjTraceProc\fR:
.PP
.CS
typedef int \fBTcl_CmdObjTraceProc\fR(
        \fBvoid *\fR \fIclientData\fR,
        \fBTcl_Interp\fR* \fIinterp\fR,
        int \fIlevel\fR,
        const char *\fIcommand\fR,
        \fBTcl_Command\fR \fIcommandToken\fR,
        int \fIobjc\fR,
        \fBTcl_Obj\fR *const \fIobjv\fR[]);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters are copies of the
corresponding arguments given to \fBTcl_CreateTrace\fR.
\fIclientData\fR typically points to an application-specific data
structure that describes what to do when \fIobjProc\fR is invoked.  The
\fIlevel\fR parameter gives the nesting level of the command (1 for
top-level commands passed to \fBTcl_Eval\fR by the application, 2 for
the next-level commands passed to \fBTcl_Eval\fR as part of parsing or
interpreting level-1 commands, and so on). The \fIcommand\fR parameter
points to a string containing the text of the command, before any
argument substitution.  The \fIcommandToken\fR parameter is a Tcl
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
When \fBTcl_DeleteTrace\fR is called, the interpreter invokes the
\fIdeleteProc\fR that was passed as a parameter to
\fBTcl_CreateObjTrace\fR.  The \fIdeleteProc\fR must match the type,
\fBTcl_CmdObjTraceDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_CmdObjTraceDeleteProc\fR(
        \fBClientData\fR \fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter will be the same as the
\fIclientData\fR parameter that was originally passed to
\fBTcl_CreateObjTrace\fR.
.PP
\fBTcl_CreateTrace\fR is an alternative interface for command tracing,
\fInot recommended for new applications\fR.  It is provided for backward
compatibility with code that was developed for older versions of the
Tcl interpreter.  It is similar to \fBTcl_CreateObjTrace\fR, except
that its \fIproc\fR parameter should have arguments and result that
match the type \fBTcl_CmdTraceProc\fR:
.PP
.CS
typedef void \fBTcl_CmdTraceProc\fR(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIlevel\fR,
        char *\fIcommand\fR,
        Tcl_CmdProc *\fIcmdProc\fR,
        ClientData \fIcmdClientData\fR,
        int \fIargc\fR,
        const char *\fIargv\fR[]);
.CE
.PP
The parameters to the \fIproc\fR callback are similar to those of the
\fIobjProc\fR callback above. The \fIcommandToken\fR is
replaced with \fIcmdProc\fR, a pointer to the (string-based) command







|















|




|







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
When \fBTcl_DeleteTrace\fR is called, the interpreter invokes the
\fIdeleteProc\fR that was passed as a parameter to
\fBTcl_CreateObjTrace\fR.  The \fIdeleteProc\fR must match the type,
\fBTcl_CmdObjTraceDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_CmdObjTraceDeleteProc\fR(
        \fBvoid *\fR \fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter will be the same as the
\fIclientData\fR parameter that was originally passed to
\fBTcl_CreateObjTrace\fR.
.PP
\fBTcl_CreateTrace\fR is an alternative interface for command tracing,
\fInot recommended for new applications\fR.  It is provided for backward
compatibility with code that was developed for older versions of the
Tcl interpreter.  It is similar to \fBTcl_CreateObjTrace\fR, except
that its \fIproc\fR parameter should have arguments and result that
match the type \fBTcl_CmdTraceProc\fR:
.PP
.CS
typedef void \fBTcl_CmdTraceProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIlevel\fR,
        char *\fIcommand\fR,
        Tcl_CmdProc *\fIcmdProc\fR,
        void *\fIcmdClientData\fR,
        int \fIargc\fR,
        const char *\fIargv\fR[]);
.CE
.PP
The parameters to the \fIproc\fR callback are similar to those of the
\fIobjProc\fR callback above. The \fIcommandToken\fR is
replaced with \fIcmdProc\fR, a pointer to the (string-based) command
Changes to doc/DString.3.
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
char *
\fBTcl_DStringAppendElement\fR(\fIdsPtr, element\fR)
.sp
\fBTcl_DStringStartSublist\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringEndSublist\fR(\fIdsPtr\fR)
.sp
int
\fBTcl_DStringLength\fR(\fIdsPtr\fR)
.sp
char *
\fBTcl_DStringValue\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
.sp
\fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR)
.SH ARGUMENTS
.AS Tcl_DString newLength in/out
.AP Tcl_DString *dsPtr in/out
Pointer to structure that is used to manage a dynamic string.
.AP "const char" *bytes in
Pointer to characters to append to dynamic string.
.AP "const char" *element in
Pointer to characters to append as list element to dynamic string.
.AP int length in
Number of bytes from \fIbytes\fR to add to dynamic string.  If -1,
add all characters up to null terminating character.
.AP int newLength in
New length for dynamic string, not including null terminating
character.
.AP Tcl_Interp *interp in/out
Interpreter whose result is to be set from or moved to the
dynamic string.
.BE








|




















|
|

|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
char *
\fBTcl_DStringAppendElement\fR(\fIdsPtr, element\fR)
.sp
\fBTcl_DStringStartSublist\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringEndSublist\fR(\fIdsPtr\fR)
.sp
size_t
\fBTcl_DStringLength\fR(\fIdsPtr\fR)
.sp
char *
\fBTcl_DStringValue\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
.sp
\fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR)
.SH ARGUMENTS
.AS Tcl_DString newLength in/out
.AP Tcl_DString *dsPtr in/out
Pointer to structure that is used to manage a dynamic string.
.AP "const char" *bytes in
Pointer to characters to append to dynamic string.
.AP "const char" *element in
Pointer to characters to append as list element to dynamic string.
.AP size_t length in
Number of bytes from \fIbytes\fR to add to dynamic string.  If (size_t)-1,
add all characters up to null terminating character.
.AP size_t newLength in
New length for dynamic string, not including null terminating
character.
.AP Tcl_Interp *interp in/out
Interpreter whose result is to be set from or moved to the
dynamic string.
.BE

Changes to doc/DoWhenIdle.3.
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
\fBTcl_DoWhenIdle\fR(\fIproc, clientData\fR)
.sp
\fBTcl_CancelIdleCall\fR(\fIproc, clientData\fR)
.SH ARGUMENTS
.AS Tcl_IdleProc clientData
.AP Tcl_IdleProc *proc in
Procedure to invoke.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_DoWhenIdle\fR arranges for \fIproc\fR to be invoked
when the application becomes idle.  The application is
considered to be idle when \fBTcl_DoOneEvent\fR has been







|







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
\fBTcl_DoWhenIdle\fR(\fIproc, clientData\fR)
.sp
\fBTcl_CancelIdleCall\fR(\fIproc, clientData\fR)
.SH ARGUMENTS
.AS Tcl_IdleProc clientData
.AP Tcl_IdleProc *proc in
Procedure to invoke.
.AP coid *clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_DoWhenIdle\fR arranges for \fIproc\fR to be invoked
when the application becomes idle.  The application is
considered to be idle when \fBTcl_DoOneEvent\fR has been
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
use \fBTcl_DoOneEvent\fR to dispatch events.
.PP
\fIProc\fR should have arguments and result that match the
type \fBTcl_IdleProc\fR:
.PP
.CS
typedef void \fBTcl_IdleProc\fR(
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR
argument given to \fBTcl_DoWhenIdle\fR.  Typically, \fIclientData\fR
points to a data structure containing application-specific information about
what \fIproc\fR should do.
.PP







|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
use \fBTcl_DoOneEvent\fR to dispatch events.
.PP
\fIProc\fR should have arguments and result that match the
type \fBTcl_IdleProc\fR:
.PP
.CS
typedef void \fBTcl_IdleProc\fR(
        void *\fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR
argument given to \fBTcl_DoWhenIdle\fR.  Typically, \fIclientData\fR
points to a data structure containing application-specific information about
what \fIproc\fR should do.
.PP
Changes to doc/DumpActiveMemory.3.
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
They are only functional when Tcl has been compiled with
\fBTCL_MEM_DEBUG\fR defined at compile-time.  When \fBTCL_MEM_DEBUG\fR
is not defined, these functions are all no-ops.
.PP
\fBTcl_DumpActiveMemory\fR will output a list of all currently
allocated memory to the specified file.  The information output for
each allocated block of memory is:  starting and ending addresses
(excluding guard zone), size, source file where \fBckalloc\fR was
called to allocate the block and line number in that file.  It is
especially useful to call \fBTcl_DumpActiveMemory\fR after the Tcl
interpreter has been deleted.
.PP
\fBTcl_InitMemory\fR adds the Tcl \fBmemory\fR command to the
interpreter given by \fIinterp\fR.  \fBTcl_InitMemory\fR is called
by \fBTcl_Main\fR.
.PP
\fBTcl_ValidateAllMemory\fR forces a validation of the guard zones of
all currently allocated blocks of memory.  Normally validation of a
block occurs when its freed, unless full validation is enabled, in
which case validation of all blocks occurs when \fBckalloc\fR and
\fBckfree\fR are called.  This function forces the validation to occur
at any point.

.SH "SEE ALSO"
TCL_MEM_DEBUG, memory

.SH KEYWORDS
memory, debug







|











|
|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
They are only functional when Tcl has been compiled with
\fBTCL_MEM_DEBUG\fR defined at compile-time.  When \fBTCL_MEM_DEBUG\fR
is not defined, these functions are all no-ops.
.PP
\fBTcl_DumpActiveMemory\fR will output a list of all currently
allocated memory to the specified file.  The information output for
each allocated block of memory is:  starting and ending addresses
(excluding guard zone), size, source file where \fBTcl_Alloc\fR was
called to allocate the block and line number in that file.  It is
especially useful to call \fBTcl_DumpActiveMemory\fR after the Tcl
interpreter has been deleted.
.PP
\fBTcl_InitMemory\fR adds the Tcl \fBmemory\fR command to the
interpreter given by \fIinterp\fR.  \fBTcl_InitMemory\fR is called
by \fBTcl_Main\fR.
.PP
\fBTcl_ValidateAllMemory\fR forces a validation of the guard zones of
all currently allocated blocks of memory.  Normally validation of a
block occurs when its freed, unless full validation is enabled, in
which case validation of all blocks occurs when \fBTcl_Alloc\fR and
\fBTcl_Free\fR are called.  This function forces the validation to occur
at any point.

.SH "SEE ALSO"
TCL_MEM_DEBUG, memory

.SH KEYWORDS
memory, debug
Changes to doc/Encoding.3.
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
.AP "const char" *src in
For the \fBTcl_ExternalToUtf\fR functions, an array of bytes in the
specified encoding that are to be converted to UTF-8.  For the
\fBTcl_UtfToExternal\fR and \fBTcl_WinUtfToTChar\fR functions, an array of
UTF-8 characters to be converted to the specified encoding.
.AP "const TCHAR" *tsrc in
An array of Windows TCHAR characters to convert to UTF-8.
.AP int srcLen in
Length of \fIsrc\fR or \fItsrc\fR in bytes.  If the length is negative, the
encoding-specific length of the string is used.
.AP Tcl_DString *dstPtr out
Pointer to an uninitialized or free \fBTcl_DString\fR in which the converted
result will be stored.
.AP int flags in
Various flag bits OR-ed together.







|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
.AP "const char" *src in
For the \fBTcl_ExternalToUtf\fR functions, an array of bytes in the
specified encoding that are to be converted to UTF-8.  For the
\fBTcl_UtfToExternal\fR and \fBTcl_WinUtfToTChar\fR functions, an array of
UTF-8 characters to be converted to the specified encoding.
.AP "const TCHAR" *tsrc in
An array of Windows TCHAR characters to convert to UTF-8.
.AP size_t srcLen in
Length of \fIsrc\fR or \fItsrc\fR in bytes.  If the length is negative, the
encoding-specific length of the string is used.
.AP Tcl_DString *dstPtr out
Pointer to an uninitialized or free \fBTcl_DString\fR in which the converted
result will be stored.
.AP int flags in
Various flag bits OR-ed together.
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
.PP
.CS
typedef struct Tcl_EncodingType {
    const char *\fIencodingName\fR;
    Tcl_EncodingConvertProc *\fItoUtfProc\fR;
    Tcl_EncodingConvertProc *\fIfromUtfProc\fR;
    Tcl_EncodingFreeProc *\fIfreeProc\fR;
    ClientData \fIclientData\fR;
    int \fInullSize\fR;
} \fBTcl_EncodingType\fR;
.CE
.PP
The \fIencodingName\fR provides a string name for the encoding, by
which it can be referred in other procedures such as
\fBTcl_GetEncoding\fR.  The \fItoUtfProc\fR refers to a callback







|







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
.PP
.CS
typedef struct Tcl_EncodingType {
    const char *\fIencodingName\fR;
    Tcl_EncodingConvertProc *\fItoUtfProc\fR;
    Tcl_EncodingConvertProc *\fIfromUtfProc\fR;
    Tcl_EncodingFreeProc *\fIfreeProc\fR;
    void *\fIclientData\fR;
    int \fInullSize\fR;
} \fBTcl_EncodingType\fR;
.CE
.PP
The \fIencodingName\fR provides a string name for the encoding, by
which it can be referred in other procedures such as
\fBTcl_GetEncoding\fR.  The \fItoUtfProc\fR refers to a callback
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
CNS11643) are not accepted.
.PP
The callback procedures \fItoUtfProc\fR and \fIfromUtfProc\fR should match the
type \fBTcl_EncodingConvertProc\fR:
.PP
.CS
typedef int \fBTcl_EncodingConvertProc\fR(
        ClientData \fIclientData\fR,
        const char *\fIsrc\fR,
        int \fIsrcLen\fR,
        int \fIflags\fR,
        Tcl_EncodingState *\fIstatePtr\fR,
        char *\fIdst\fR,
        int \fIdstLen\fR,
        int *\fIsrcReadPtr\fR,







|







335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
CNS11643) are not accepted.
.PP
The callback procedures \fItoUtfProc\fR and \fIfromUtfProc\fR should match the
type \fBTcl_EncodingConvertProc\fR:
.PP
.CS
typedef int \fBTcl_EncodingConvertProc\fR(
        void *\fIclientData\fR,
        const char *\fIsrc\fR,
        int \fIsrcLen\fR,
        int \fIflags\fR,
        Tcl_EncodingState *\fIstatePtr\fR,
        char *\fIdst\fR,
        int \fIdstLen\fR,
        int *\fIsrcReadPtr\fR,
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
procedure will be a non-NULL location.
.PP
The callback procedure \fIfreeProc\fR, if non-NULL, should match the type
\fBTcl_EncodingFreeProc\fR:
.PP
.CS
typedef void \fBTcl_EncodingFreeProc\fR(
        ClientData \fIclientData\fR);
.CE
.PP
This \fIfreeProc\fR function is called when the encoding is deleted.  The
\fIclientData\fR parameter is the same as the \fIclientData\fR field
specified to \fBTcl_CreateEncoding\fR when the encoding was created.
.PP
\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR







|







367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
procedure will be a non-NULL location.
.PP
The callback procedure \fIfreeProc\fR, if non-NULL, should match the type
\fBTcl_EncodingFreeProc\fR:
.PP
.CS
typedef void \fBTcl_EncodingFreeProc\fR(
        void *\fIclientData\fR);
.CE
.PP
This \fIfreeProc\fR function is called when the encoding is deleted.  The
\fIclientData\fR parameter is the same as the \fIclientData\fR field
specified to \fBTcl_CreateEncoding\fR when the encoding was created.
.PP
\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR
Changes to doc/Exit.3.
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Exact meaning may
be platform-specific.  0 usually means a normal exit, any nonzero value
usually means that an error occurred.
.AP Tcl_ExitProc *proc in
Procedure to invoke before exiting application, or (for
\fBTcl_SetExitProc\fR) NULL to uninstall the current application exit
procedure.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE

.SH DESCRIPTION
.PP
The procedures described here provide a graceful mechanism to end the
execution of a \fBTcl\fR application. Exit handlers are invoked to cleanup the







|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Exact meaning may
be platform-specific.  0 usually means a normal exit, any nonzero value
usually means that an error occurred.
.AP Tcl_ExitProc *proc in
Procedure to invoke before exiting application, or (for
\fBTcl_SetExitProc\fR) NULL to uninstall the current application exit
procedure.
.AP void *clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE

.SH DESCRIPTION
.PP
The procedures described here provide a graceful mechanism to end the
execution of a \fBTcl\fR application. Exit handlers are invoked to cleanup the
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Note that if other code invokes \fBexit\fR system procedure directly, or
otherwise causes the application to terminate without calling
\fBTcl_Exit\fR, the exit handlers will not be run.
\fBTcl_Exit\fR internally invokes the \fBexit\fR system call, thus it never
returns control to its caller.
If an application exit handler has been installed (see
\fBTcl_SetExitProc\fR), that handler is invoked with an argument
consisting of the exit status (cast to ClientData); the application
exit handler should not return control to Tcl.
.PP
\fBTcl_Finalize\fR is similar to \fBTcl_Exit\fR except that it does not
exit from the current process.
It is useful for cleaning up when a process is finished using \fBTcl\fR but
wishes to continue executing, and when \fBTcl\fR is used in a dynamically
loaded extension that is about to be unloaded.







|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Note that if other code invokes \fBexit\fR system procedure directly, or
otherwise causes the application to terminate without calling
\fBTcl_Exit\fR, the exit handlers will not be run.
\fBTcl_Exit\fR internally invokes the \fBexit\fR system call, thus it never
returns control to its caller.
If an application exit handler has been installed (see
\fBTcl_SetExitProc\fR), that handler is invoked with an argument
consisting of the exit status (cast to void *); the application
exit handler should not return control to Tcl.
.PP
\fBTcl_Finalize\fR is similar to \fBTcl_Exit\fR except that it does not
exit from the current process.
It is useful for cleaning up when a process is finished using \fBTcl\fR but
wishes to continue executing, and when \fBTcl\fR is used in a dynamically
loaded extension that is about to be unloaded.
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
by \fBTcl_FinalizeThread\fR and \fBTcl_ExitThread\fR.
This provides a hook for cleanup operations such as flushing buffers
and freeing global memory.
\fIProc\fR should match the type \fBTcl_ExitProc\fR:
.PP
.CS
typedef void \fBTcl_ExitProc\fR(
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a
copy of the \fIclientData\fR argument given to
\fBTcl_CreateExitHandler\fR or \fBTcl_CreateThreadExitHandler\fR when
the callback
was created.  Typically, \fIclientData\fR points to a data







|







89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
by \fBTcl_FinalizeThread\fR and \fBTcl_ExitThread\fR.
This provides a hook for cleanup operations such as flushing buffers
and freeing global memory.
\fIProc\fR should match the type \fBTcl_ExitProc\fR:
.PP
.CS
typedef void \fBTcl_ExitProc\fR(
        void *\fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a
copy of the \fIclientData\fR argument given to
\fBTcl_CreateExitHandler\fR or \fBTcl_CreateThreadExitHandler\fR when
the callback
was created.  Typically, \fIclientData\fR points to a data
129
130
131
132
133
134
135
136
137
138
139
140
\fBTcl_SetExitProc\fR installs an application exit handler, returning
the previously-installed application exit handler or NULL if no
application handler was installed.  If an application exit handler is
installed, that exit handler takes over complete responsibility for
finalization of Tcl's subsystems via \fBTcl_Finalize\fR at an
appropriate time.  The argument passed to \fIproc\fR when it is
invoked will be the exit status code (as passed to \fBTcl_Exit\fR)
cast to a ClientData value.
.SH "SEE ALSO"
exit(n)
.SH KEYWORDS
abort, callback, cleanup, dynamic loading, end application, exit, unloading, thread







|




129
130
131
132
133
134
135
136
137
138
139
140
\fBTcl_SetExitProc\fR installs an application exit handler, returning
the previously-installed application exit handler or NULL if no
application handler was installed.  If an application exit handler is
installed, that exit handler takes over complete responsibility for
finalization of Tcl's subsystems via \fBTcl_Finalize\fR at an
appropriate time.  The argument passed to \fIproc\fR when it is
invoked will be the exit status code (as passed to \fBTcl_Exit\fR)
cast to a void *value.
.SH "SEE ALSO"
exit(n)
.SH KEYWORDS
abort, callback, cleanup, dynamic loading, end application, exit, unloading, thread
Changes to doc/FileSystem.3.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
.sp
int
\fBTcl_FSRegister\fR(\fIclientData, fsPtr\fR)
.sp
int
\fBTcl_FSUnregister\fR(\fIfsPtr\fR)
.sp
ClientData
\fBTcl_FSData\fR(\fIfsPtr\fR)
.sp
void
\fBTcl_FSMountsChanged\fR(\fIfsPtr\fR)
.sp
const Tcl_Filesystem *
\fBTcl_FSGetFileSystemForPath\fR(\fIpathPtr\fR)







|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
.sp
int
\fBTcl_FSRegister\fR(\fIclientData, fsPtr\fR)
.sp
int
\fBTcl_FSUnregister\fR(\fIfsPtr\fR)
.sp
void *
\fBTcl_FSData\fR(\fIfsPtr\fR)
.sp
void
\fBTcl_FSMountsChanged\fR(\fIfsPtr\fR)
.sp
const Tcl_Filesystem *
\fBTcl_FSGetFileSystemForPath\fR(\fIpathPtr\fR)
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
.sp
Tcl_Obj *
\fBTcl_FSJoinToPath\fR(\fIbasePtr, objc, objv\fR)
.sp
int
\fBTcl_FSConvertToPathType\fR(\fIinterp, pathPtr\fR)
.sp
ClientData
\fBTcl_FSGetInternalRep\fR(\fIpathPtr, fsPtr\fR)
.sp
Tcl_Obj *
\fBTcl_FSGetTranslatedPath\fR(\fIinterp, pathPtr\fR)
.sp
const char *
\fBTcl_FSGetTranslatedStringPath\fR(\fIinterp, pathPtr\fR)







|







121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
.sp
Tcl_Obj *
\fBTcl_FSJoinToPath\fR(\fIbasePtr, objc, objv\fR)
.sp
int
\fBTcl_FSConvertToPathType\fR(\fIinterp, pathPtr\fR)
.sp
void *
\fBTcl_FSGetInternalRep\fR(\fIpathPtr, fsPtr\fR)
.sp
Tcl_Obj *
\fBTcl_FSGetTranslatedPath\fR(\fIinterp, pathPtr\fR)
.sp
const char *
\fBTcl_FSGetTranslatedStringPath\fR(\fIinterp, pathPtr\fR)
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
Only files or directories matching this pattern will be returned.
.AP Tcl_GlobTypeData *types in
Only files or directories matching the type descriptions contained in
this structure will be returned. This parameter may be NULL.
.AP Tcl_Interp *interp in
Interpreter to use either for results, evaluation, or reporting error
messages.
.AP ClientData clientData in
The native description of the path value to create.
.AP Tcl_Obj *firstPtr in
The first of two path values to compare. The value may be converted
to \fBpath\fR type.
.AP Tcl_Obj *secondPtr in
The second of two path values to compare. The value may be converted
to \fBpath\fR type.







|







208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
Only files or directories matching this pattern will be returned.
.AP Tcl_GlobTypeData *types in
Only files or directories matching the type descriptions contained in
this structure will be returned. This parameter may be NULL.
.AP Tcl_Interp *interp in
Interpreter to use either for results, evaluation, or reporting error
messages.
.AP void *clientData in
The native description of the path value to create.
.AP Tcl_Obj *firstPtr in
The first of two path values to compare. The value may be converted
to \fBpath\fR type.
.AP Tcl_Obj *secondPtr in
The second of two path values to compare. The value may be converted
to \fBpath\fR type.
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
Name of a procedure to look up in the file's symbol table
.AP "const char" *sym2 in
Name of a procedure to look up in the file's symbol table
.AP Tcl_PackageInitProc **proc1Ptr out
Filled with the init function for this code.
.AP Tcl_PackageInitProc **proc2Ptr out
Filled with the safe-init function for this code.
.AP ClientData *clientDataPtr out
Filled with the clientData value to pass to this code's unload
function when it is called.
.AP Tcl_LoadHandle *loadHandlePtr out
Filled with an abstract token representing the loaded file.
.AP Tcl_FSUnloadFileProc **unloadProcPtr out
Filled with the function to use to unload this piece of code.
.AP Tcl_LoadHandle loadHandle in







|







245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
Name of a procedure to look up in the file's symbol table
.AP "const char" *sym2 in
Name of a procedure to look up in the file's symbol table
.AP Tcl_PackageInitProc **proc1Ptr out
Filled with the init function for this code.
.AP Tcl_PackageInitProc **proc2Ptr out
Filled with the safe-init function for this code.
.AP void **clientDataPtr out
Filled with the clientData value to pass to this code's unload
function when it is called.
.AP Tcl_LoadHandle *loadHandlePtr out
Filled with an abstract token representing the loaded file.
.AP Tcl_FSUnloadFileProc **unloadProcPtr out
Filled with the function to use to unload this piece of code.
.AP Tcl_LoadHandle loadHandle in
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
freed. This function is of little practical use, and
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSGetTranslatedStringPath\fR does the same as
\fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL.
The string returned is dynamically allocated and owned by the caller,
which must store it or call \fBckfree\fR to ensure it is freed. Again,
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSNewNativePath\fR performs something like the reverse of the
usual obj->path->nativerep conversions. If some code retrieves a path
in native form (from, e.g.\ \fBreadlink\fR or a native dialog), and that path
is to be used at the Tcl level, then calling this function is an







|







720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
freed. This function is of little practical use, and
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSGetTranslatedStringPath\fR does the same as
\fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL.
The string returned is dynamically allocated and owned by the caller,
which must store it or call \fBTcl_Free\fR to ensure it is freed. Again,
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSNewNativePath\fR performs something like the reverse of the
usual obj->path->nativerep conversions. If some code retrieves a path
in native form (from, e.g.\ \fBreadlink\fR or a native dialog), and that path
is to be used at the Tcl level, then calling this function is an
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
absolute.
.PP
It returns one of \fBTCL_PATH_ABSOLUTE\fR, \fBTCL_PATH_RELATIVE\fR, or
\fBTCL_PATH_VOLUME_RELATIVE\fR
.SS "PORTABLE STAT RESULT API"
.PP
\fBTcl_AllocStatBuf\fR allocates a \fITcl_StatBuf\fR on the system heap (which
may be deallocated by being passed to \fBckfree\fR). This allows extensions to
invoke \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR without being dependent on the
size of the buffer. That in turn depends on the flags used to build Tcl.
.PP
.VS 8.6
The portable fields of a \fITcl_StatBuf\fR may be read using the following
functions, each of which returns the value of the corresponding field listed
in the table below. Note that on some platforms there may be other fields in







|







787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
absolute.
.PP
It returns one of \fBTCL_PATH_ABSOLUTE\fR, \fBTCL_PATH_RELATIVE\fR, or
\fBTCL_PATH_VOLUME_RELATIVE\fR
.SS "PORTABLE STAT RESULT API"
.PP
\fBTcl_AllocStatBuf\fR allocates a \fITcl_StatBuf\fR on the system heap (which
may be deallocated by being passed to \fBTcl_Free\fR). This allows extensions to
invoke \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR without being dependent on the
size of the buffer. That in turn depends on the flags used to build Tcl.
.PP
.VS 8.6
The portable fields of a \fITcl_StatBuf\fR may be read using the following
functions, each of which returns the value of the corresponding field listed
in the table below. Note that on some platforms there may be other fields in
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
not check if the same filesystem is registered multiple times (and in
general that is not a good thing to do). \fBTCL_OK\fR will be returned.
.PP
\fBTcl_FSUnregister\fR removes the given filesystem structure from
the list of known filesystems, if it is known, and returns \fBTCL_OK\fR. If
the filesystem is not currently registered, \fBTCL_ERROR\fR is returned.
.PP
\fBTcl_FSData\fR will return the ClientData associated with the given
filesystem, if that filesystem is registered. Otherwise it will
return NULL.
.PP
\fBTcl_FSMountsChanged\fR is used to inform the Tcl's core that
the set of mount points for the given (already registered) filesystem
have changed, and that cached file representations may therefore no
longer be correct.







|







837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
not check if the same filesystem is registered multiple times (and in
general that is not a good thing to do). \fBTCL_OK\fR will be returned.
.PP
\fBTcl_FSUnregister\fR removes the given filesystem structure from
the list of known filesystems, if it is known, and returns \fBTCL_OK\fR. If
the filesystem is not currently registered, \fBTCL_ERROR\fR is returned.
.PP
\fBTcl_FSData\fR will return the clientData associated with the given
filesystem, if that filesystem is registered. Otherwise it will
return NULL.
.PP
\fBTcl_FSMountsChanged\fR is used to inform the Tcl's core that
the set of mount points for the given (already registered) filesystem
have changed, and that cached file representations may therefore no
longer be correct.
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
cache the fact that this path belongs to this filesystem. Such caches
are invalidated when filesystem structures are added or removed from
Tcl's internal list of known filesystems.
.PP
.CS
typedef int \fBTcl_FSPathInFilesystemProc\fR(
        Tcl_Obj *\fIpathPtr\fR,
        ClientData *\fIclientDataPtr\fR);
.CE
.SS DUPINTERNALREPPROC
.PP
This function makes a copy of a path's internal representation, and is
called when Tcl needs to duplicate a path value. If NULL, Tcl will
simply not copy the internal representation, which may then need to be
regenerated later.
.PP
.CS
typedef ClientData \fBTcl_FSDupInternalRepProc\fR(
        ClientData \fIclientData\fR);
.CE
.SS FREEINTERNALREPPROC
Free the internal representation. This must be implemented if internal
representations need freeing (i.e.\ if some memory is allocated when an
internal representation is generated), but may otherwise be NULL.
.PP
.CS
typedef void \fBTcl_FSFreeInternalRepProc\fR(
        ClientData \fIclientData\fR);
.CE
.SS INTERNALTONORMALIZEDPROC
.PP
Function to convert internal representation to a normalized path. Only
required if the filesystem creates pure path values with no string/path
representation. The return value is a Tcl value whose string
representation is the normalized path.
.PP
.CS
typedef Tcl_Obj *\fBTcl_FSInternalToNormalizedProc\fR(
        ClientData \fIclientData\fR);
.CE
.SS CREATEINTERNALREPPROC
.PP
Function to take a path value, and calculate an internal
representation for it, and store that native representation in the
value. May be NULL if paths have no internal representation, or if
the \fITcl_FSPathInFilesystemProc\fR for this filesystem always
immediately creates an internal representation for paths it accepts.
.PP
.CS
typedef ClientData \fBTcl_FSCreateInternalRepProc\fR(
        Tcl_Obj *\fIpathPtr\fR);
.CE
.SS NORMALIZEPATHPROC
.PP
Function to normalize a path. Should be implemented for all
filesystems which can have multiple string representations for the same
path value. In Tcl, every







|









|
|








|










|










|







1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
cache the fact that this path belongs to this filesystem. Such caches
are invalidated when filesystem structures are added or removed from
Tcl's internal list of known filesystems.
.PP
.CS
typedef int \fBTcl_FSPathInFilesystemProc\fR(
        Tcl_Obj *\fIpathPtr\fR,
        void **\fIclientDataPtr\fR);
.CE
.SS DUPINTERNALREPPROC
.PP
This function makes a copy of a path's internal representation, and is
called when Tcl needs to duplicate a path value. If NULL, Tcl will
simply not copy the internal representation, which may then need to be
regenerated later.
.PP
.CS
typedef void *\fBTcl_FSDupInternalRepProc\fR(
        void *\fIclientData\fR);
.CE
.SS FREEINTERNALREPPROC
Free the internal representation. This must be implemented if internal
representations need freeing (i.e.\ if some memory is allocated when an
internal representation is generated), but may otherwise be NULL.
.PP
.CS
typedef void \fBTcl_FSFreeInternalRepProc\fR(
        void *\fIclientData\fR);
.CE
.SS INTERNALTONORMALIZEDPROC
.PP
Function to convert internal representation to a normalized path. Only
required if the filesystem creates pure path values with no string/path
representation. The return value is a Tcl value whose string
representation is the normalized path.
.PP
.CS
typedef Tcl_Obj *\fBTcl_FSInternalToNormalizedProc\fR(
        void *\fIclientData\fR);
.CE
.SS CREATEINTERNALREPPROC
.PP
Function to take a path value, and calculate an internal
representation for it, and store that native representation in the
value. May be NULL if paths have no internal representation, or if
the \fITcl_FSPathInFilesystemProc\fR for this filesystem always
immediately creates an internal representation for paths it accepts.
.PP
.CS
typedef void *\fBTcl_FSCreateInternalRepProc\fR(
        Tcl_Obj *\fIpathPtr\fR);
.CE
.SS NORMALIZEPATHPROC
.PP
Function to normalize a path. Should be implemented for all
filesystems which can have multiple string representations for the same
path value. In Tcl, every
Changes to doc/GetOpnFl.3.
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
String identifying channel, such as \fBstdin\fR or \fBfile4\fR.
.AP int write in
Non-zero means the file will be used for writing, zero means it will
be used for reading.
.AP int checkUsage in
If non-zero, then an error will be generated if the file was not opened
for the access indicated by \fIwrite\fR.
.AP ClientData *filePtr out
Points to word in which to store pointer to FILE structure for
the file given by \fIchanID\fR.
.BE

.SH DESCRIPTION
.PP
\fBTcl_GetOpenFile\fR takes as argument a file identifier of the form







|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
String identifying channel, such as \fBstdin\fR or \fBfile4\fR.
.AP int write in
Non-zero means the file will be used for writing, zero means it will
be used for reading.
.AP int checkUsage in
If non-zero, then an error will be generated if the file was not opened
for the access indicated by \fIwrite\fR.
.AP void **filePtr out
Points to word in which to store pointer to FILE structure for
the file given by \fIchanID\fR.
.BE

.SH DESCRIPTION
.PP
\fBTcl_GetOpenFile\fR takes as argument a file identifier of the form
Changes to doc/GetTime.3.
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
.AP Tcl_Time *timePtr out
Points to memory in which to store the date and time information.
.AP Tcl_GetTimeProc getProc in
Pointer to handler function replacing \fBTcl_GetTime\fR's access to the OS.
.AP Tcl_ScaleTimeProc scaleProc in
Pointer to handler function for the conversion of time delays in the
virtual domain to real-time.
.AP ClientData clientData in
Value passed through to the two handler functions.
.AP Tcl_GetTimeProc *getProcPtr out
Pointer to place the currently registered get handler function into.
.AP Tcl_ScaleTimeProc *scaleProcPtr out
Pointer to place the currently registered scale handler function into.
.AP ClientData *clientDataPtr out
Pointer to place the currently registered pass-through value into.
.BE
.SH DESCRIPTION
.PP
The \fBTcl_GetTime\fR function retrieves the current time as a
\fITcl_Time\fR structure in memory the caller provides.  This
structure has the following definition:







|





|







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
.AP Tcl_Time *timePtr out
Points to memory in which to store the date and time information.
.AP Tcl_GetTimeProc getProc in
Pointer to handler function replacing \fBTcl_GetTime\fR's access to the OS.
.AP Tcl_ScaleTimeProc scaleProc in
Pointer to handler function for the conversion of time delays in the
virtual domain to real-time.
.AP void *clientData in
Value passed through to the two handler functions.
.AP Tcl_GetTimeProc *getProcPtr out
Pointer to place the currently registered get handler function into.
.AP Tcl_ScaleTimeProc *scaleProcPtr out
Pointer to place the currently registered scale handler function into.
.AP void **clientDataPtr out
Pointer to place the currently registered pass-through value into.
.BE
.SH DESCRIPTION
.PP
The \fBTcl_GetTime\fR function retrieves the current time as a
\fITcl_Time\fR structure in memory the caller provides.  This
structure has the following definition:
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
any argument which is NULL is ignored and not set.
.PP
The signatures of the handler functions are as follows:
.PP
.CS
typedef void \fBTcl_GetTimeProc\fR(
        Tcl_Time *\fItimebuf\fR,
        ClientData \fIclientData\fR);
typedef void \fBTcl_ScaleTimeProc\fR(
        Tcl_Time *\fItimebuf\fR,
        ClientData \fIclientData\fR);
.CE
.PP
The \fItimebuf\fR fields contain the time to manipulate, and the
\fIclientData\fR fields contain a pointer supplied at the time the handler
functions were registered.
.PP
Any handler pair specified has to return data which is consistent between







|


|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
any argument which is NULL is ignored and not set.
.PP
The signatures of the handler functions are as follows:
.PP
.CS
typedef void \fBTcl_GetTimeProc\fR(
        Tcl_Time *\fItimebuf\fR,
        void *\fIclientData\fR);
typedef void \fBTcl_ScaleTimeProc\fR(
        Tcl_Time *\fItimebuf\fR,
        void *\fIclientData\fR);
.CE
.PP
The \fItimebuf\fR fields contain the time to manipulate, and the
\fIclientData\fR fields contain a pointer supplied at the time the handler
functions were registered.
.PP
Any handler pair specified has to return data which is consistent between
Changes to doc/Hash.3.
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
\fBTcl_CreateHashEntry\fR(\fItablePtr, key, newPtr\fR)
.sp
\fBTcl_DeleteHashEntry\fR(\fIentryPtr\fR)
.sp
Tcl_HashEntry *
\fBTcl_FindHashEntry\fR(\fItablePtr, key\fR)
.sp
ClientData
\fBTcl_GetHashValue\fR(\fIentryPtr\fR)
.sp
\fBTcl_SetHashValue\fR(\fIentryPtr, value\fR)
.sp
void *
\fBTcl_GetHashKey\fR(\fItablePtr, entryPtr\fR)
.sp







|







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
\fBTcl_CreateHashEntry\fR(\fItablePtr, key, newPtr\fR)
.sp
\fBTcl_DeleteHashEntry\fR(\fIentryPtr\fR)
.sp
Tcl_HashEntry *
\fBTcl_FindHashEntry\fR(\fItablePtr, key\fR)
.sp
void *
\fBTcl_GetHashValue\fR(\fIentryPtr\fR)
.sp
\fBTcl_SetHashValue\fR(\fIentryPtr, value\fR)
.sp
void *
\fBTcl_GetHashKey\fR(\fItablePtr, entryPtr\fR)
.sp
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Key to use for probe into table.  Exact form depends on
\fIkeyType\fR used to create table.
.AP int *newPtr out
The word at \fI*newPtr\fR is set to 1 if a new entry was created
and 0 if there was already an entry for \fIkey\fR.
.AP Tcl_HashEntry *entryPtr in
Pointer to hash table entry.
.AP ClientData value in
New value to assign to hash table entry.  Need not have type
ClientData, but must fit in same space as ClientData.
.AP Tcl_HashSearch *searchPtr in
Pointer to record to use to keep track of progress in enumerating
all the entries in a hash table.
.BE
.SH DESCRIPTION
.PP
A hash table consists of zero or more entries, each consisting of a







|
|
<







62
63
64
65
66
67
68
69
70

71
72
73
74
75
76
77
Key to use for probe into table.  Exact form depends on
\fIkeyType\fR used to create table.
.AP int *newPtr out
The word at \fI*newPtr\fR is set to 1 if a new entry was created
and 0 if there was already an entry for \fIkey\fR.
.AP Tcl_HashEntry *entryPtr in
Pointer to hash table entry.
.AP void *value in
New value to assign to hash table entry.

.AP Tcl_HashSearch *searchPtr in
Pointer to record to use to keep track of progress in enumerating
all the entries in a hash table.
.BE
.SH DESCRIPTION
.PP
A hash table consists of zero or more entries, each consisting of a
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
.PP
\fBTcl_FindHashEntry\fR is similar to \fBTcl_CreateHashEntry\fR
except that it does not create a new entry if the key doesn't exist;
instead, it returns NULL as result.
.PP
\fBTcl_GetHashValue\fR and \fBTcl_SetHashValue\fR are used to
read and write an entry's value, respectively.
Values are stored and retrieved as type
.QW ClientData ,
which is
large enough to hold a pointer value.  On almost all machines this is
large enough to hold an integer value too.
.PP
\fBTcl_GetHashKey\fR returns the key for a given hash table entry,
either as a pointer to a string, a one-word
.PQ "char *"
key, or
as a pointer to the first word of an array of integers, depending
on the \fIkeyType\fR used to create a hash table.







<
<
<
<
<







181
182
183
184
185
186
187





188
189
190
191
192
193
194
.PP
\fBTcl_FindHashEntry\fR is similar to \fBTcl_CreateHashEntry\fR
except that it does not create a new entry if the key doesn't exist;
instead, it returns NULL as result.
.PP
\fBTcl_GetHashValue\fR and \fBTcl_SetHashValue\fR are used to
read and write an entry's value, respectively.





.PP
\fBTcl_GetHashKey\fR returns the key for a given hash table entry,
either as a pointer to a string, a one-word
.PQ "char *"
key, or
as a pointer to the first word of an array of integers, depending
on the \fIkeyType\fR used to create a hash table.
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
\fBTcl_FirstHashEntry\fR or \fBTcl_NextHashEntry\fR.
.PP
\fBTcl_HashStats\fR returns a dynamically-allocated string with
overall information about a hash table, such as the number of
entries it contains, the number of buckets in its hash array,
and the utilization of the buckets.
It is the caller's responsibility to free the result string
by passing it to \fBckfree\fR.
.PP
The header file \fBtcl.h\fR defines the actual data structures
used to implement hash tables.
This is necessary so that clients can allocate Tcl_HashTable
structures and so that macros can be used to read and write
the values of entries.
However, users of the hashing routines should never refer directly







|







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
\fBTcl_FirstHashEntry\fR or \fBTcl_NextHashEntry\fR.
.PP
\fBTcl_HashStats\fR returns a dynamically-allocated string with
overall information about a hash table, such as the number of
entries it contains, the number of buckets in its hash array,
and the utilization of the buckets.
It is the caller's responsibility to free the result string
by passing it to \fBTcl_Free\fR.
.PP
The header file \fBtcl.h\fR defines the actual data structures
used to implement hash tables.
This is necessary so that clients can allocate Tcl_HashTable
structures and so that macros can be used to read and write
the values of entries.
However, users of the hashing routines should never refer directly
Changes to doc/Limit.3.
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Function to call when a particular limit is exceeded.  If the
\fIhandlerProc\fR removes or raises the limit during its processing,
the limited interpreter will be permitted to continue to process after
the handler returns.  Many handlers may be attached to the same
interpreter limit; their order of execution is not defined, and they
must be identified by \fIhandlerProc\fR and \fIclientData\fR when they
are deleted.
.AP ClientData clientData in
Arbitrary pointer-sized word used to pass some context to the
\fIhandlerProc\fR function.
.AP Tcl_LimitHandlerDeleteProc *deleteProc in
Function to call whenever a handler is deleted.  May be NULL if the
\fIclientData\fR requires no deletion.
.BE
.SH DESCRIPTION







|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Function to call when a particular limit is exceeded.  If the
\fIhandlerProc\fR removes or raises the limit during its processing,
the limited interpreter will be permitted to continue to process after
the handler returns.  Many handlers may be attached to the same
interpreter limit; their order of execution is not defined, and they
must be identified by \fIhandlerProc\fR and \fIclientData\fR when they
are deleted.
.AP void *clientData in
Arbitrary pointer-sized word used to pass some context to the
\fIhandlerProc\fR function.
.AP Tcl_LimitHandlerDeleteProc *deleteProc in
Function to call whenever a handler is deleted.  May be NULL if the
\fIclientData\fR requires no deletion.
.BE
.SH DESCRIPTION
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
To add a handler callback to be invoked when a limit is exceeded, call
\fBTcl_LimitAddHandler\fR.  The \fIhandlerProc\fR argument describes
the function that will actually be called; it should have the
following prototype:
.PP
.CS
typedef void \fBTcl_LimitHandlerProc\fR(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIclientData\fR argument to the handler will be whatever is
passed to the \fIclientData\fR argument to \fBTcl_LimitAddHandler\fR,
and the \fIinterp\fR is the interpreter that had its limit exceeded.
.PP
The \fIdeleteProc\fR argument to \fBTcl_LimitAddHandler\fR is a
function to call to delete the \fIclientData\fR value.  It may be
\fBTCL_STATIC\fR or NULL if no deletion action is necessary, or
\fBTCL_DYNAMIC\fR if all that is necessary is to free the structure with
\fBTcl_Free\fR.  Otherwise, it should refer to a function with the
following prototype:
.PP
.CS
typedef void \fBTcl_LimitHandlerDeleteProc\fR(
        ClientData \fIclientData\fR);
.CE
.PP
A limit handler may be deleted using \fBTcl_LimitRemoveHandler\fR; the
handler removed will be the first one found (out of the handlers added
with \fBTcl_LimitAddHandler\fR) with exactly matching \fItype\fR,
\fIhandlerProc\fR and \fIclientData\fR arguments.  This function
always invokes the \fIdeleteProc\fR on the \fIclientData\fR (unless
the \fIdeleteProc\fR was NULL or \fBTCL_STATIC\fR).
.SH KEYWORDS
interpreter, resource, limit, commands, time, callback







|
















|










158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
To add a handler callback to be invoked when a limit is exceeded, call
\fBTcl_LimitAddHandler\fR.  The \fIhandlerProc\fR argument describes
the function that will actually be called; it should have the
following prototype:
.PP
.CS
typedef void \fBTcl_LimitHandlerProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIclientData\fR argument to the handler will be whatever is
passed to the \fIclientData\fR argument to \fBTcl_LimitAddHandler\fR,
and the \fIinterp\fR is the interpreter that had its limit exceeded.
.PP
The \fIdeleteProc\fR argument to \fBTcl_LimitAddHandler\fR is a
function to call to delete the \fIclientData\fR value.  It may be
\fBTCL_STATIC\fR or NULL if no deletion action is necessary, or
\fBTCL_DYNAMIC\fR if all that is necessary is to free the structure with
\fBTcl_Free\fR.  Otherwise, it should refer to a function with the
following prototype:
.PP
.CS
typedef void \fBTcl_LimitHandlerDeleteProc\fR(
        void *\fIclientData\fR);
.CE
.PP
A limit handler may be deleted using \fBTcl_LimitRemoveHandler\fR; the
handler removed will be the first one found (out of the handlers added
with \fBTcl_LimitAddHandler\fR) with exactly matching \fItype\fR,
\fIhandlerProc\fR and \fIclientData\fR arguments.  This function
always invokes the \fIdeleteProc\fR on the \fIclientData\fR (unless
the \fIdeleteProc\fR was NULL or \fBTCL_STATIC\fR).
.SH KEYWORDS
interpreter, resource, limit, commands, time, callback
Changes to doc/LinkVar.3.
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
form acceptable to \fBTcl_GetBooleanFromObj\fR;  attempts to write
non-boolean values into \fIvarName\fR will be rejected with
Tcl errors.
.TP
\fBTCL_LINK_STRING\fR
The C variable is of type \fBchar *\fR.
If its value is not NULL then it must be a pointer to a string
allocated with \fBTcl_Alloc\fR or \fBckalloc\fR.
Whenever the Tcl variable is modified the current C string will be
freed and new memory will be allocated to hold a copy of the variable's
new value.
If the C variable contains a NULL pointer then the Tcl variable
will read as
.QW NULL .
.PP







|







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
form acceptable to \fBTcl_GetBooleanFromObj\fR;  attempts to write
non-boolean values into \fIvarName\fR will be rejected with
Tcl errors.
.TP
\fBTCL_LINK_STRING\fR
The C variable is of type \fBchar *\fR.
If its value is not NULL then it must be a pointer to a string
allocated with \fBTcl_Alloc\fR.
Whenever the Tcl variable is modified the current C string will be
freed and new memory will be allocated to hold a copy of the variable's
new value.
If the C variable contains a NULL pointer then the Tcl variable
will read as
.QW NULL .
.PP
Changes to doc/Method.3.
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
.sp
Tcl_Object
\fBTcl_ObjectContextObject\fR(\fIcontext\fR)
.sp
int
\fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR)
.SH ARGUMENTS
.AS ClientData clientData in
.AP Tcl_Interp *interp in/out
The interpreter holding the object or class to create or update a method in.
.AP Tcl_Object object in
The object to create the method in.
.AP Tcl_Class class in
The class to create the method in.
.AP Tcl_Obj *nameObj in







|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
.sp
Tcl_Object
\fBTcl_ObjectContextObject\fR(\fIcontext\fR)
.sp
int
\fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR)
.SH ARGUMENTS
.AS void *clientData in
.AP Tcl_Interp *interp in/out
The interpreter holding the object or class to create or update a method in.
.AP Tcl_Object object in
The object to create the method in.
.AP Tcl_Class class in
The class to create the method in.
.AP Tcl_Obj *nameObj in
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
compatibility) for a non-exported method,
.VS TIP500
and \fBTCL_OO_METHOD_PRIVATE\fR for a private method.
.VE TIP500
.AP Tcl_MethodType *methodTypePtr in
A description of the type of the method to create, or the type of method to
compare against.
.AP ClientData clientData in
A piece of data that is passed to the implementation of the method without
interpretation.
.AP ClientData *clientDataPtr out
A pointer to a variable in which to write the \fIclientData\fR value supplied
when the method was created. If NULL, the \fIclientData\fR value will not be
retrieved.
.AP Tcl_Method method in
A reference to a method to query.
.AP Tcl_ObjectContext context in
A reference to a method-call context. Note that client code \fImust not\fR







|


|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
compatibility) for a non-exported method,
.VS TIP500
and \fBTCL_OO_METHOD_PRIVATE\fR for a private method.
.VE TIP500
.AP Tcl_MethodType *methodTypePtr in
A description of the type of the method to create, or the type of method to
compare against.
.AP void *clientData in
A piece of data that is passed to the implementation of the method without
interpretation.
.AP void **clientDataPtr out
A pointer to a variable in which to write the \fIclientData\fR value supplied
when the method was created. If NULL, the \fIclientData\fR value will not be
retrieved.
.AP Tcl_Method method in
A reference to a method to query.
.AP Tcl_ObjectContext context in
A reference to a method-call context. Note that client code \fImust not\fR
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
that the \fIclientData\fR can just be copied directly.
.SS "TCL_METHODCALLPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are called when the method is invoked.
.PP
.CS
typedef int \fBTcl_MethodCallProc\fR(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        Tcl_ObjectContext \fIobjectContext\fR,
        int \fIobjc\fR,
        Tcl_Obj *const *\fIobjv\fR);
.CE
.PP
The \fIclientData\fR argument to a Tcl_MethodCallProc is the value that was
given when the method was created, the \fIinterp\fR is a place in which to
execute scripts and access variables as well as being where to put the result
of the method, and the \fIobjc\fR and \fIobjv\fR fields give the parameter
objects to the method. The calling context of the method can be discovered
through the \fIobjectContext\fR argument, and the return value from a
Tcl_MethodCallProc is any Tcl return code (e.g. TCL_OK, TCL_ERROR).
.SS "TCL_METHODDELETEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used when a method is deleted, whether
through a new method being created or because the object or class is deleted.
.PP
.CS
typedef void \fBTcl_MethodDeleteProc\fR(
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument to a Tcl_MethodDeleteProc will be the same as
the value passed to the \fIclientData\fR argument to \fBTcl_NewMethod\fR or
\fBTcl_NewInstanceMethod\fR when the method was created.
.SS "TCL_CLONEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used to copy a method when the object or
class is copied using \fBTcl_CopyObjectInstance\fR (or \fBoo::copy\fR).
.PP
.CS
typedef int \fBTcl_CloneProc\fR(
        Tcl_Interp *\fIinterp\fR,
        ClientData \fIoldClientData\fR,
        ClientData *\fInewClientDataPtr\fR);
.CE
.PP
The \fIinterp\fR argument gives a place to write an error message when the
attempt to clone the object is to fail, in which case the clone procedure must
also return TCL_ERROR; it should return TCL_OK otherwise.
The \fIoldClientData\fR field to a Tcl_CloneProc gives the value from the
method being copied from, and the \fInewClientDataPtr\fR field will point to







|




















|













|
|







209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
that the \fIclientData\fR can just be copied directly.
.SS "TCL_METHODCALLPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are called when the method is invoked.
.PP
.CS
typedef int \fBTcl_MethodCallProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        Tcl_ObjectContext \fIobjectContext\fR,
        int \fIobjc\fR,
        Tcl_Obj *const *\fIobjv\fR);
.CE
.PP
The \fIclientData\fR argument to a Tcl_MethodCallProc is the value that was
given when the method was created, the \fIinterp\fR is a place in which to
execute scripts and access variables as well as being where to put the result
of the method, and the \fIobjc\fR and \fIobjv\fR fields give the parameter
objects to the method. The calling context of the method can be discovered
through the \fIobjectContext\fR argument, and the return value from a
Tcl_MethodCallProc is any Tcl return code (e.g. TCL_OK, TCL_ERROR).
.SS "TCL_METHODDELETEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used when a method is deleted, whether
through a new method being created or because the object or class is deleted.
.PP
.CS
typedef void \fBTcl_MethodDeleteProc\fR(
        void *\fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument to a Tcl_MethodDeleteProc will be the same as
the value passed to the \fIclientData\fR argument to \fBTcl_NewMethod\fR or
\fBTcl_NewInstanceMethod\fR when the method was created.
.SS "TCL_CLONEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used to copy a method when the object or
class is copied using \fBTcl_CopyObjectInstance\fR (or \fBoo::copy\fR).
.PP
.CS
typedef int \fBTcl_CloneProc\fR(
        Tcl_Interp *\fIinterp\fR,
        void *\fIoldClientData\fR,
        void **\fInewClientDataPtr\fR);
.CE
.PP
The \fIinterp\fR argument gives a place to write an error message when the
attempt to clone the object is to fail, in which case the clone procedure must
also return TCL_ERROR; it should return TCL_OK otherwise.
The \fIoldClientData\fR field to a Tcl_CloneProc gives the value from the
method being copied from, and the \fInewClientDataPtr\fR field will point to
Changes to doc/NRE.3.
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
.AP Tcl_ObjCmdProc *proc in
Called in order to evaluate a command.  Is often just a small wrapper that uses
\fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline.  Behaves
in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3)
(\fIq.v.\fR).
.AP Tcl_ObjCmdProc *nreProc in
Called instead of \fIproc\fR when a trampoline is already in use.
.AP ClientData clientData in
Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR
and \fIobjProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in/out
Called before \fIcmdName\fR is deleted from the interpreter, allowing for
command-specific cleanup. May be NULL.
.AP int objc in
Number of items in \fIobjv\fR.







|







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
.AP Tcl_ObjCmdProc *proc in
Called in order to evaluate a command.  Is often just a small wrapper that uses
\fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline.  Behaves
in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3)
(\fIq.v.\fR).
.AP Tcl_ObjCmdProc *nreProc in
Called instead of \fIproc\fR when a trampoline is already in use.
.AP void *clientData in
Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR
and \fIobjProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in/out
Called before \fIcmdName\fR is deleted from the interpreter, allowing for
command-specific cleanup. May be NULL.
.AP int objc in
Number of items in \fIobjv\fR.
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Token to use instead of one derived from the first word of \fIobjv\fR in order
to evaluate a command.
.AP Tcl_Obj *resultPtr out
Pointer to an unshared Tcl_Obj where the result of the evaluation is stored if
the return code is TCL_OK.
.AP Tcl_NRPostProc *postProcPtr in
A function to push.
.AP ClientData data0 in
.AP ClientData data1 in
.AP ClientData data2 in
.AP ClientData data3 in
\fIdata0\fR through \fIdata3\fR are four one-word values that will be passed
to the function designated by \fIpostProcPtr\fR when it is invoked.
.BE
.SH DESCRIPTION
.PP
These functions provide an interface to the function stack that an interpreter
iterates through to evaluate commands.  The routine behind a command is







|
|
|
|







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Token to use instead of one derived from the first word of \fIobjv\fR in order
to evaluate a command.
.AP Tcl_Obj *resultPtr out
Pointer to an unshared Tcl_Obj where the result of the evaluation is stored if
the return code is TCL_OK.
.AP Tcl_NRPostProc *postProcPtr in
A function to push.
.AP void *data0 in
.AP void *data1 in
.AP void *data2 in
.AP void *data3 in
\fIdata0\fR through \fIdata3\fR are four one-word values that will be passed
to the function designated by \fIpostProcPtr\fR when it is invoked.
.BE
.SH DESCRIPTION
.PP
These functions provide an interface to the function stack that an interpreter
iterates through to evaluate commands.  The routine behind a command is
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
.PP
\fBTcl_NRAddCallback\fR pushes \fIpostProcPtr\fR.  The signature for
\fBTcl_NRPostProc\fR is:
.PP
.CS
typedef int
\fBTcl_NRPostProc\fR(
        \fBClientData\fR \fIdata\fR[],
        \fBTcl_Interp\fR *\fIinterp\fR,
        int \fIresult\fR);
.CE
.PP
\fIdata\fR is a pointer to an array containing \fIdata0\fR through \fIdata3\fR.
\fIresult\fR is the value returned by the previous function implementing part
the routine.
.SH EXAMPLE
.PP
The following command uses \fBTcl_EvalObjEx\fR, which consumes space on the C
stack, to evalute a script:
.PP
.CS
int
\fITheCmdOldObjProc\fR(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int result;
    Tcl_Obj *objPtr;








|















|







126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
.PP
\fBTcl_NRAddCallback\fR pushes \fIpostProcPtr\fR.  The signature for
\fBTcl_NRPostProc\fR is:
.PP
.CS
typedef int
\fBTcl_NRPostProc\fR(
        \fBvoid *\fR \fIdata\fR[],
        \fBTcl_Interp\fR *\fIinterp\fR,
        int \fIresult\fR);
.CE
.PP
\fIdata\fR is a pointer to an array containing \fIdata0\fR through \fIdata3\fR.
\fIresult\fR is the value returned by the previous function implementing part
the routine.
.SH EXAMPLE
.PP
The following command uses \fBTcl_EvalObjEx\fR, which consumes space on the C
stack, to evalute a script:
.PP
.CS
int
\fITheCmdOldObjProc\fR(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int result;
    Tcl_Obj *objPtr;

173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
trampoline instead of consuming space on the C stack.  A new version of
\fITheCmdOldObjProc\fR is just a a wrapper that uses \fBTcl_NRCallObjProc\fR to
call \fITheCmdNRObjProc\fR:
.PP
.CS
int
\fITheCmdOldObjProc\fR(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return \fBTcl_NRCallObjProc\fR(interp, \fITheCmdNRObjProc\fR,
            clientData, objc, objv);
}
.CE
.PP
.CS
int
\fITheCmdNRObjProc\fR
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *objPtr;

    \fI... preparation ...\fR

    \fBTcl_NRAddCallback\fR(interp, \fITheCmdPostProc\fR,
            data0, data1, data2, data3);
    /* \fIdata0 .. data3\fR are up to four one-word items to
     * pass to the postprocessing procedure */

    return \fBTcl_NREvalObj\fR(interp, objPtr, 0);
}
.CE
.PP
.CS
int
\fITheCmdNRPostProc\fR(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    /* \fIdata[0] .. data[3]\fR are the four words of data
     * passed to \fBTcl_NRAddCallback\fR */

    \fI... postprocessing ...\fR







|












|




















|







173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
trampoline instead of consuming space on the C stack.  A new version of
\fITheCmdOldObjProc\fR is just a a wrapper that uses \fBTcl_NRCallObjProc\fR to
call \fITheCmdNRObjProc\fR:
.PP
.CS
int
\fITheCmdOldObjProc\fR(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return \fBTcl_NRCallObjProc\fR(interp, \fITheCmdNRObjProc\fR,
            clientData, objc, objv);
}
.CE
.PP
.CS
int
\fITheCmdNRObjProc\fR
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *objPtr;

    \fI... preparation ...\fR

    \fBTcl_NRAddCallback\fR(interp, \fITheCmdPostProc\fR,
            data0, data1, data2, data3);
    /* \fIdata0 .. data3\fR are up to four one-word items to
     * pass to the postprocessing procedure */

    return \fBTcl_NREvalObj\fR(interp, objPtr, 0);
}
.CE
.PP
.CS
int
\fITheCmdNRPostProc\fR(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    /* \fIdata[0] .. data[3]\fR are the four words of data
     * passed to \fBTcl_NRAddCallback\fR */

    \fI... postprocessing ...\fR
Changes to doc/Namespace.3.
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
.SH ARGUMENTS
.AS Tcl_NamespaceDeleteProc allowOverwrite in/out
.AP Tcl_Interp *interp in/out
The interpreter in which the namespace exists and where name lookups
are performed. Also where error result messages are written.
.AP "const char" *name in
The name of the namespace or command to be created or accessed.
.AP ClientData clientData in
A context pointer by the creator of the namespace.  Not interpreted by
Tcl at all.
.AP Tcl_NamespaceDeleteProc *deleteProc in
A pointer to function to call when the namespace is deleted, or NULL
if no such callback is to be performed.
.AP Tcl_Namespace *nsPtr in
The namespace to be manipulated, or NULL (for other than







|







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
.SH ARGUMENTS
.AS Tcl_NamespaceDeleteProc allowOverwrite in/out
.AP Tcl_Interp *interp in/out
The interpreter in which the namespace exists and where name lookups
are performed. Also where error result messages are written.
.AP "const char" *name in
The name of the namespace or command to be created or accessed.
.AP void *clientData in
A context pointer by the creator of the namespace.  Not interpreted by
Tcl at all.
.AP Tcl_NamespaceDeleteProc *deleteProc in
A pointer to function to call when the namespace is deleted, or NULL
if no such callback is to be performed.
.AP Tcl_Namespace *nsPtr in
The namespace to be manipulated, or NULL (for other than
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
the global namespace.)
.PP
\fBTcl_CreateNamespace\fR creates a new namespace.  The
\fIdeleteProc\fR will have the following type signature:
.PP
.CS
typedef void \fBTcl_NamespaceDeleteProc\fR(
        ClientData \fIclientData\fR);
.CE
.PP
\fBTcl_DeleteNamespace\fR deletes a namespace, calling the
\fIdeleteProc\fR defined for the namespace (if any).
.PP
\fBTcl_AppendExportList\fR retrieves the export patterns for a
namespace given namespace and appends them (as list items) to







|







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
the global namespace.)
.PP
\fBTcl_CreateNamespace\fR creates a new namespace.  The
\fIdeleteProc\fR will have the following type signature:
.PP
.CS
typedef void \fBTcl_NamespaceDeleteProc\fR(
        void *\fIclientData\fR);
.CE
.PP
\fBTcl_DeleteNamespace\fR deletes a namespace, calling the
\fIdeleteProc\fR defined for the namespace (if any).
.PP
\fBTcl_AppendExportList\fR retrieves the export patterns for a
namespace given namespace and appends them (as list items) to
Changes to doc/Notifier.3.
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
.sp
Tcl_ThreadId
\fBTcl_GetCurrentThread\fR()
.sp
void
\fBTcl_DeleteEvents\fR(\fIdeleteProc, clientData\fR)
.sp
ClientData
\fBTcl_InitNotifier\fR()
.sp
void
\fBTcl_FinalizeNotifier\fR(\fIclientData\fR)
.sp
int
\fBTcl_WaitForEvent\fR(\fItimePtr\fR)







|







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
.sp
Tcl_ThreadId
\fBTcl_GetCurrentThread\fR()
.sp
void
\fBTcl_DeleteEvents\fR(\fIdeleteProc, clientData\fR)
.sp
void *
\fBTcl_InitNotifier\fR()
.sp
void
\fBTcl_FinalizeNotifier\fR(\fIclientData\fR)
.sp
int
\fBTcl_WaitForEvent\fR(\fItimePtr\fR)
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
.AS Tcl_EventDeleteProc *notifierProcPtr
.AP Tcl_EventSetupProc *setupProc in
Procedure to invoke to prepare for event wait in \fBTcl_DoOneEvent\fR.
.AP Tcl_EventCheckProc *checkProc in
Procedure for \fBTcl_DoOneEvent\fR to invoke after waiting for
events.  Checks to see if any events have occurred and, if so,
queues them.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIsetupProc\fR, \fIcheckProc\fR, or
\fIdeleteProc\fR.
.AP "const Tcl_Time" *timePtr in
Indicates the maximum amount of time to wait for an event.  This
is specified as an interval (how long to wait), not an absolute
time (when to wakeup).  If the pointer passed to \fBTcl_WaitForEvent\fR
is NULL, it means there is no maximum wait time:  wait forever if
necessary.
.AP Tcl_Event *evPtr in
An event to add to the event queue.  The storage for the event must
have been allocated by the caller using \fBTcl_Alloc\fR or \fBckalloc\fR.
.AP Tcl_QueuePosition position in
Where to add the new event in the queue:  \fBTCL_QUEUE_TAIL\fR,
\fBTCL_QUEUE_HEAD\fR, or \fBTCL_QUEUE_MARK\fR.
.AP Tcl_ThreadId threadId in
A unique identifier for a thread.
.AP Tcl_EventDeleteProc *deleteProc in
Procedure to invoke for each queued event in \fBTcl_DeleteEvents\fR.







|










|







74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
.AS Tcl_EventDeleteProc *notifierProcPtr
.AP Tcl_EventSetupProc *setupProc in
Procedure to invoke to prepare for event wait in \fBTcl_DoOneEvent\fR.
.AP Tcl_EventCheckProc *checkProc in
Procedure for \fBTcl_DoOneEvent\fR to invoke after waiting for
events.  Checks to see if any events have occurred and, if so,
queues them.
.AP void *clientData in
Arbitrary one-word value to pass to \fIsetupProc\fR, \fIcheckProc\fR, or
\fIdeleteProc\fR.
.AP "const Tcl_Time" *timePtr in
Indicates the maximum amount of time to wait for an event.  This
is specified as an interval (how long to wait), not an absolute
time (when to wakeup).  If the pointer passed to \fBTcl_WaitForEvent\fR
is NULL, it means there is no maximum wait time:  wait forever if
necessary.
.AP Tcl_Event *evPtr in
An event to add to the event queue.  The storage for the event must
have been allocated by the caller using \fBTcl_Alloc\fR.
.AP Tcl_QueuePosition position in
Where to add the new event in the queue:  \fBTCL_QUEUE_TAIL\fR,
\fBTCL_QUEUE_HEAD\fR, or \fBTCL_QUEUE_MARK\fR.
.AP Tcl_ThreadId threadId in
A unique identifier for a thread.
.AP Tcl_EventDeleteProc *deleteProc in
Procedure to invoke for each queued event in \fBTcl_DeleteEvents\fR.
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
The procedure \fBTcl_CreateEventSource\fR creates a new event source.
Its arguments specify the setup procedure and check procedure for
the event source.
\fISetupProc\fR should match the following prototype:
.PP
.CS
typedef void \fBTcl_EventSetupProc\fR(
        ClientData \fIclientData\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_CreateEventSource\fR;  it is typically used to
point to private information managed by the event source.
The \fIflags\fR argument will be the same as the \fIflags\fR







|







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
The procedure \fBTcl_CreateEventSource\fR creates a new event source.
Its arguments specify the setup procedure and check procedure for
the event source.
\fISetupProc\fR should match the following prototype:
.PP
.CS
typedef void \fBTcl_EventSetupProc\fR(
        void *\fIclientData\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_CreateEventSource\fR;  it is typically used to
point to private information managed by the event source.
The \fIflags\fR argument will be the same as the \fIflags\fR
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
The second procedure provided by each event source is its check
procedure, indicated by the \fIcheckProc\fR argument to
\fBTcl_CreateEventSource\fR.  \fICheckProc\fR must match the
following prototype:
.PP
.CS
typedef void \fBTcl_EventCheckProc\fR(
        ClientData \fIclientData\fR,
        int \fIflags\fR);
.CE
.PP
The arguments to this procedure are the same as those for \fIsetupProc\fR.
\fBCheckProc\fR is invoked by \fBTcl_DoOneEvent\fR after it has waited
for events.  Presumably at least one event source is now prepared to
queue an event.  \fBTcl_DoOneEvent\fR calls each of the event sources







|







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
The second procedure provided by each event source is its check
procedure, indicated by the \fIcheckProc\fR argument to
\fBTcl_CreateEventSource\fR.  \fICheckProc\fR must match the
following prototype:
.PP
.CS
typedef void \fBTcl_EventCheckProc\fR(
        void *\fIclientData\fR,
        int \fIflags\fR);
.CE
.PP
The arguments to this procedure are the same as those for \fIsetupProc\fR.
\fBCheckProc\fR is invoked by \fBTcl_DoOneEvent\fR after it has waited
for events.  Presumably at least one event source is now prepared to
queue an event.  \fBTcl_DoOneEvent\fR calls each of the event sources
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
Another example of deferring events happens in Tk if
\fBTk_RestrictEvents\fR has been invoked to defer certain kinds
of window events.
.PP
When \fIproc\fR returns 1, \fBTcl_ServiceEvent\fR will remove the
event from the event queue and free its storage.
Note that the storage for an event must be allocated by
the event source (using \fBTcl_Alloc\fR or the Tcl macro \fBckalloc\fR)
before calling \fBTcl_QueueEvent\fR, but it
will be freed by \fBTcl_ServiceEvent\fR, not by the event source.
.PP
Threaded applications work in a
similar manner, except that there is a separate event queue for
each thread containing a Tcl interpreter.
Calling \fBTcl_QueueEvent\fR in a multithreaded application adds







|







395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
Another example of deferring events happens in Tk if
\fBTk_RestrictEvents\fR has been invoked to defer certain kinds
of window events.
.PP
When \fIproc\fR returns 1, \fBTcl_ServiceEvent\fR will remove the
event from the event queue and free its storage.
Note that the storage for an event must be allocated by
the event source (using \fBTcl_Alloc\fR)
before calling \fBTcl_QueueEvent\fR, but it
will be freed by \fBTcl_ServiceEvent\fR, not by the event source.
.PP
Threaded applications work in a
similar manner, except that there is a separate event queue for
each thread containing a Tcl interpreter.
Calling \fBTcl_QueueEvent\fR in a multithreaded application adds
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
for each event in the queue, deleting those for with the procedure
returns 1.  Events for which the procedure returns 0 are left in the
queue.  \fIProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_EventDeleteProc\fR(
        Tcl_Event *\fIevPtr\fR,
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_DeleteEvents\fR; it is typically used to point to
private information managed by the event source.  The \fIevPtr\fR will
point to the next event in the queue.
.PP







|







424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
for each event in the queue, deleting those for with the procedure
returns 1.  Events for which the procedure returns 0 are left in the
queue.  \fIProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_EventDeleteProc\fR(
        Tcl_Event *\fIevPtr\fR,
        void *\fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_DeleteEvents\fR; it is typically used to point to
private information managed by the event source.  The \fIevPtr\fR will
point to the next event in the queue.
.PP
Changes to doc/Object.3.
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
.SH "THE TCL_OBJ STRUCTURE"
.PP
Each Tcl value is represented by a \fBTcl_Obj\fR structure
which is defined as follows.
.PP
.CS
typedef struct Tcl_Obj {
    int \fIrefCount\fR;
    char *\fIbytes\fR;
    int \fIlength\fR;
    const Tcl_ObjType *\fItypePtr\fR;
    union {
        long \fIlongValue\fR;
        double \fIdoubleValue\fR;
        void *\fIotherValuePtr\fR;
        Tcl_WideInt \fIwideValue\fR;
        struct {







|

|







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
.SH "THE TCL_OBJ STRUCTURE"
.PP
Each Tcl value is represented by a \fBTcl_Obj\fR structure
which is defined as follows.
.PP
.CS
typedef struct Tcl_Obj {
    size_t \fIrefCount\fR;
    char *\fIbytes\fR;
    size_t \fIlength\fR;
    const Tcl_ObjType *\fItypePtr\fR;
    union {
        long \fIlongValue\fR;
        double \fIdoubleValue\fR;
        void *\fIotherValuePtr\fR;
        Tcl_WideInt \fIwideValue\fR;
        struct {
Changes to doc/ObjectType.3.
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
We require the string representation's byte array
to have a null after the last byte, at offset \fIlength\fR,
and to have no null bytes before that; this allows string representations
to be treated as conventional null character-terminated C strings.
These restrictions are easily met by using Tcl's internal UTF encoding
for the string representation, same as one would do for other
Tcl routines accepting string values as arguments.
Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR
or \fBckalloc\fR.  Note that \fIupdateStringProc\fRs must allocate
enough storage for the string's bytes and the terminating null byte.
.PP
The \fIupdateStringProc\fR for Tcl's built-in double type, for example,
calls Tcl_PrintDouble to write to a buffer of size TCL_DOUBLE_SPACE,
then allocates and copies the string representation to just enough
space to hold it.  A pointer to the allocated space is stored in
the \fIbytes\fR member.







|
|







182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
We require the string representation's byte array
to have a null after the last byte, at offset \fIlength\fR,
and to have no null bytes before that; this allows string representations
to be treated as conventional null character-terminated C strings.
These restrictions are easily met by using Tcl's internal UTF encoding
for the string representation, same as one would do for other
Tcl routines accepting string values as arguments.
Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR.
Note that \fIupdateStringProc\fRs must allocate
enough storage for the string's bytes and the terminating null byte.
.PP
The \fIupdateStringProc\fR for Tcl's built-in double type, for example,
calls Tcl_PrintDouble to write to a buffer of size TCL_DOUBLE_SPACE,
then allocates and copies the string representation to just enough
space to hold it.  A pointer to the allocated space is stored in
the \fIbytes\fR member.
Changes to doc/OpenFileChnl.3.
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
.sp
int
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp
int
\fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
int
\fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR)
.sp
int
\fBTcl_Gets\fR(\fIchannel, lineRead\fR)
.sp
int
\fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR)
.sp
int
\fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR)
.sp
int
\fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR)
.sp
int
\fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
int
\fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
int
\fBTcl_WriteRaw\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
int
\fBTcl_Eof\fR(\fIchannel\fR)
.sp
int
\fBTcl_Flush\fR(\fIchannel\fR)







|


|


|


|


|


|


|


|







49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
.sp
int
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp
int
\fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
size_t
\fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR)
.sp
size_t
\fBTcl_Gets\fR(\fIchannel, lineRead\fR)
.sp
size_t
\fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR)
.sp
size_t
\fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR)
.sp
size_t
\fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR)
.sp
size_t
\fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
size_t
\fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
size_t
\fBTcl_WriteRaw\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
int
\fBTcl_Eof\fR(\fIchannel\fR)
.sp
int
\fBTcl_Flush\fR(\fIchannel\fR)
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
\fBTCL_ENFORCE_MODE\fR. If \fBTCL_STDIN\fR is set, stdin for the first child
in the pipe is the pipe channel, otherwise it is the same as the standard
input of the invoking process; likewise for \fBTCL_STDOUT\fR and
\fBTCL_STDERR\fR. If \fBTCL_ENFORCE_MODE\fR is not set, then the pipe can
redirect stdio handles to override the stdio handles for which
\fBTCL_STDIN\fR, \fBTCL_STDOUT\fR and \fBTCL_STDERR\fR have been set.  If it
is set, then such redirections cause an error.
.AP ClientData handle in
Operating system specific handle for I/O to a file. For Unix this is a
file descriptor, for Windows it is a HANDLE.
.AP int readOrWrite in
OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
what operations are valid on \fIhandle\fR.
.AP "const char" *channelName in
The name of the channel.
.AP int *modePtr out
Points at an integer variable that will receive an OR-ed combination of
\fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR denoting whether the channel is
open for reading and writing.
.AP "const char" *pattern in
The pattern to match on, passed to Tcl_StringMatch, or NULL.
.AP Tcl_Channel channel in
A Tcl channel for input or output.  Must have been the return value
from a procedure such as \fBTcl_OpenFileChannel\fR.
.AP Tcl_Obj *readObjPtr in/out
A pointer to a Tcl value in which to store the characters read from the
channel.
.AP int charsToRead in
The number of characters to read from the channel.  If the channel's encoding
is \fBbinary\fR, this is equivalent to the number of bytes to read from the
channel.
.AP int appendFlag in
If non-zero, data read from the channel will be appended to the value.
Otherwise, the data will replace the existing contents of the value.
.AP char *readBuf out
A buffer in which to store the bytes read from the channel.
.AP int bytesToRead in
The number of bytes to read from the channel.  The buffer \fIreadBuf\fR must
be large enough to hold this many bytes.
.AP Tcl_Obj *lineObjPtr in/out
A pointer to a Tcl value in which to store the line read from the
channel.  The line read will be appended to the current value of the
value.
.AP Tcl_DString *lineRead in/out
A pointer to a Tcl dynamic string in which to store the line read from the
channel.  Must have been initialized by the caller.  The line read will be
appended to any data already in the dynamic string.
.AP "const char" *input in
The input to add to a channel buffer.
.AP int inputLen in
Length of the input
.AP int addAtEnd in
Flag indicating whether the input should be added to the end or
beginning of the channel buffer.
.AP Tcl_Obj *writeObjPtr in
A pointer to a Tcl value whose contents will be output to the channel.
.AP "const char" *charBuf in
A buffer containing the characters to output to the channel.
.AP "const char" *byteBuf in
A buffer containing the bytes to output to the channel.
.AP int bytesToWrite in
The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and
output to the channel.
.AP Tcl_WideInt offset in
How far to move the access point in the channel at which the next input or
output operation will be applied, measured in bytes from the position
given by \fIseekMode\fR.  May be either positive or negative.
.AP int seekMode in







|



















|








|












|










|







130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
\fBTCL_ENFORCE_MODE\fR. If \fBTCL_STDIN\fR is set, stdin for the first child
in the pipe is the pipe channel, otherwise it is the same as the standard
input of the invoking process; likewise for \fBTCL_STDOUT\fR and
\fBTCL_STDERR\fR. If \fBTCL_ENFORCE_MODE\fR is not set, then the pipe can
redirect stdio handles to override the stdio handles for which
\fBTCL_STDIN\fR, \fBTCL_STDOUT\fR and \fBTCL_STDERR\fR have been set.  If it
is set, then such redirections cause an error.
.AP void *handle in
Operating system specific handle for I/O to a file. For Unix this is a
file descriptor, for Windows it is a HANDLE.
.AP int readOrWrite in
OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
what operations are valid on \fIhandle\fR.
.AP "const char" *channelName in
The name of the channel.
.AP int *modePtr out
Points at an integer variable that will receive an OR-ed combination of
\fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR denoting whether the channel is
open for reading and writing.
.AP "const char" *pattern in
The pattern to match on, passed to Tcl_StringMatch, or NULL.
.AP Tcl_Channel channel in
A Tcl channel for input or output.  Must have been the return value
from a procedure such as \fBTcl_OpenFileChannel\fR.
.AP Tcl_Obj *readObjPtr in/out
A pointer to a Tcl value in which to store the characters read from the
channel.
.AP size_t charsToRead in
The number of characters to read from the channel.  If the channel's encoding
is \fBbinary\fR, this is equivalent to the number of bytes to read from the
channel.
.AP int appendFlag in
If non-zero, data read from the channel will be appended to the value.
Otherwise, the data will replace the existing contents of the value.
.AP char *readBuf out
A buffer in which to store the bytes read from the channel.
.AP size_t bytesToRead in
The number of bytes to read from the channel.  The buffer \fIreadBuf\fR must
be large enough to hold this many bytes.
.AP Tcl_Obj *lineObjPtr in/out
A pointer to a Tcl value in which to store the line read from the
channel.  The line read will be appended to the current value of the
value.
.AP Tcl_DString *lineRead in/out
A pointer to a Tcl dynamic string in which to store the line read from the
channel.  Must have been initialized by the caller.  The line read will be
appended to any data already in the dynamic string.
.AP "const char" *input in
The input to add to a channel buffer.
.AP size_t inputLen in
Length of the input
.AP int addAtEnd in
Flag indicating whether the input should be added to the end or
beginning of the channel buffer.
.AP Tcl_Obj *writeObjPtr in
A pointer to a Tcl value whose contents will be output to the channel.
.AP "const char" *charBuf in
A buffer containing the characters to output to the channel.
.AP "const char" *byteBuf in
A buffer containing the bytes to output to the channel.
.AP size_t bytesToWrite in
The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and
output to the channel.
.AP Tcl_WideInt offset in
How far to move the access point in the channel at which the next input or
output operation will be applied, measured in bytes from the position
given by \fIseekMode\fR.  May be either positive or negative.
.AP int seekMode in
Changes to doc/OpenTcp.3.
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
for the local end of the connection.  If NULL, a default interface is
chosen.
.AP int async in
If nonzero, the client socket is connected asynchronously to the server.
.AP "unsigned int" flags in
ORed combination of \fBTCL_TCPSERVER\fR flags that specify additional
informations about the socket being created.
.AP ClientData sock in
Platform-specific handle for client TCP socket.
.AP Tcl_TcpAcceptProc *proc in
Pointer to a procedure to invoke each time a new connection is
accepted via the socket.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
These functions are convenience procedures for creating
channels that communicate over TCP sockets.
The operations on a channel







|




|







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
for the local end of the connection.  If NULL, a default interface is
chosen.
.AP int async in
If nonzero, the client socket is connected asynchronously to the server.
.AP "unsigned int" flags in
ORed combination of \fBTCL_TCPSERVER\fR flags that specify additional
informations about the socket being created.
.AP void *sock in
Platform-specific handle for client TCP socket.
.AP Tcl_TcpAcceptProc *proc in
Pointer to a procedure to invoke each time a new connection is
accepted via the socket.
.AP void *clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
These functions are convenience procedures for creating
channels that communicate over TCP sockets.
The operations on a channel
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
allow connections from any network interface.
Each time a client connects to this socket, Tcl creates a channel
for the new connection and invokes \fIproc\fR with information about
the channel. \fIProc\fR must match the following prototype:
.PP
.CS
typedef void \fBTcl_TcpAcceptProc\fR(
        ClientData \fIclientData\fR,
        Tcl_Channel \fIchannel\fR,
        char *\fIhostName\fR,
        int \fIport\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_OpenTcpServer\fR, \fIchannel\fR will be the handle







|







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
allow connections from any network interface.
Each time a client connects to this socket, Tcl creates a channel
for the new connection and invokes \fIproc\fR with information about
the channel. \fIProc\fR must match the following prototype:
.PP
.CS
typedef void \fBTcl_TcpAcceptProc\fR(
        void *\fIclientData\fR,
        Tcl_Channel \fIchannel\fR,
        char *\fIhostName\fR,
        int \fIport\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_OpenTcpServer\fR, \fIchannel\fR will be the handle
Changes to doc/ParseArgs.3.
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
stored in \fIremObjv\fR.
.AP "Tcl_Obj *const" *objv in
The array of arguments to be parsed.
.AP Tcl_Obj ***remObjv out
Pointer to a variable that will hold the array of unprocessed arguments.
Should be NULL if no return of unprocessed arguments is required. If
\fIobjcPtr\fR is updated to a non-zero value, the array returned through this
must be deallocated using \fBckfree\fR.
.BE
.SH DESCRIPTION
.PP
The \fBTcl_ParseArgsObjv\fR function provides a system for parsing argument
lists of the form
.QW "\fB\-someName \fIsomeValue\fR ..." .
Such argument lists are commonly found both in the arguments to a program and







|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
stored in \fIremObjv\fR.
.AP "Tcl_Obj *const" *objv in
The array of arguments to be parsed.
.AP Tcl_Obj ***remObjv out
Pointer to a variable that will hold the array of unprocessed arguments.
Should be NULL if no return of unprocessed arguments is required. If
\fIobjcPtr\fR is updated to a non-zero value, the array returned through this
must be deallocated using \fBTcl_Free\fR.
.BE
.SH DESCRIPTION
.PP
The \fBTcl_ParseArgsObjv\fR function provides a system for parsing argument
lists of the form
.QW "\fB\-someName \fIsomeValue\fR ..." .
Such argument lists are commonly found both in the arguments to a program and
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
.CS
typedef struct {
    int \fItype\fR;
    const char *\fIkeyStr\fR;
    void *\fIsrcPtr\fR;
    void *\fIdstPtr\fR;
    const char *\fIhelpStr\fR;
    ClientData \fIclientData\fR;
} \fBTcl_ArgvInfo\fR;
.CE
.PP
The \fIkeyStr\fR field contains the name of the option; by convention, this
will normally begin with a
.QW \fB\-\fR
character. The \fItype\fR, \fIsrcPtr\fR, \fIdstPtr\fR and \fIclientData\fR







|







80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
.CS
typedef struct {
    int \fItype\fR;
    const char *\fIkeyStr\fR;
    void *\fIsrcPtr\fR;
    void *\fIdstPtr\fR;
    const char *\fIhelpStr\fR;
    void *\fIclientData\fR;
} \fBTcl_ArgvInfo\fR;
.CE
.PP
The \fIkeyStr\fR field contains the name of the option; by convention, this
will normally begin with a
.QW \fB\-\fR
character. The \fItype\fR, \fIsrcPtr\fR, \fIdstPtr\fR and \fIclientData\fR
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
This argument optionally takes a following value argument; it is up to the
handler callback function passed in \fIsrcPtr\fR to decide. That function will
have the following signature:
.RS
.PP
.CS
typedef int (\fBTcl_ArgvFuncProc\fR)(
        ClientData \fIclientData\fR,
        Tcl_Obj *\fIobjPtr\fR,
        void *\fIdstPtr\fR);
.CE
.PP
The result is a boolean value indicating whether to consume the following
argument. The \fIclientData\fR is the value from the table entry, the
\fIobjPtr\fR is the value that represents the following argument or NULL if







|







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
This argument optionally takes a following value argument; it is up to the
handler callback function passed in \fIsrcPtr\fR to decide. That function will
have the following signature:
.RS
.PP
.CS
typedef int (\fBTcl_ArgvFuncProc\fR)(
        void *\fIclientData\fR,
        Tcl_Obj *\fIobjPtr\fR,
        void *\fIdstPtr\fR);
.CE
.PP
The result is a boolean value indicating whether to consume the following
argument. The \fIclientData\fR is the value from the table entry, the
\fIobjPtr\fR is the value that represents the following argument or NULL if
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
function passed in \fIsrcPtr\fR returns how many (or a negative number to
signal an error, in which case it should also set the interpreter result). The
function will have the following signature:
.RS
.PP
.CS
typedef int (\fBTcl_ArgvGenFuncProc\fR)(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIobjc\fR,
        Tcl_Obj *const *\fIobjv\fR,
        void *\fIdstPtr\fR);
.CE
.PP
The \fIclientData\fR is the value from the table entry, the \fIinterp\fR is







|







145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
function passed in \fIsrcPtr\fR returns how many (or a negative number to
signal an error, in which case it should also set the interpreter result). The
function will have the following signature:
.RS
.PP
.CS
typedef int (\fBTcl_ArgvGenFuncProc\fR)(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIobjc\fR,
        Tcl_Obj *const *\fIobjv\fR,
        void *\fIdstPtr\fR);
.CE
.PP
The \fIclientData\fR is the value from the table entry, the \fIinterp\fR is
Changes to doc/ParseCmd.3.
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
    int \fInumTokens\fR;
    ...
} \fBTcl_Parse\fR;

typedef struct Tcl_Token {
    int \fItype\fR;
    const char *\fIstart\fR;
    int \fIsize\fR;
    int \fInumComponents\fR;
} \fBTcl_Token\fR;
.CE
.PP
The first five fields of a Tcl_Parse structure
are filled in only by \fBTcl_ParseCommand\fR.
These fields are not used by the other parsing procedures.
.PP







|
|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
    int \fInumTokens\fR;
    ...
} \fBTcl_Parse\fR;

typedef struct Tcl_Token {
    int \fItype\fR;
    const char *\fIstart\fR;
    size_t \fIsize\fR;
    size_t \fInumComponents\fR;
} \fBTcl_Token\fR;
.CE
.PP
The first five fields of a Tcl_Parse structure
are filled in only by \fBTcl_ParseCommand\fR.
These fields are not used by the other parsing procedures.
.PP
Changes to doc/Preserve.3.
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
\fBTcl_Preserve\fR(\fIclientData\fR)
.sp
\fBTcl_Release\fR(\fIclientData\fR)
.sp
\fBTcl_EventuallyFree\fR(\fIclientData, freeProc\fR)
.SH ARGUMENTS
.AS Tcl_FreeProc clientData
.AP ClientData clientData in
Token describing structure to be freed or reallocated.  Usually a pointer
to memory for structure.
.AP Tcl_FreeProc *freeProc in
Procedure to invoke to free \fIclientData\fR.
.BE
.SH DESCRIPTION
.PP







|







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
\fBTcl_Preserve\fR(\fIclientData\fR)
.sp
\fBTcl_Release\fR(\fIclientData\fR)
.sp
\fBTcl_EventuallyFree\fR(\fIclientData, freeProc\fR)
.SH ARGUMENTS
.AS Tcl_FreeProc clientData
.AP void *clientData in
Token describing structure to be freed or reallocated.  Usually a pointer
to memory for structure.
.AP Tcl_FreeProc *freeProc in
Procedure to invoke to free \fIclientData\fR.
.BE
.SH DESCRIPTION
.PP
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
same as the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR.
The type of \fIblockPtr\fR (\fBchar *\fR) is different than the type of the
\fIclientData\fR argument to \fBTcl_EventuallyFree\fR for historical
reasons, but the value is the same.
.PP
When the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR
refers to storage allocated and returned by a prior call to
\fBTcl_Alloc\fR, \fBckalloc\fR, or another function of the Tcl library,
then the \fIfreeProc\fR argument should be given the special value of
\fBTCL_DYNAMIC\fR.
.PP
This mechanism can be used to solve the problem described above
by placing \fBTcl_Preserve\fR and \fBTcl_Release\fR calls around
actions that may cause undesired storage re-allocation.  The
mechanism is intended only for short-term use (i.e. while procedures







|







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
same as the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR.
The type of \fIblockPtr\fR (\fBchar *\fR) is different than the type of the
\fIclientData\fR argument to \fBTcl_EventuallyFree\fR for historical
reasons, but the value is the same.
.PP
When the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR
refers to storage allocated and returned by a prior call to
\fBTcl_Alloc\fR or another function of the Tcl library,
then the \fIfreeProc\fR argument should be given the special value of
\fBTCL_DYNAMIC\fR.
.PP
This mechanism can be used to solve the problem described above
by placing \fBTcl_Preserve\fR and \fBTcl_Release\fR calls around
actions that may cause undesired storage re-allocation.  The
mechanism is intended only for short-term use (i.e. while procedures
Changes to doc/SaveResult.3.
1
2
3
4
5
6
7
8
9
10
11
'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
'\" Copyright (c) 2018 Nathan Coulter. 
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS



|







1
2
3
4
5
6
7
8
9
10
11
'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
'\" Copyright (c) 2018 Nathan Coulter.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
Changes to doc/SplitList.3.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
.sp
int
\fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR)
.sp
char *
\fBTcl_Merge\fR(\fIargc, argv\fR)
.sp
int
\fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR)
.sp
int
\fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR)
.sp
int
\fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR)
.sp
int
\fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR)
.SH ARGUMENTS
.AS "const char *const" ***argvPtr out
.AP Tcl_Interp *interp out
Interpreter to use for error reporting.  If NULL, then no error message
is left.
.AP char *list in







|


|


|


|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
.sp
int
\fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR)
.sp
char *
\fBTcl_Merge\fR(\fIargc, argv\fR)
.sp
size_t
\fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR)
.sp
size_t
\fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR)
.sp
size_t
\fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR)
.sp
size_t
\fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR)
.SH ARGUMENTS
.AS "const char *const" ***argvPtr out
.AP Tcl_Interp *interp out
Interpreter to use for error reporting.  If NULL, then no error message
is left.
.AP char *list in
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Array of strings to merge together into a single list.
Each string will become a separate element of the list.
.AP "const char" *src in
String that is to become an element of a list.
.AP int *flagsPtr in
Pointer to word to fill in with information about \fIsrc\fR.
The value of *\fIflagsPtr\fR must be passed to \fBTcl_ConvertElement\fR.
.AP int length in
Number of bytes in string \fIsrc\fR.
.AP char *dst in
Place to copy converted list element.  Must contain enough characters
to hold converted string.
.AP int flags in
Information about \fIsrc\fR. Must be value returned by previous
call to \fBTcl_ScanElement\fR, possibly OR-ed







|







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Array of strings to merge together into a single list.
Each string will become a separate element of the list.
.AP "const char" *src in
String that is to become an element of a list.
.AP int *flagsPtr in
Pointer to word to fill in with information about \fIsrc\fR.
The value of *\fIflagsPtr\fR must be passed to \fBTcl_ConvertElement\fR.
.AP size_t length in
Number of bytes in string \fIsrc\fR.
.AP char *dst in
Place to copy converted list element.  Must contain enough characters
to hold converted string.
.AP int flags in
Information about \fIsrc\fR. Must be value returned by previous
call to \fBTcl_ScanElement\fR, possibly OR-ed
Changes to doc/StringObj.3.
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
\fBTcl_ConcatObj\fR(\fIobjc, objv\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *appendObjPtr in/out
.AP "const char" *bytes in
Points to the first byte of an array of UTF-8-encoded bytes
used to set or append to a string value.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.  (Applications needing null bytes
should represent them as the two-byte sequence \fI\e700\e600\fR, use
\fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if
the string is a collection of uninterpreted bytes.)
.AP int length in
The number of bytes to copy from \fIbytes\fR when
initializing, setting, or appending to a string value.
If negative, all bytes up to the first null are used.
.AP "const Tcl_UniChar" *unicode in
Points to the first byte of an array of Unicode characters
used to set or append to a string value.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.
.AP int numChars in
The number of Unicode characters to copy from \fIunicode\fR when
initializing, setting, or appending to a string value.
If negative, all characters up to the first null character are used.
.AP int index in
The index of the Unicode character to return.
.AP int first in
The index of the first Unicode character in the Unicode range to be
returned as a new value.
.AP int last in
The index of the last Unicode character in the Unicode range to be
returned as a new value.
.AP Tcl_Obj *objPtr in/out
Points to a value to manipulate.
.AP Tcl_Obj *appendObjPtr in
The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
.AP int *lengthPtr out
If non-NULL, the location where \fBTcl_GetStringFromObj\fR will store
the length of a value's string representation.
.AP "const char" *string in
Null-terminated string value to append to \fIobjPtr\fR.
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
.AP int limit in
Maximum number of bytes to be appended.
.AP "const char" *ellipsis in
Suffix to append when the limit leads to string truncation.
If NULL is passed then the suffix
.QW "..."
is used.
.AP "const char" *format in
Format control string including % conversion specifiers.
.AP int objc in
The number of elements to format or concatenate.
.AP Tcl_Obj *objv[] in
The array of values to format or concatenate.
.AP int newLength in
New length for the string value of \fIobjPtr\fR, not including the
final null character.
.BE
.SH DESCRIPTION
.PP
The procedures described in this manual entry allow Tcl values to
be manipulated as string values.  They use the internal representation







|



|


|





|


|
|

|


|














|












|







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
\fBTcl_ConcatObj\fR(\fIobjc, objv\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *appendObjPtr in/out
.AP "const char" *bytes in
Points to the first byte of an array of UTF-8-encoded bytes
used to set or append to a string value.
This byte array may contain embedded null characters
unless \fInumChars\fR is (size_t)-1.  (Applications needing null bytes
should represent them as the two-byte sequence \fI\e700\e600\fR, use
\fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if
the string is a collection of uninterpreted bytes.)
.AP size_t length in
The number of bytes to copy from \fIbytes\fR when
initializing, setting, or appending to a string value.
If (size_t)-1, all bytes up to the first null are used.
.AP "const Tcl_UniChar" *unicode in
Points to the first byte of an array of Unicode characters
used to set or append to a string value.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.
.AP size_t numChars in
The number of Unicode characters to copy from \fIunicode\fR when
initializing, setting, or appending to a string value.
If (size_t)-1, all characters up to the first null character are used.
.AP size_t index in
The index of the Unicode character to return.
.AP size_t first in
The index of the first Unicode character in the Unicode range to be
returned as a new value.
.AP size_t last in
The index of the last Unicode character in the Unicode range to be
returned as a new value.
.AP Tcl_Obj *objPtr in/out
Points to a value to manipulate.
.AP Tcl_Obj *appendObjPtr in
The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
.AP int *lengthPtr out
If non-NULL, the location where \fBTcl_GetStringFromObj\fR will store
the length of a value's string representation.
.AP "const char" *string in
Null-terminated string value to append to \fIobjPtr\fR.
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
.AP size_t limit in
Maximum number of bytes to be appended.
.AP "const char" *ellipsis in
Suffix to append when the limit leads to string truncation.
If NULL is passed then the suffix
.QW "..."
is used.
.AP "const char" *format in
Format control string including % conversion specifiers.
.AP int objc in
The number of elements to format or concatenate.
.AP Tcl_Obj *objv[] in
The array of values to format or concatenate.
.AP size_t newLength in
New length for the string value of \fIobjPtr\fR, not including the
final null character.
.BE
.SH DESCRIPTION
.PP
The procedures described in this manual entry allow Tcl values to
be manipulated as string values.  They use the internal representation
Changes to doc/TCL_MEM_DEBUG.3.
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
.PP
Once memory debugging support has been compiled into Tcl, the C
functions \fBTcl_ValidateAllMemory\fR, and \fBTcl_DumpActiveMemory\fR,
and the Tcl \fBmemory\fR command can be used to validate and examine
memory usage.
.SH "GUARD ZONES"
.PP
When memory debugging is enabled, whenever a call to \fBckalloc\fR is
made, slightly more memory than requested is allocated so the memory
debugging code can keep track of the allocated memory, and eight-byte
.QW "guard zones"
are placed in front of and behind the space that will be
returned to the caller.  (The sizes of the guard zones are defined by the
C #define \fBLOW_GUARD_SIZE\fR and #define \fBHIGH_GUARD_SIZE\fR
in the file \fIgeneric/tclCkalloc.c\fR \(em it can
be extended if you suspect large overwrite problems, at some cost in
performance.)  A known pattern is written into the guard zones and, on
a call to \fBckfree\fR, the guard zones of the space being freed are
checked to see if either zone has been modified in any way.  If one
has been, the guard bytes and their new contents are identified, and a
.QW "low guard failed"
or
.QW "high guard failed"
message is issued.  The
.QW "guard failed"
message includes the address of the memory packet and
the file name and line number of the code that called \fBckfree\fR.
This allows you to detect the common sorts of one-off problems, where
not enough space was allocated to contain the data written, for
example.
.SH "DEBUGGING DIFFICULT MEMORY CORRUPTION PROBLEMS"
.PP
Normally, Tcl compiled with memory debugging enabled will make it easy
to isolate a corruption problem.  Turning on memory validation with
the memory command can help isolate difficult problems.  If you
suspect (or know) that corruption is occurring before the Tcl
interpreter comes up far enough for you to issue commands, you can set
\fBMEM_VALIDATE\fR define, recompile tclCkalloc.c and rebuild Tcl.
This will enable memory validation from the first call to
\fBckalloc\fR, again, at a large performance impact.
.PP
If you are desperate and validating memory on every call to
\fBckalloc\fR and \fBckfree\fR is not enough, you can explicitly call
\fBTcl_ValidateAllMemory\fR directly at any point.  It takes a \fIchar
*\fR and an \fIint\fR which are normally the filename and line number
of the caller, but they can actually be anything you want.  Remember
to remove the calls after you find the problem.
.SH "SEE ALSO"
ckalloc, memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory
.SH KEYWORDS
memory, debug







|









|








|












|


|





|


30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
.PP
Once memory debugging support has been compiled into Tcl, the C
functions \fBTcl_ValidateAllMemory\fR, and \fBTcl_DumpActiveMemory\fR,
and the Tcl \fBmemory\fR command can be used to validate and examine
memory usage.
.SH "GUARD ZONES"
.PP
When memory debugging is enabled, whenever a call to \fBTcl_Alloc\fR is
made, slightly more memory than requested is allocated so the memory
debugging code can keep track of the allocated memory, and eight-byte
.QW "guard zones"
are placed in front of and behind the space that will be
returned to the caller.  (The sizes of the guard zones are defined by the
C #define \fBLOW_GUARD_SIZE\fR and #define \fBHIGH_GUARD_SIZE\fR
in the file \fIgeneric/tclCkalloc.c\fR \(em it can
be extended if you suspect large overwrite problems, at some cost in
performance.)  A known pattern is written into the guard zones and, on
a call to \fBTcl_Free\fR, the guard zones of the space being freed are
checked to see if either zone has been modified in any way.  If one
has been, the guard bytes and their new contents are identified, and a
.QW "low guard failed"
or
.QW "high guard failed"
message is issued.  The
.QW "guard failed"
message includes the address of the memory packet and
the file name and line number of the code that called \fBTcl_Free\fR.
This allows you to detect the common sorts of one-off problems, where
not enough space was allocated to contain the data written, for
example.
.SH "DEBUGGING DIFFICULT MEMORY CORRUPTION PROBLEMS"
.PP
Normally, Tcl compiled with memory debugging enabled will make it easy
to isolate a corruption problem.  Turning on memory validation with
the memory command can help isolate difficult problems.  If you
suspect (or know) that corruption is occurring before the Tcl
interpreter comes up far enough for you to issue commands, you can set
\fBMEM_VALIDATE\fR define, recompile tclCkalloc.c and rebuild Tcl.
This will enable memory validation from the first call to
\fBTcl_Alloc\fR, again, at a large performance impact.
.PP
If you are desperate and validating memory on every call to
\fBTcl_Alloc\fR and \fBTcl_Free\fR is not enough, you can explicitly call
\fBTcl_ValidateAllMemory\fR directly at any point.  It takes a \fIchar
*\fR and an \fIint\fR which are normally the filename and line number
of the caller, but they can actually be anything you want.  Remember
to remove the calls after you find the problem.
.SH "SEE ALSO"
Tcl_Alloc, memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory
.SH KEYWORDS
memory, debug
Changes to doc/TclZlib.3.
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
section \fBGZIP OPTIONS DICTIONARY\fR for details about the contents of this
dictionary.
.AP "unsigned int" initValue in
The initial value for the checksum algorithm.
.AP "unsigned char" *bytes in
An array of bytes to run the checksum algorithm over, or NULL to get the
recommended initial value for the checksum algorithm.
.AP int length in
The number of bytes in the array.
.AP int mode in
What mode to operate the stream in. Should be either
\fBTCL_ZLIB_STREAM_DEFLATE\fR for a compressing stream or
\fBTCL_ZLIB_STREAM_INFLATE\fR for a decompressing stream.
.AP Tcl_ZlibStream *zshandlePtr out
A pointer to a variable in which to write the abstract token for the stream
upon successful creation.
.AP Tcl_ZlibStream zshandle in
The abstract token for the stream to operate on.
.AP int flush in
Whether and how to flush the stream after writing the data to it. Must be one
of: \fBTCL_ZLIB_NO_FLUSH\fR if no flushing is to be done, \fBTCL_ZLIB_FLUSH\fR
if the currently compressed data must be made available for access using
\fBTcl_ZlibStreamGet\fR, \fBTCL_ZLIB_FULLFLUSH\fR if the stream must be put
into a state where the decompressor can recover from on corruption, or
\fBTCL_ZLIB_FINALIZE\fR to ensure that the stream is finished and that any
trailer demanded by the format is written.
.AP int count in
The maximum number of bytes to get from the stream, or -1 to get all remaining
bytes from the stream's buffers.
.AP Tcl_Obj *compDict in
A byte array value that is the compression dictionary to use with the stream.
Note that this is \fInot a Tcl dictionary\fR, and it is recommended that this
only ever be used with streams that were created with their \fIformat\fR set
to \fBTCL_ZLIB_FORMAT_ZLIB\fR because the other formats have no mechanism to
indicate whether a compression dictionary was present other than to fail on







|


















|
|







84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
section \fBGZIP OPTIONS DICTIONARY\fR for details about the contents of this
dictionary.
.AP "unsigned int" initValue in
The initial value for the checksum algorithm.
.AP "unsigned char" *bytes in
An array of bytes to run the checksum algorithm over, or NULL to get the
recommended initial value for the checksum algorithm.
.AP size_t length in
The number of bytes in the array.
.AP int mode in
What mode to operate the stream in. Should be either
\fBTCL_ZLIB_STREAM_DEFLATE\fR for a compressing stream or
\fBTCL_ZLIB_STREAM_INFLATE\fR for a decompressing stream.
.AP Tcl_ZlibStream *zshandlePtr out
A pointer to a variable in which to write the abstract token for the stream
upon successful creation.
.AP Tcl_ZlibStream zshandle in
The abstract token for the stream to operate on.
.AP int flush in
Whether and how to flush the stream after writing the data to it. Must be one
of: \fBTCL_ZLIB_NO_FLUSH\fR if no flushing is to be done, \fBTCL_ZLIB_FLUSH\fR
if the currently compressed data must be made available for access using
\fBTcl_ZlibStreamGet\fR, \fBTCL_ZLIB_FULLFLUSH\fR if the stream must be put
into a state where the decompressor can recover from on corruption, or
\fBTCL_ZLIB_FINALIZE\fR to ensure that the stream is finished and that any
trailer demanded by the format is written.
.AP size_t count in
The maximum number of bytes to get from the stream, or (size_t)-1 to get all remaining
bytes from the stream's buffers.
.AP Tcl_Obj *compDict in
A byte array value that is the compression dictionary to use with the stream.
Note that this is \fInot a Tcl dictionary\fR, and it is recommended that this
only ever be used with streams that were created with their \fIformat\fR set
to \fBTCL_ZLIB_FORMAT_ZLIB\fR because the other formats have no mechanism to
indicate whether a compression dictionary was present other than to fail on
Changes to doc/Thread.3.
41
42
43
44
45
46
47

48

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
int
\fBTcl_JoinThread\fR(\fIid, result\fR)
.SH ARGUMENTS
.AS Tcl_CreateThreadProc proc out
.AP Tcl_Condition *condPtr in
A condition variable, which must be associated with a mutex lock.
.AP Tcl_Mutex *mutexPtr in

A mutex lock.

.AP "const Tcl_Time" *timePtr in
A time limit on the condition wait.  NULL to wait forever.
Note that a polling value of 0 seconds does not make much sense.
.AP Tcl_ThreadDataKey *keyPtr in
This identifies a block of thread local storage.  The key should be
static and process-wide, yet each thread will end up associating
a different block of storage with this key.
.AP int *size in
The size of the thread local storage block.  This amount of data
is allocated and initialized to zero the first time each thread
calls \fBTcl_GetThreadData\fR.
.AP Tcl_ThreadId *idPtr out
The referred storage will contain the id of the newly created thread as
returned by the operating system.
.AP Tcl_ThreadId id in
Id of the thread waited upon.
.AP Tcl_ThreadCreateProc *proc in
This procedure will act as the \fBmain()\fR of the newly created
thread. The specified \fIclientData\fR will be its sole argument.
.AP ClientData clientData in
Arbitrary information. Passed as sole argument to the \fIproc\fR.
.AP int stackSize in
The size of the stack given to the new thread.
.AP int flags in
Bitmask containing flags allowing the caller to modify behavior of
the new thread.
.AP int *result out







>
|
>



















|







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
int
\fBTcl_JoinThread\fR(\fIid, result\fR)
.SH ARGUMENTS
.AS Tcl_CreateThreadProc proc out
.AP Tcl_Condition *condPtr in
A condition variable, which must be associated with a mutex lock.
.AP Tcl_Mutex *mutexPtr in
.VS TIP509
A recursive mutex lock.
.VE TIP509
.AP "const Tcl_Time" *timePtr in
A time limit on the condition wait.  NULL to wait forever.
Note that a polling value of 0 seconds does not make much sense.
.AP Tcl_ThreadDataKey *keyPtr in
This identifies a block of thread local storage.  The key should be
static and process-wide, yet each thread will end up associating
a different block of storage with this key.
.AP int *size in
The size of the thread local storage block.  This amount of data
is allocated and initialized to zero the first time each thread
calls \fBTcl_GetThreadData\fR.
.AP Tcl_ThreadId *idPtr out
The referred storage will contain the id of the newly created thread as
returned by the operating system.
.AP Tcl_ThreadId id in
Id of the thread waited upon.
.AP Tcl_ThreadCreateProc *proc in
This procedure will act as the \fBmain()\fR of the newly created
thread. The specified \fIclientData\fR will be its sole argument.
.AP void *clientData in
Arbitrary information. Passed as sole argument to the \fIproc\fR.
.AP int stackSize in
The size of the stack given to the new thread.
.AP int flags in
Bitmask containing flags allowing the caller to modify behavior of
the new thread.
.AP int *result out
136
137
138
139
140
141
142

143
144




145
146
147
148
149
150
151
the \fBNotifier\fR manual page for more information on these procedures.
.PP
A mutex is a lock that is used to serialize all threads through a piece
of code by calling \fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\fR.
If one thread holds a mutex, any other thread calling \fBTcl_MutexLock\fR will
block until \fBTcl_MutexUnlock\fR is called.
A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR.

The result of locking a mutex twice from the same thread is undefined.
On some platforms it will result in a deadlock.




The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR and \fBTcl_MutexFinalize\fR
procedures are defined as empty macros if not compiling with threads enabled.
For declaration of mutexes the \fBTCL_DECLARE_MUTEX\fR macro should be used.
This macro assures correct mutex handling even when the core is compiled
without threads enabled.
.PP
A condition variable is used as a signaling mechanism:







>
|
<
>
>
>
>







138
139
140
141
142
143
144
145
146

147
148
149
150
151
152
153
154
155
156
157
the \fBNotifier\fR manual page for more information on these procedures.
.PP
A mutex is a lock that is used to serialize all threads through a piece
of code by calling \fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\fR.
If one thread holds a mutex, any other thread calling \fBTcl_MutexLock\fR will
block until \fBTcl_MutexUnlock\fR is called.
A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR.
.VS TIP509
Mutexes are reentrant: they can be locked several times from the same

thread. However there must be exactly one call to
\fBTcl_MutexUnlock\fR for each call to \fBTcl_MutexLock\fR in order
for a thread to release a mutex completely.
.VE TIP509
The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR and \fBTcl_MutexFinalize\fR
procedures are defined as empty macros if not compiling with threads enabled.
For declaration of mutexes the \fBTCL_DECLARE_MUTEX\fR macro should be used.
This macro assures correct mutex handling even when the core is compiled
without threads enabled.
.PP
A condition variable is used as a signaling mechanism:
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
.PP
It should then be defined like this example, which just counts up to a given
value and then finishes.
.PP
.CS
static \fBTcl_ThreadCreateType\fR
MyThreadImplFunc(
    ClientData clientData)
{
    int i, limit = (int) clientData;
    for (i=0 ; i<limit ; i++) {
        /* doing nothing at all here */
    }
    \fBTCL_THREAD_CREATE_RETURN\fR;
}
.CE
.PP
To create the above thread, make it execute, and wait for it to finish, we
would do this:
.PP
.CS
int limit = 1000000000;
ClientData limitData = (void*)((intptr_t) limit);
Tcl_ThreadId id;    \fI/* holds identity of thread created */\fR
int result;

if (\fBTcl_CreateThread\fR(&id, MyThreadImplFunc, limitData,
        \fBTCL_THREAD_STACK_DEFAULT\fR,
        \fBTCL_THREAD_JOINABLE\fR) != TCL_OK) {
    \fI/* Thread did not create correctly */\fR







|














|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
.PP
It should then be defined like this example, which just counts up to a given
value and then finishes.
.PP
.CS
static \fBTcl_ThreadCreateType\fR
MyThreadImplFunc(
    void *clientData)
{
    int i, limit = (int) clientData;
    for (i=0 ; i<limit ; i++) {
        /* doing nothing at all here */
    }
    \fBTCL_THREAD_CREATE_RETURN\fR;
}
.CE
.PP
To create the above thread, make it execute, and wait for it to finish, we
would do this:
.PP
.CS
int limit = 1000000000;
void *limitData = (void*)((intptr_t) limit);
Tcl_ThreadId id;    \fI/* holds identity of thread created */\fR
int result;

if (\fBTcl_CreateThread\fR(&id, MyThreadImplFunc, limitData,
        \fBTCL_THREAD_STACK_DEFAULT\fR,
        \fBTCL_THREAD_JOINABLE\fR) != TCL_OK) {
    \fI/* Thread did not create correctly */\fR
Changes to doc/TraceCmd.3.
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
.BS
.SH NAME
Tcl_CommandTraceInfo, Tcl_TraceCommand, Tcl_UntraceCommand \- monitor renames and deletes of a command
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
ClientData
\fBTcl_CommandTraceInfo(\fIinterp, cmdName, flags, proc, prevClientData\fB)\fR
.sp
int
\fBTcl_TraceCommand(\fIinterp, cmdName, flags, proc, clientData\fB)\fR
.sp
void
\fBTcl_UntraceCommand(\fIinterp, cmdName, flags, proc, clientData\fB)\fR
.SH ARGUMENTS
.AS Tcl_CommandTraceProc prevClientData
.AP Tcl_Interp *interp in
Interpreter containing the command.
.AP "const char" *cmdName in
Name of command.
.AP int flags in
OR'ed collection of the values \fBTCL_TRACE_RENAME\fR and
\fBTCL_TRACE_DELETE\fR.
.AP Tcl_CommandTraceProc *proc in
Procedure to call when specified operations occur to \fIcmdName\fR.
.AP ClientData clientData in
Arbitrary argument to pass to \fIproc\fR.
.AP ClientData prevClientData in
If non-NULL, gives last value returned by \fBTcl_CommandTraceInfo\fR,
so this call will return information about next trace.  If NULL, this
call will return information about first trace.
.BE
.SH DESCRIPTION
.PP
\fBTcl_TraceCommand\fR allows a C procedure to monitor operations







|


















|

|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
.BS
.SH NAME
Tcl_CommandTraceInfo, Tcl_TraceCommand, Tcl_UntraceCommand \- monitor renames and deletes of a command
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void *
\fBTcl_CommandTraceInfo(\fIinterp, cmdName, flags, proc, prevClientData\fB)\fR
.sp
int
\fBTcl_TraceCommand(\fIinterp, cmdName, flags, proc, clientData\fB)\fR
.sp
void
\fBTcl_UntraceCommand(\fIinterp, cmdName, flags, proc, clientData\fB)\fR
.SH ARGUMENTS
.AS Tcl_CommandTraceProc prevClientData
.AP Tcl_Interp *interp in
Interpreter containing the command.
.AP "const char" *cmdName in
Name of command.
.AP int flags in
OR'ed collection of the values \fBTCL_TRACE_RENAME\fR and
\fBTCL_TRACE_DELETE\fR.
.AP Tcl_CommandTraceProc *proc in
Procedure to call when specified operations occur to \fIcmdName\fR.
.AP void *clientData in
Arbitrary argument to pass to \fIproc\fR.
.AP void *prevClientData in
If non-NULL, gives last value returned by \fBTcl_CommandTraceInfo\fR,
so this call will return information about next trace.  If NULL, this
call will return information about first trace.
.BE
.SH DESCRIPTION
.PP
\fBTcl_TraceCommand\fR allows a C procedure to monitor operations
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
.PP
Whenever one of the specified operations occurs to the command,
\fIproc\fR will be invoked.  It should have arguments and result that
match the type \fBTcl_CommandTraceProc\fR:
.PP
.CS
typedef void \fBTcl_CommandTraceProc\fR(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        const char *\fIoldName\fR,
        const char *\fInewName\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters will have the same
values as those passed to \fBTcl_TraceCommand\fR when the trace was
created.  \fIClientData\fR typically points to an application-specific
data structure that describes what to do when \fIproc\fR is invoked.
\fIOldName\fR gives the name of the command being renamed, and
\fInewName\fR gives the name that the command is being renamed to (or
NULL when the command is being deleted.)
\fIFlags\fR is an OR'ed combination of bits potentially providing
several pieces of information.  One of the bits \fBTCL_TRACE_RENAME\fR and
\fBTCL_TRACE_DELETE\fR will be set in \fIflags\fR to indicate which







|








|







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
.PP
Whenever one of the specified operations occurs to the command,
\fIproc\fR will be invoked.  It should have arguments and result that
match the type \fBTcl_CommandTraceProc\fR:
.PP
.CS
typedef void \fBTcl_CommandTraceProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        const char *\fIoldName\fR,
        const char *\fInewName\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters will have the same
values as those passed to \fBTcl_TraceCommand\fR when the trace was
created.  \fIclientData\fR typically points to an application-specific
data structure that describes what to do when \fIproc\fR is invoked.
\fIOldName\fR gives the name of the command being renamed, and
\fInewName\fR gives the name that the command is being renamed to (or
NULL when the command is being deleted.)
\fIFlags\fR is an OR'ed combination of bits potentially providing
several pieces of information.  One of the bits \fBTCL_TRACE_RENAME\fR and
\fBTCL_TRACE_DELETE\fR will be set in \fIflags\fR to indicate which
Changes to doc/TraceVar.3.
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
int
\fBTcl_TraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR
.sp
\fBTcl_UntraceVar(\fIinterp, varName, flags, proc, clientData\fB)\fR
.sp
\fBTcl_UntraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR
.sp
ClientData
\fBTcl_VarTraceInfo(\fIinterp, varName, flags, proc, prevClientData\fB)\fR
.sp
ClientData
\fBTcl_VarTraceInfo2(\fIinterp, name1, name2, flags, proc, prevClientData\fB)\fR
.SH ARGUMENTS
.AS Tcl_VarTraceProc prevClientData
.AP Tcl_Interp *interp in
Interpreter containing variable.
.AP "const char" *varName in
Name of variable.  May refer to a scalar variable, to
an array variable with no index, or to an array variable
with a parenthesized index.
.AP int flags in
OR-ed combination of the values \fBTCL_TRACE_READS\fR,
\fBTCL_TRACE_WRITES\fR, \fBTCL_TRACE_UNSETS\fR, \fBTCL_TRACE_ARRAY\fR,
\fBTCL_GLOBAL_ONLY\fR, \fBTCL_NAMESPACE_ONLY\fR,
\fBTCL_TRACE_RESULT_DYNAMIC\fR and \fBTCL_TRACE_RESULT_OBJECT\fR.
Not all flags are used by all
procedures.  See below for more information.
.AP Tcl_VarTraceProc *proc in
Procedure to invoke whenever one of the traced operations occurs.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.AP "const char" *name1 in
Name of scalar or array variable (without array index).
.AP "const char" *name2 in
For a trace on an element of an array, gives the index of the
element.  For traces on scalar variables or on whole arrays,
is NULL.
.AP ClientData prevClientData in
If non-NULL, gives last value returned by \fBTcl_VarTraceInfo\fR or
\fBTcl_VarTraceInfo2\fR, so this call will return information about
next trace.  If NULL, this call will return information about first
trace.
.BE
.SH DESCRIPTION
.PP







|


|


|















|







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
int
\fBTcl_TraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR
.sp
\fBTcl_UntraceVar(\fIinterp, varName, flags, proc, clientData\fB)\fR
.sp
\fBTcl_UntraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR
.sp
void *
\fBTcl_VarTraceInfo(\fIinterp, varName, flags, proc, prevClientData\fB)\fR
.sp
void *
\fBTcl_VarTraceInfo2(\fIinterp, name1, name2, flags, proc, prevClientData\fB)\fR
.SH ARGUMENTS
.AS void *prevClientData
.AP Tcl_Interp *interp in
Interpreter containing variable.
.AP "const char" *varName in
Name of variable.  May refer to a scalar variable, to
an array variable with no index, or to an array variable
with a parenthesized index.
.AP int flags in
OR-ed combination of the values \fBTCL_TRACE_READS\fR,
\fBTCL_TRACE_WRITES\fR, \fBTCL_TRACE_UNSETS\fR, \fBTCL_TRACE_ARRAY\fR,
\fBTCL_GLOBAL_ONLY\fR, \fBTCL_NAMESPACE_ONLY\fR,
\fBTCL_TRACE_RESULT_DYNAMIC\fR and \fBTCL_TRACE_RESULT_OBJECT\fR.
Not all flags are used by all
procedures.  See below for more information.
.AP Tcl_VarTraceProc *proc in
Procedure to invoke whenever one of the traced operations occurs.
.AP void *clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.AP "const char" *name1 in
Name of scalar or array variable (without array index).
.AP "const char" *name2 in
For a trace on an element of an array, gives the index of the
element.  For traces on scalar variables or on whole arrays,
is NULL.
.AP void *prevClientData in
If non-NULL, gives last value returned by \fBTcl_VarTraceInfo\fR or
\fBTcl_VarTraceInfo2\fR, so this call will return information about
next trace.  If NULL, this call will return information about first
trace.
.BE
.SH DESCRIPTION
.PP
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
This gives the trace procedure a chance to update the array before
array names or array get is called.  Note that this is called
before an array set, but that will trigger write traces.
.TP
\fBTCL_TRACE_RESULT_DYNAMIC\fR
The result of invoking the \fIproc\fR is a dynamically allocated
string that will be released by the Tcl library via a call to
\fBckfree\fR.  Must not be specified at the same time as
\fBTCL_TRACE_RESULT_OBJECT\fR.
.TP
\fBTCL_TRACE_RESULT_OBJECT\fR
The result of invoking the \fIproc\fR is a Tcl_Obj* (cast to a char*)
with a reference count of at least one.  The ownership of that
reference will be transferred to the Tcl core for release (when the
core has finished with it) via a call to \fBTcl_DecrRefCount\fR.  Must
not be specified at the same time as \fBTCL_TRACE_RESULT_DYNAMIC\fR.
.PP
Whenever one of the specified operations occurs on the variable,
\fIproc\fR will be invoked.
It should have arguments and result that match the type
\fBTcl_VarTraceProc\fR:
.PP
.CS
typedef char *\fBTcl_VarTraceProc\fR(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        char *\fIname1\fR,
        char *\fIname2\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters will
have the same values as those passed to \fBTcl_TraceVar\fR when the
trace was created.
\fIClientData\fR typically points to an application-specific
data structure that describes what to do when \fIproc\fR
is invoked.
\fIName1\fR and \fIname2\fR give the name of the traced variable
in the normal two-part form (see the description of \fBTcl_TraceVar2\fR
below for details).
\fIFlags\fR is an OR-ed combination of bits providing several
pieces of information.







|
















|









|







103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
This gives the trace procedure a chance to update the array before
array names or array get is called.  Note that this is called
before an array set, but that will trigger write traces.
.TP
\fBTCL_TRACE_RESULT_DYNAMIC\fR
The result of invoking the \fIproc\fR is a dynamically allocated
string that will be released by the Tcl library via a call to
\fBTcl_Free\fR.  Must not be specified at the same time as
\fBTCL_TRACE_RESULT_OBJECT\fR.
.TP
\fBTCL_TRACE_RESULT_OBJECT\fR
The result of invoking the \fIproc\fR is a Tcl_Obj* (cast to a char*)
with a reference count of at least one.  The ownership of that
reference will be transferred to the Tcl core for release (when the
core has finished with it) via a call to \fBTcl_DecrRefCount\fR.  Must
not be specified at the same time as \fBTCL_TRACE_RESULT_DYNAMIC\fR.
.PP
Whenever one of the specified operations occurs on the variable,
\fIproc\fR will be invoked.
It should have arguments and result that match the type
\fBTcl_VarTraceProc\fR:
.PP
.CS
typedef char *\fBTcl_VarTraceProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        char *\fIname1\fR,
        char *\fIname2\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters will
have the same values as those passed to \fBTcl_TraceVar\fR when the
trace was created.
\fIclientData\fR typically points to an application-specific
data structure that describes what to do when \fIproc\fR
is invoked.
\fIName1\fR and \fIname2\fR give the name of the traced variable
in the normal two-part form (see the description of \fBTcl_TraceVar2\fR
below for details).
\fIFlags\fR is an OR-ed combination of bits providing several
pieces of information.
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
successful completion.
If \fIproc\fR returns a non-NULL value it signifies that an
error occurred.
The return value must be a pointer to a static character string
containing an error message,
unless (\fIexactly\fR one of) the \fBTCL_TRACE_RESULT_DYNAMIC\fR and
\fBTCL_TRACE_RESULT_OBJECT\fR flags is set, which specify that the result is
either a dynamic string (to be released with \fBckfree\fR) or a
Tcl_Obj* (cast to char* and to be released with
\fBTcl_DecrRefCount\fR) containing the error message.
If a trace procedure returns an error, no further traces are
invoked for the access and the traced access aborts with the
given message.
Trace procedures can use this facility to make variables
read-only, for example (but note that the value of the variable







|







308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
successful completion.
If \fIproc\fR returns a non-NULL value it signifies that an
error occurred.
The return value must be a pointer to a static character string
containing an error message,
unless (\fIexactly\fR one of) the \fBTCL_TRACE_RESULT_DYNAMIC\fR and
\fBTCL_TRACE_RESULT_OBJECT\fR flags is set, which specify that the result is
either a dynamic string (to be released with \fBTcl_Free\fR) or a
Tcl_Obj* (cast to char* and to be released with
\fBTcl_DecrRefCount\fR) containing the error message.
If a trace procedure returns an error, no further traces are
invoked for the access and the traced access aborts with the
given message.
Trace procedures can use this facility to make variables
read-only, for example (but note that the value of the variable
Changes to doc/Utf.3.
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Tcl_UniChar *
\fBTcl_UtfToUniCharDString\fR(\fIsrc, length, dsPtr\fR)
.sp
int
\fBTcl_UniCharLen\fR(\fIuniStr\fR)
.sp
int
\fBTcl_UniCharNcmp\fR(\fIucs, uct, numChars\fR)
.sp
int
\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, numChars\fR)
.sp
int
\fBTcl_UniCharCaseMatch\fR(\fIuniStr, uniPattern, nocase\fR)
.sp
int
\fBTcl_UtfNcmp\fR(\fIcs, ct, numChars\fR)
.sp
int
\fBTcl_UtfNcasecmp\fR(\fIcs, ct, numChars\fR)
.sp
int
\fBTcl_UtfCharComplete\fR(\fIsrc, length\fR)
.sp
int
\fBTcl_NumUtfChars\fR(\fIsrc, length\fR)
.sp







|


|





|


|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Tcl_UniChar *
\fBTcl_UtfToUniCharDString\fR(\fIsrc, length, dsPtr\fR)
.sp
int
\fBTcl_UniCharLen\fR(\fIuniStr\fR)
.sp
int
\fBTcl_UniCharNcmp\fR(\fIucs, uct, uniLength\fR)
.sp
int
\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, uniLength\fR)
.sp
int
\fBTcl_UniCharCaseMatch\fR(\fIuniStr, uniPattern, nocase\fR)
.sp
int
\fBTcl_UtfNcmp\fR(\fIcs, ct, length\fR)
.sp
int
\fBTcl_UtfNcasecmp\fR(\fIcs, ct, length\fR)
.sp
int
\fBTcl_UtfCharComplete\fR(\fIsrc, length\fR)
.sp
int
\fBTcl_NumUtfChars\fR(\fIsrc, length\fR)
.sp
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
.sp
int
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
.sp
const char *
\fBTcl_UtfAtIndex\fR(\fIsrc, index\fR)
.sp
int
\fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *uniPattern in/out
.AP char *buf out
Buffer in which the UTF-8 representation of the Tcl_UniChar is stored.  At most
\fBTCL_UTF_MAX\fR bytes are stored in the buffer.
.AP int ch in







|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
.sp
int
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
.sp
const char *
\fBTcl_UtfAtIndex\fR(\fIsrc, index\fR)
.sp
size_t
\fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *uniPattern in/out
.AP char *buf out
Buffer in which the UTF-8 representation of the Tcl_UniChar is stored.  At most
\fBTCL_UTF_MAX\fR bytes are stored in the buffer.
.AP int ch in
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *ucs in
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *uct in
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *uniPattern in
A null-terminated Unicode string.
.AP int length in
The length of the UTF-8 string in bytes (not UTF-8 characters).  If
negative, all bytes up to the first null byte are used.
.AP int uniLength in
The length of the Unicode string in characters.  Must be greater than or
equal to 0.
.AP "Tcl_DString" *dsPtr in/out
A pointer to a previously initialized \fBTcl_DString\fR.
.AP "unsigned long" numChars in
The number of characters to compare.
.AP "const char" *start in
Pointer to the beginning of a UTF-8 string.
.AP int index in
The index of a character (not byte) in the UTF-8 string.
.AP int *readPtr out
If non-NULL, filled with the number of bytes in the backslash sequence,
including the backslash character.
.AP char *dst out
Buffer in which the bytes represented by the backslash sequence are stored.
At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer.







|

|
|
|
<


<
<


|







90
91
92
93
94
95
96
97
98
99
100
101

102
103


104
105
106
107
108
109
110
111
112
113
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *ucs in
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *uct in
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *uniPattern in
A null-terminated Unicode string.
.AP size_t length in
The length of the UTF-8 string in bytes (not UTF-8 characters).  If
(size_t)-1, all bytes up to the first null byte are used.
.AP size_t 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
Pointer to the beginning of a UTF-8 string.
.AP size_t index in
The index of a character (not byte) in the UTF-8 string.
.AP int *readPtr out
If non-NULL, filled with the number of bytes in the backslash sequence,
including the backslash character.
.AP char *dst out
Buffer in which the bytes represented by the backslash sequence are stored.
At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer.
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
\fBTcl_UniCharLen\fR corresponds to \fBstrlen\fR for Unicode
characters.  It accepts a null-terminated Unicode string and returns
the number of Unicode characters (not bytes) in that string.
.PP
\fBTcl_UniCharNcmp\fR and \fBTcl_UniCharNcasecmp\fR correspond to
\fBstrncmp\fR and \fBstrncasecmp\fR, respectively, for Unicode characters.
They accept two null-terminated Unicode strings and the number of characters
to compare.  Both strings are assumed to be at least \fInumChars\fR characters
long. \fBTcl_UniCharNcmp\fR  compares the two strings character-by-character
according to the Unicode character ordering.  It returns an integer greater
than, equal to, or less than 0 if the first string is greater than, equal
to, or less than the second string respectively.  \fBTcl_UniCharNcasecmp\fR
is the Unicode case insensitive version.
.PP
\fBTcl_UniCharCaseMatch\fR is the Unicode equivalent to
\fBTcl_StringCaseMatch\fR.  It accepts a null-terminated Unicode string,
a Unicode pattern, and a boolean value specifying whether the match should
be case sensitive and returns whether the string matches the pattern.
.PP
\fBTcl_UtfNcmp\fR corresponds to \fBstrncmp\fR for UTF-8 strings. It
accepts two null-terminated UTF-8 strings and the number of characters
to compare.  (Both strings are assumed to be at least \fInumChars\fR
characters long.)  \fBTcl_UtfNcmp\fR compares the two strings
character-by-character according to the Unicode character ordering.
It returns an integer greater than, equal to, or less than 0 if the
first string is greater than, equal to, or less than the second string
respectively.
.PP
\fBTcl_UtfNcasecmp\fR corresponds to \fBstrncasecmp\fR for UTF-8







|













|







168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
\fBTcl_UniCharLen\fR corresponds to \fBstrlen\fR for Unicode
characters.  It accepts a null-terminated Unicode string and returns
the number of Unicode characters (not bytes) in that string.
.PP
\fBTcl_UniCharNcmp\fR and \fBTcl_UniCharNcasecmp\fR correspond to
\fBstrncmp\fR and \fBstrncasecmp\fR, respectively, for Unicode characters.
They accept two null-terminated Unicode strings and the number of characters
to compare.  Both strings are assumed to be at least \fIuniLength\fR characters
long. \fBTcl_UniCharNcmp\fR  compares the two strings character-by-character
according to the Unicode character ordering.  It returns an integer greater
than, equal to, or less than 0 if the first string is greater than, equal
to, or less than the second string respectively.  \fBTcl_UniCharNcasecmp\fR
is the Unicode case insensitive version.
.PP
\fBTcl_UniCharCaseMatch\fR is the Unicode equivalent to
\fBTcl_StringCaseMatch\fR.  It accepts a null-terminated Unicode string,
a Unicode pattern, and a boolean value specifying whether the match should
be case sensitive and returns whether the string matches the pattern.
.PP
\fBTcl_UtfNcmp\fR corresponds to \fBstrncmp\fR for UTF-8 strings. It
accepts two null-terminated UTF-8 strings and the number of characters
to compare.  (Both strings are assumed to be at least \fIlength\fR
characters long.)  \fBTcl_UtfNcmp\fR compares the two strings
character-by-character according to the Unicode character ordering.
It returns an integer greater than, equal to, or less than 0 if the
first string is greater than, equal to, or less than the second string
respectively.
.PP
\fBTcl_UtfNcasecmp\fR corresponds to \fBstrncasecmp\fR for UTF-8
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
the start of the UTF-8 string.  If \fIsrc\fR was already at \fIstart\fR, the
return value will be \fIstart\fR.
.PP
\fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the
Pascal Ord() function.  It returns the Tcl_UniChar represented at the
specified character (not byte) \fIindex\fR in the UTF-8 string
\fIsrc\fR.  The source string must contain at least \fIindex\fR
characters.  Behavior is undefined if a negative \fIindex\fR is given.
.PP
\fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not
byte) \fIindex\fR in the UTF-8 string \fIsrc\fR.  The source string must
contain at least \fIindex\fR characters.  This is equivalent to calling
\fBTcl_UtfNext\fR \fIindex\fR times.  If a negative \fIindex\fR is given,
the return pointer points to the first character in the source string.
.PP
\fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl
commands.  It parses a backslash sequence and stores the properly formed
UTF-8 character represented by the backslash sequence in the output
buffer \fIdst\fR.  At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer.
\fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number







|




|







234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
the start of the UTF-8 string.  If \fIsrc\fR was already at \fIstart\fR, the
return value will be \fIstart\fR.
.PP
\fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the
Pascal Ord() function.  It returns the Tcl_UniChar represented at the
specified character (not byte) \fIindex\fR in the UTF-8 string
\fIsrc\fR.  The source string must contain at least \fIindex\fR
characters.
.PP
\fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not
byte) \fIindex\fR in the UTF-8 string \fIsrc\fR.  The source string must
contain at least \fIindex\fR characters.  This is equivalent to calling
\fBTcl_UtfNext\fR \fIindex\fR times.  If \fIindex\fR is (size_t)-1,
the return pointer points to the first character in the source string.
.PP
\fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl
commands.  It parses a backslash sequence and stores the properly formed
UTF-8 character represented by the backslash sequence in the output
buffer \fIdst\fR.  At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer.
\fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number
Added doc/abstract.n.


























































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH abstract n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::abstract \- a class that does not allow direct instances of itself
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::abstract\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR
       \(-> \fBoo::abstract\fR
.fi
.BE
.SH DESCRIPTION
Abstract classes are classes that can contain definitions, but which cannot be
directly manufactured; they are intended to only ever be inherited from and
instantiated indirectly. The characteristic methods of \fBoo::class\fR
(\fBcreate\fR and \fBnew\fR) are not exported by an instance of
\fBoo::abstract\fR.
.PP
Note that \fBoo::abstract\fR is not itself an instance of \fBoo::abstract\fR.
.SS CONSTRUCTOR
The \fBoo::abstract\fR class does not define an explicit constructor; this
means that it is effectively the same as the constructor of the
\fBoo::class\fR class.
.SS DESTRUCTOR
The \fBoo::abstract\fR class does not define an explicit destructor;
destroying an instance of it is just like destroying an ordinary class (and
will destroy all its subclasses).
.SS "EXPORTED METHODS"
The \fBoo::abstract\fR class defines no new exported methods.
.SS "NON-EXPORTED METHODS"
The \fBoo::abstract\fR class explicitly states that \fBcreate\fR,
\fBcreateWithNamespace\fR, and \fBnew\fR are unexported.
.SH EXAMPLES
.PP
This example defines a simple class hierarchy and creates a new instance of
it. It then invokes a method of the object before destroying the hierarchy and
showing that the destruction is transitive.
.PP
.CS
\fBoo::abstract\fR create fruit {
    method eat {} {
        puts "yummy!"
    }
}
oo::class create banana {
    superclass fruit
    method peel {} {
        puts "skin now off"
    }
}
set b [banana \fBnew\fR]
$b peel              \fI\(-> prints 'skin now off'\fR
$b eat               \fI\(-> prints 'yummy!'\fR
set f [fruit new]    \fI\(-> error 'unknown method "new"...'\fR
.CE
.SH "SEE ALSO"
oo::define(n), oo::object(n)
.SH KEYWORDS
abstract class, class, metaclass, object
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Changes to doc/append.n.
16
17
18
19
20
21
22





23
24
25
26
27
28
29
.BE
.SH DESCRIPTION
.PP
Append all of the \fIvalue\fR arguments to the current value
of variable \fIvarName\fR.  If \fIvarName\fR does not exist,
it is given a value equal to the concatenation of all the
\fIvalue\fR arguments.





The result of this command is the new value stored in variable
\fIvarName\fR.
This command provides an efficient way to build up long
variables incrementally.
For example,
.QW "\fBappend a $b\fR"
is much more efficient than







>
>
>
>
>







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
.BE
.SH DESCRIPTION
.PP
Append all of the \fIvalue\fR arguments to the current value
of variable \fIvarName\fR.  If \fIvarName\fR does not exist,
it is given a value equal to the concatenation of all the
\fIvalue\fR arguments.
.VS TIP508
If \fIvarName\fR indicate an element that does not exist of an array that has
a default value set, the concatenation of the default value and all the
\fIvalue\fR arguments will be stored in the array element.
.VE TIP508
The result of this command is the new value stored in variable
\fIvarName\fR.
This command provides an efficient way to build up long
variables incrementally.
For example,
.QW "\fBappend a $b\fR"
is much more efficient than
40
41
42
43
44
45
46
47
48

49
puts $var
# Prints 0,1,2,3,4,5,6,7,8,9,10
.CE
.SH "SEE ALSO"
concat(n), lappend(n)
.SH KEYWORDS
append, variable
'\" Local Variables:
'\" mode: nroff

'\" End:







|
|
>
|
45
46
47
48
49
50
51
52
53
54
55
puts $var
# Prints 0,1,2,3,4,5,6,7,8,9,10
.CE
.SH "SEE ALSO"
concat(n), lappend(n)
.SH KEYWORDS
append, variable
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Changes to doc/array.n.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1993-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH array n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
array \- Manipulate array variables
.SH SYNOPSIS
\fBarray \fIoption arrayName\fR ?\fIarg arg ...\fR?







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1993-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH array n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
array \- Manipulate array variables
.SH SYNOPSIS
\fBarray \fIoption arrayName\fR ?\fIarg arg ...\fR?
31
32
33
34
35
36
37















































38
39
40
41
42
43
44
\fISearchId\fR indicates which search on \fIarrayName\fR to
check, and must have been the return value from a previous
invocation of \fBarray startsearch\fR.
This option is particularly useful if an array has an element
with an empty name, since the return value from
\fBarray nextelement\fR will not indicate whether the search
has been completed.















































.TP
\fBarray donesearch \fIarrayName searchId\fR
This command terminates an array search and destroys all the
state associated with that search.  \fISearchId\fR indicates
which search on \fIarrayName\fR to destroy, and must have
been the return value from a previous invocation of
\fBarray startsearch\fR.  Returns an empty string.







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
\fISearchId\fR indicates which search on \fIarrayName\fR to
check, and must have been the return value from a previous
invocation of \fBarray startsearch\fR.
This option is particularly useful if an array has an element
with an empty name, since the return value from
\fBarray nextelement\fR will not indicate whether the search
has been completed.
.TP
\fBarray default \fIsubcommand arrayName args...\fR
.VS TIP508
Manages the default value of the array. Arrays initially have no default
value, but this command allows you to set one; the default value will be
returned when reading from an element of the array \farrayName\fR if the read
would otherwise result in an error. Note that this may cause the \fBappend\fR,
\fBdict\fR, \fBincr\fR and \fBlappend\fR commands to change their behavior in
relation to non-existing array elements.
.RS
.PP
The \fIsubcommand\fR argument controls what exact operation will be performed
on the default value of \fIarrayName\fR. Supported \fIsubcommand\fRs are:
.VE TIP508
.TP
\fBarray default exists \fIarrayName\fR
.VS TIP508
This returns a boolean value indicating whether a default value has been set
for the array \fIarrayName\fR. Returns a false value if \fIarrayName\fR does
not exist. Raises an error if \fIarrayName\fR is an existing variable that is
not an array.
.VE TIP508
.TP
\fBarray default get \fIarrayName\fR
.VS TIP508
This returns the current default value for the array \fIarrayName\fR.  Raises
an error if \fIarrayName\fR is an existing variable that is not an array, or
if \fIarrayName\fR is an array without a default value.
.VE TIP508
.TP
\fBarray default set \fIarrayName value\fR
.VS TIP508
This sets the default value for the array \fIarrayName\fR to \fIvalue\fR.
Returns the empty string. Raises an error if \fIarrayName\fR is an existing
variable that is not an array, or if \fIarrayName\fR is an illegal name for an
array. If \fIarrayName\fR does not currently exist, it is created as an empty
array as well as having its default value set.
.VE TIP508
.TP
\fBarray default unset \fIarrayName\fR
.VS TIP508
This removes the default value for the array \fIarrayName\fR and returns the
empty string. Does nothing if \fIarrayName\fR does not have a default
value. Raises an error if \fIarrayName\fR is an existing variable that is not
an array.
.VE TIP508
.RE
.TP
\fBarray donesearch \fIarrayName searchId\fR
This command terminates an array search and destroys all the
state associated with that search.  \fISearchId\fR indicates
which search on \fIarrayName\fR to destroy, and must have
been the return value from a previous invocation of
\fBarray startsearch\fR.  Returns an empty string.
190
191
192
193
194
195
196




    number of buckets with 10 or more entries: 0
    average search distance for entry: 1.2
.CE
.SH "SEE ALSO"
list(n), string(n), variable(n), trace(n), foreach(n)
.SH KEYWORDS
array, element names, search











>
>
>
>
237
238
239
240
241
242
243
244
245
246
247
    number of buckets with 10 or more entries: 0
    average search distance for entry: 1.2
.CE
.SH "SEE ALSO"
list(n), string(n), variable(n), trace(n), foreach(n)
.SH KEYWORDS
array, element names, search
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Added doc/callback.n.
















































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH callback n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
callback, mymethod \- generate callbacks to methods
.SH SYNOPSIS
.nf
package require TclOO

\fBcallback\fR \fImethodName\fR ?\fIarg ...\fR?
\fBmymethod\fR \fImethodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBcallback\fR command,
'\" Based on notes in the tcllib docs, we know the provenance of mymethod
also called \fBmymethod\fR for compatibility with the ooutil and snit packages
of Tcllib,
and which should only be used from within the context of a call to a method
(i.e. inside a method, constructor or destructor body) is used to generate a
script fragment that will invoke the method, \fImethodName\fR, on the current
object (as reported by \fBself\fR) when executed. Any additional arguments
provided will be provided as leading arguments to the callback. The resulting
script fragment shall be a proper list.
.PP
Note that it is up to the caller to ensure that the current object is able to
handle the call of \fImethodName\fR; this command does not check that.
\fImethodName\fR may refer to any exported or unexported method, but may not
refer to a private method as those can only be invoked directly from within
methods. If there is no such method present at the point when the callback is
invoked, the standard \fBunknown\fR method handler will be called.
.SH EXAMPLE
This is a simple echo server class. The \fBcallback\fR command is used in two
places, to arrange for the incoming socket connections to be handled by the
\fIAccept\fR method, and to arrange for the incoming bytes on those
connections to be handled by the \fIReceive\fR method.
.PP
.CS
oo::class create EchoServer {
    variable server clients
    constructor {port} {
        set server [socket -server [\fBcallback\fR Accept] $port]
        set clients {}
    }
    destructor {
        chan close $server
        foreach client [dict keys $clients] {
            chan close $client
        }
    }

    method Accept {channel clientAddress clientPort} {
        dict set clients $channel [dict create \e
                address $clientAddress port $clientPort]
        chan event $channel readable [\fBcallback\fR Receive $channel]
    }
    method Receive {channel} {
        if {[chan gets $channel line] >= 0} {
            my echo $channel $line
        } else {
            chan close $channel
            dict unset clients $channel
        }
    }

    method echo {channel line} {
        dict with clients $channel {
            chan puts $channel \e
                    [format {[%s:%d] %s} $address $port $line]
        }
    }
}
.CE
.SH "SEE ALSO"
chan(n), fileevent(n), my(n), self(n), socket(n), trace(n)
.SH KEYWORDS
callback, object
.\" Local Variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Changes to doc/cd.n.
37
38
39
40
41
42
43




.CS
\fBcd\fR ../lib
.CE
.SH "SEE ALSO"
filename(n), glob(n), pwd(n)
.SH KEYWORDS
working directory











>
>
>
>
37
38
39
40
41
42
43
44
45
46
47
.CS
\fBcd\fR ../lib
.CE
.SH "SEE ALSO"
filename(n), glob(n), pwd(n)
.SH KEYWORDS
working directory
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Added doc/classvariable.n.




























































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
'\"
'\" Copyright (c) 2011-2015 Andreas Kupries
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH classvariable n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
classvariable \- create link from local variable to variable in class
.SH SYNOPSIS
.nf
package require TclOO

\fBclassvariable\fR \fIvariableName\fR ?\fI...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBclassvariable\fR command is available within methods. It takes a series
of one or more variable names and makes them available in the method's scope;
those variable names must not be qualified and must not refer to array
elements. The originating scope for the variables is the namespace of the
class that the method was defined by. In other words, the referenced variables
are shared between all instances of that class.
.PP
Note: This command is equivalent to the command \fBtypevariable\fR provided by
the snit package in tcllib for approximately the same purpose. If used in a
method defined directly on a class instance (e.g., through the
\fBoo::objdefine\fR \fBmethod\fR definition) this is very much like just
using:
.PP
.CS
namespace upvar [namespace current] $var $var
.CE
.PP
for each variable listed to \fBclassvariable\fR.
.SH EXAMPLE
This class counts how many instances of it have been made.
.PP
.CS
oo::class create Counted {
    initialise {
        variable count 0
    }

    variable number
    constructor {} {
        \fBclassvariable\fR count
        set number [incr count]
    }

    method report {} {
        \fBclassvariable\fR count
        puts "This is instance $number of $count"
    }
}

set a [Counted new]
set b [Counted new]
$a report
        \fI\(-> This is instance 1 of 2\fR
set c [Counted new]
$b report
        \fI\(-> This is instance 2 of 3\fR
$c report
        \fI\(-> This is instance 3 of 3\fR
.CE
.SH "SEE ALSO"
global(n), namespace(n), oo::class(n), oo::define(n), upvar(n), variable(n)
.SH KEYWORDS
class, class variable, variable
.\" Local Variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Changes to doc/clock.n.
882
883
884
885
886
887
888

889


890
891
892
893
894

895
896
897
898
899
900
901
902
903
904
905
906
907
908
909

910
911
912
913
914
915
916
917
918
919
920
921
922

923
924
925
926
927
928
929
time.  This is useful for determining the time on a specific day or
doing other date-relative conversions.
.PP
The \fIinputString\fR argument consists of zero or more specifications of the
following form:
.TP
\fItime\fR

A time of day, which is of the form: \fBhh?:mm?:ss?? ?meridian? ?zone?\fR


or \fBhhmm ?meridian? ?zone?\fR
If no meridian is specified, \fBhh\fR is interpreted on
a 24-hour clock.
.TP
\fIdate\fR

A specific month and day with optional year.  The
acceptable formats are
.QW "\fBmm/dd\fR?\fB/yy\fR?" ,
.QW "\fBmonthname dd\fR?\fB, yy\fR?" ,
.QW "\fBday, dd monthname \fR?\fByy\fR?" ,
.QW "\fBdd monthname yy\fR" ,
.QW "?\fBCC\fR?\fByymmdd\fR" ,
and
.QW "\fBdd-monthname-\fR?\fBCC\fR?\fByy\fR" .
The default year is the current year.  If the year is less
than 100, we treat the years 00-68 as 2000-2068 and the years 69-99
as 1969-1999.  Not all platforms can represent the years 38-70, so
an error may result if these years are used.
.TP
\fIISO 8601 point-in-time\fR

An ISO 8601 point-in-time specification, such as
.QW \fICCyymmdd\fBT\fIhhmmss\fR,
where \fBT\fR is the literal
.QW T ,
.QW "\fICCyymmdd hhmmss\fR" ,
or
.QW \fICCyymmdd\fBT\fIhh:mm:ss\fR .
Note that only these three formats are accepted.
The command does \fInot\fR accept the full range of point-in-time
specifications specified in ISO8601.  Other formats can be recognized by
giving an explicit \fB\-format\fR option to the \fBclock scan\fR command.
.TP
\fIrelative time\fR

A specification relative to the current time.  The format is \fBnumber
unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR,
\fBmonth\fR, \fBweek\fR, \fBday\fR,
\fBhour\fR, \fBminute\fR (or \fBmin\fR), and \fBsecond\fR (or \fBsec\fR).  The
unit can be specified as a singular or plural, as in \fB3 weeks\fR.
These modifiers may also be specified:
\fBtomorrow\fR, \fByesterday\fR, \fBtoday\fR, \fBnow\fR,







>
|
>
>
|
|



>


|
|
|
|
|

|






>






|






>







882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
time.  This is useful for determining the time on a specific day or
doing other date-relative conversions.
.PP
The \fIinputString\fR argument consists of zero or more specifications of the
following form:
.TP
\fItime\fR
.
A time of day, which is of the form:
.QW "\fIhh\fR?\fB:\fImm\fR?\fB:\fIss\fR?? ?\fImeridian\fR? ?\fIzone\fR?"
or
.QW "\fBhhmm \fR?\fBmeridian\fR? ?\fBzone\fR?" .
If no \fImeridian\fR is specified, \fIhh\fR is interpreted on
a 24-hour clock.
.TP
\fIdate\fR
.
A specific month and day with optional year.  The
acceptable formats are
.QW "\fImm\fB/\fIdd\fR?\fB/\fIyy\fR?" ,
.QW "\fImonthname dd\fR?\fB, \fIyy\fR?" ,
.QW "\fIday\fB, \fIdd monthname \fR?\fIyy\fR?" ,
.QW "\fIdd monthname yy\fR" ,
.QW "?\fICC\fR?\fIyymmdd\fR" ,
and
.QW "\fIdd\fB-\fImonthname\fB-\fR?\fICC\fR?\fIyy\fR" .
The default year is the current year.  If the year is less
than 100, we treat the years 00-68 as 2000-2068 and the years 69-99
as 1969-1999.  Not all platforms can represent the years 38-70, so
an error may result if these years are used.
.TP
\fIISO 8601 point-in-time\fR
.
An ISO 8601 point-in-time specification, such as
.QW \fICCyymmdd\fBT\fIhhmmss\fR,
where \fBT\fR is the literal
.QW T ,
.QW "\fICCyymmdd hhmmss\fR" ,
or
.QW \fICCyymmdd\fBT\fIhh\fB:\fImm\fB:\fIss\fR .
Note that only these three formats are accepted.
The command does \fInot\fR accept the full range of point-in-time
specifications specified in ISO8601.  Other formats can be recognized by
giving an explicit \fB\-format\fR option to the \fBclock scan\fR command.
.TP
\fIrelative time\fR
.
A specification relative to the current time.  The format is \fBnumber
unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR,
\fBmonth\fR, \fBweek\fR, \fBday\fR,
\fBhour\fR, \fBminute\fR (or \fBmin\fR), and \fBsecond\fR (or \fBsec\fR).  The
unit can be specified as a singular or plural, as in \fB3 weeks\fR.
These modifiers may also be specified:
\fBtomorrow\fR, \fByesterday\fR, \fBtoday\fR, \fBnow\fR,
Changes to doc/define.n.
1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH define n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS

|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2007-2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH define n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
34
35
36
37
38
39
40





















41
42
43
44
45
46
47
\fIarg\fR arguments; when the second is present, it is exactly as if all the
arguments from \fIsubcommand\fR onwards are made into a list and that list is
used as the \fIdefScript\fR argument.
.SS "CONFIGURING CLASSES"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form:





















.TP
\fBconstructor\fI argList bodyScript\fR
.
This creates or updates the constructor for a class. The formal arguments to
the constructor (defined using the same format as for the Tcl \fBproc\fR
command) will be \fIargList\fR, and the body of the constructor will be
\fIbodyScript\fR. When the body of the constructor is evaluated, the current







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
\fIarg\fR arguments; when the second is present, it is exactly as if all the
arguments from \fIsubcommand\fR onwards are made into a list and that list is
used as the \fIdefScript\fR argument.
.SS "CONFIGURING CLASSES"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form:
.TP
\fBclassmethod\fI name\fR ?\fIargList bodyScrip\fR?
.VS TIP478
This creates a class method, or (if \fIargList\fR and \fIbodyScript\fR are
omitted) promotes an existing method on the class object to be a class
method. The \fIname\fR, \fIargList\fR and \fIbodyScript\fR arguments are as in
the \fBmethod\fR definition, below.
.RS
.PP
Class methods can be called on either the class itself or on the instances of
that class. When they are called, the current object (see the \fBself\R and
\fBmy\fR commands) is the class on which they are called or the class of the
instance on which they are called, depending on whether they are called on the
class or an instance of the class, respectively. If called on a subclass or
instance of the subclass, the current object is the subclass.
.PP
In a private definition context, the methods as invoked on classes are
\fInot\fR private, but the methods as invoked on instances of classes are
private.
.RE
.VE TIP478
.TP
\fBconstructor\fI argList bodyScript\fR
.
This creates or updates the constructor for a class. The formal arguments to
the constructor (defined using the same format as for the Tcl \fBproc\fR
command) will be \fIargList\fR, and the body of the constructor will be
\fIbodyScript\fR. When the body of the constructor is evaluated, the current
105
106
107
108
109
110
111









112
113
114
115
116
117
118
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private forwarded methods.
.VE TIP500
.RE









.TP
\fBmethod\fI name argList bodyScript\fR
.
This creates or updates a method that is implemented as a procedure-like
script. The name of the method is \fIname\fR, the formal arguments to the
method (defined using the same format as for the Tcl \fBproc\fR command) will
be \fIargList\fR, and the body of the method will be \fIbodyScript\fR. When







>
>
>
>
>
>
>
>
>







126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private forwarded methods.
.VE TIP500
.RE
.TP
\fBinitialise\fI script\fR
.TP
\fBinitialize\fI script\fR
.VS TIP478
This evaluates \fIscript\fR in a context which supports local variables and
where the current namespace is the instance namespace of the class object
itself. This is useful for setting up, e.g., class-scoped variables.
.VE TIP478
.TP
\fBmethod\fI name argList bodyScript\fR
.
This creates or updates a method that is implemented as a procedure-like
script. The name of the method is \fIname\fR, the formal arguments to the
method (defined using the same format as for the Tcl \fBproc\fR command) will
be \fIargList\fR, and the body of the method will be \fIbodyScript\fR. When
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408










409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429









430


















431
432
433
434
435










436
437
438
439
440
441
442








443
444
445
446
447
448
449
\fBself call\fR).
.VE TIP500
.SH "SLOTTED DEFINITIONS"
Some of the configurable definitions of a class or object are \fIslotted
definitions\fR. This means that the configuration is implemented by a slot
object, that is an instance of the class \fBoo::Slot\fR, which manages a list
of values (class names, variable names, etc.) that comprises the contents of
the slot. The class defines three operations (as methods) that may be done on
the slot:
.TP
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
.
This appends the given \fImember\fR elements to the slot definition.
.TP
\fIslot\fR \fB\-clear\fR
.
This sets the slot definition to the empty list.










.TP
\fIslot\fR \fB\-set\fR ?\fImember ...\fR?
.
This replaces the slot definition with the given \fImember\fR elements.
.PP
A consequence of this is that any use of a slot's default operation where the
first member argument begins with a hyphen will be an error. One of the above
operations should be used explicitly in those circumstances.
.SS "SLOT IMPLEMENTATION"
Internally, slot objects also define a method \fB\-\-default\-operation\fR
which is forwarded to the default operation of the slot (thus, for the class
.QW \fBvariable\fR
slot, this is forwarded to
.QW "\fBmy \-append\fR" ),
and these methods which provide the implementation interface:
.TP
\fIslot\fR \fBGet\fR
.
Returns a list that is the current contents of the slot. This method must
always be called from a stack frame created by a call to \fBoo::define\fR or
\fBoo::objdefine\fR.









.TP


















\fIslot\fR \fBSet \fIelementList\fR
.
Sets the contents of the slot to the list \fIelementList\fR and returns the
empty string. This method must always be called from a stack frame created by
a call to \fBoo::define\fR or \fBoo::objdefine\fR.










.PP
The implementation of these methods is slot-dependent (and responsible for
accessing the correct part of the class or object definition). Slots also have
an unknown method handler to tie all these pieces together, and they hide
their \fBdestroy\fR method so that it is not invoked inadvertently. It is
\fIrecommended\fR that any user changes to the slot mechanism be restricted to
defining new operations whose names start with a hyphen.








.SH EXAMPLES
This example demonstrates how to use both forms of the \fBoo::define\fR and
\fBoo::objdefine\fR commands (they work in the same way), as well as
illustrating four of their subcommands.
.PP
.CS
oo::class create c







|









>
>
>
>
>
>
>
>
>
>


















|
|
|
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




|
>
>
>
>
>
>
>
>
>
>







>
>
>
>
>
>
>
>







422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
\fBself call\fR).
.VE TIP500
.SH "SLOTTED DEFINITIONS"
Some of the configurable definitions of a class or object are \fIslotted
definitions\fR. This means that the configuration is implemented by a slot
object, that is an instance of the class \fBoo::Slot\fR, which manages a list
of values (class names, variable names, etc.) that comprises the contents of
the slot. The class defines five operations (as methods) that may be done on
the slot:
.TP
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
.
This appends the given \fImember\fR elements to the slot definition.
.TP
\fIslot\fR \fB\-clear\fR
.
This sets the slot definition to the empty list.
.TP
\fIslot\fR \fB\-prepend\fR ?\fImember ...\fR?
.VS TIP516
This prepends the given \fImember\fR elements to the slot definition.
.VE TIP516
.TP
\fIslot\fR \fB\-remove\fR ?\fImember ...\fR?
.VS TIP516
This removes the given \fImember\fR elements from the slot definition.
.VE TIP516
.TP
\fIslot\fR \fB\-set\fR ?\fImember ...\fR?
.
This replaces the slot definition with the given \fImember\fR elements.
.PP
A consequence of this is that any use of a slot's default operation where the
first member argument begins with a hyphen will be an error. One of the above
operations should be used explicitly in those circumstances.
.SS "SLOT IMPLEMENTATION"
Internally, slot objects also define a method \fB\-\-default\-operation\fR
which is forwarded to the default operation of the slot (thus, for the class
.QW \fBvariable\fR
slot, this is forwarded to
.QW "\fBmy \-append\fR" ),
and these methods which provide the implementation interface:
.TP
\fIslot\fR \fBGet\fR
.
Returns a list that is the current contents of the slot, but does not modify
the slot. This method must always be called from a stack frame created by a
call to \fBoo::define\fR or \fBoo::objdefine\fR. This method \fIshould not\fR
return an error unless it is called from outside a definition context or with
the wrong number of arguments.
.RS
.PP
.VS TIP516
The elements of the list should be fully resolved, if that is a meaningful
concept to the slot.
.VE TIP516
.RE
.TP
\fIslot\fR \fBResolve\fR \fIslotElement\fR
.VS TIP516
Returns \fIslotElement\fR with a resolution operation applied to it, but does
not modify the slot. For slots of simple strings, this is an operation that
does nothing, whereas for slots of classes, this maps a class name to its
fully-qualified class name.  This method must always be called from a stack
frame created by a call to \fBoo::define\fR or \fBoo::objdefine\fR.  This
method \fIshould not\fR return an error unless it is called from outside a
definition context or with the wrong number of arguments; unresolvable
arguments should be returned as is (as not all slot operations strictly
require that values are resolvable to work).
.RS
.PP
Implementations \fIshould not\fR enforce uniqueness and ordering constraints
in this method; that is the responsibility of the \fBSet\fR method.
.RE
.VE TIP516
.TP
\fIslot\fR \fBSet \fIelementList\fR
.
Sets the contents of the slot to the list \fIelementList\fR and returns the
empty string. This method must always be called from a stack frame created by
a call to \fBoo::define\fR or \fBoo::objdefine\fR. This method may return an
error if it rejects the change to the slot contents (e.g., because of invalid
values) as well as if it is called from outside a definition context or with
the wrong number of arguments.
.RS
.PP
This method \fImay\fR reorder and filter the elements if this is necessary in
order to satisfy the underlying constraints of the slot. (For example, slots
of classes enforce a uniqueness constraint that places each element in the
earliest location in the slot that it can.)
.RE
.PP
The implementation of these methods is slot-dependent (and responsible for
accessing the correct part of the class or object definition). Slots also have
an unknown method handler to tie all these pieces together, and they hide
their \fBdestroy\fR method so that it is not invoked inadvertently. It is
\fIrecommended\fR that any user changes to the slot mechanism be restricted to
defining new operations whose names start with a hyphen.
.PP
.VS TIP516
Most slot operations will initially \fBResolve\fR their argument list, combine
it with the results of the \fBGet\fR method, and then \fBSet\fR the result.
Some operations omit one or both of the first two steps; omitting the third
would result in an idempotent read-only operation (but the standard mechanism
for reading from slots is via \fBinfo class\fR and \fBinfo object\fR).
.VE TIP516
.SH EXAMPLES
This example demonstrates how to use both forms of the \fBoo::define\fR and
\fBoo::objdefine\fR commands (they work in the same way), as well as
illustrating four of their subcommands.
.PP
.CS
oo::class create c
492
493
494
495
496
497
498














































































499
500
501
502
503
504
505
506
}
\fBoo::objdefine\fR inst {
    \fBmixin -append\fR B
}
inst m1              \fI\(-> prints "red brick"\fR
inst m2              \fI\(-> prints "blue brick"\fR
.CE














































































.SH "SEE ALSO"
next(n), oo::class(n), oo::object(n)
.SH KEYWORDS
class, definition, method, object, slot
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
}
\fBoo::objdefine\fR inst {
    \fBmixin -append\fR B
}
inst m1              \fI\(-> prints "red brick"\fR
inst m2              \fI\(-> prints "blue brick"\fR
.CE
.PP
.VS TIP478
This example shows how to create and use class variables. It is a class that
counts how many instances of itself have been made.
.PP
.CS
oo::class create Counted
\fBoo::define\fR Counted {
    \fBinitialise\fR {
        variable count 0
    }

    \fBvariable\fR number
    \fBconstructor\fR {} {
        classvariable count
        set number [incr count]
    }

    \fBmethod\fR report {} {
        classvariable count
        puts "This is instance $number of $count"
    }
}

set a [Counted new]
set b [Counted new]
$a report
        \fI\(-> This is instance 1 of 2\fR
set c [Counted new]
$b report
        \fI\(-> This is instance 2 of 3\fR
$c report
        \fI\(-> This is instance 3 of 3\fR
.CE
.PP
This example demonstrates how to use class methods. (Note that the constructor
for \fBoo::class\fR calls \fBoo::define\fR on the class.)
.PP
.CS
oo::class create DBTable {
    \fBclassmethod\fR find {description} {
        puts "DB: locate row from [self] matching $description"
        return [my new]
    }
    \fBclassmethod\fR insert {description} {
        puts "DB: create row in [self] matching $description"
        return [my new]
    }
    \fBmethod\fR update {description} {
        puts "DB: update row [self] with $description"
    }
    \fBmethod\fR delete {} {
        puts "DB: delete row [self]"
        my destroy; # Just delete the object, not the DB row
    }
}

oo::class create Users {
    \fBsuperclass\fR DBTable
}
oo::class create Groups {
    \fBsuperclass\fR DBTable
}

set u1 [Users insert "username=abc"]
        \fI\(-> DB: create row from ::Users matching username=abc\fR
set u2 [Users insert "username=def"]
        \fI\(-> DB: create row from ::Users matching username=def\fR
$u2 update "group=NULL"
        \fI\(-> DB: update row ::oo::Obj124 with group=NULL\fR
$u1 delete
        \fI\(-> DB: delete row ::oo::Obj123\fR
set g [Group find "groupname=webadmins"]
        \fI\(-> DB: locate row ::Group with groupname=webadmins\fR
$g update "emailaddress=admins"
        \fI\(-> DB: update row ::oo::Obj125 with emailaddress=admins\fR
.CE
.VE TIP478
.SH "SEE ALSO"
next(n), oo::class(n), oo::object(n)
.SH KEYWORDS
class, definition, method, object, slot
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Changes to doc/dict.n.
23
24
25
26
27
28
29





30
31
32
33
34
35
36
\fBdict append \fIdictionaryVariable key \fR?\fIstring ...\fR?
.
This appends the given string (or strings) to the value that the given
key maps to in the dictionary value contained in the given variable,
writing the resulting dictionary value back to that variable.
Non-existent keys are treated as if they map to an empty string. The
updated dictionary value is returned.





.TP
\fBdict create \fR?\fIkey value ...\fR?
.
Return a new dictionary that contains each of the key/value mappings
listed as arguments (keys and values alternating, with each key being
followed by its associated value.)
.TP







>
>
>
>
>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
\fBdict append \fIdictionaryVariable key \fR?\fIstring ...\fR?
.
This appends the given string (or strings) to the value that the given
key maps to in the dictionary value contained in the given variable,
writing the resulting dictionary value back to that variable.
Non-existent keys are treated as if they map to an empty string. The
updated dictionary value is returned.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the appending operation.
.VE TIP508
.TP
\fBdict create \fR?\fIkey value ...\fR?
.
Return a new dictionary that contains each of the key/value mappings
listed as arguments (keys and values alternating, with each key being
followed by its associated value.)
.TP
120
121
122
123
124
125
126





127
128
129
130
131
132
133
This adds the given increment value (an integer that defaults to 1 if
not specified) to the value that the given key maps to in the
dictionary value contained in the given variable, writing the
resulting dictionary value back to that variable. Non-existent keys
are treated as if they map to 0. It is an error to increment a value
for an existing key if that value is not an integer. The updated
dictionary value is returned.





.TP
\fBdict info \fIdictionaryValue\fR
.
This returns information (intended for display to people) about the
given dictionary though the format of this data is dependent on the
implementation of the dictionary. For dictionaries that are
implemented by hash tables, it is expected that this will return the







>
>
>
>
>







125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
This adds the given increment value (an integer that defaults to 1 if
not specified) to the value that the given key maps to in the
dictionary value contained in the given variable, writing the
resulting dictionary value back to that variable. Non-existent keys
are treated as if they map to 0. It is an error to increment a value
for an existing key if that value is not an integer. The updated
dictionary value is returned.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the incrementing operation.
.VE TIP508
.TP
\fBdict info \fIdictionaryValue\fR
.
This returns information (intended for display to people) about the
given dictionary though the format of this data is dependent on the
implementation of the dictionary. For dictionaries that are
implemented by hash tables, it is expected that this will return the
145
146
147
148
149
150
151





152
153
154
155
156
157
158
This appends the given items to the list value that the given key maps
to in the dictionary value contained in the given variable, writing
the resulting dictionary value back to that variable. Non-existent
keys are treated as if they map to an empty list, and it is legal for
there to be no items to append to the list. It is an error for the
value that the key maps to to not be representable as a list. The
updated dictionary value is returned.





.TP
\fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR
.
This command applies a transformation to each element of a dictionary,
returning a new dictionary. It takes three arguments: the first is a
two-element list of variable names (for the key and value respectively of each
mapping in the dictionary), the second the dictionary value to iterate across,







>
>
>
>
>







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
This appends the given items to the list value that the given key maps
to in the dictionary value contained in the given variable, writing
the resulting dictionary value back to that variable. Non-existent
keys are treated as if they map to an empty list, and it is legal for
there to be no items to append to the list. It is an error for the
value that the key maps to to not be representable as a list. The
updated dictionary value is returned.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the list-appending operation.
.VE TIP508
.TP
\fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR
.
This command applies a transformation to each element of a dictionary,
returning a new dictionary. It takes three arguments: the first is a
two-element list of variable names (for the key and value respectively of each
mapping in the dictionary), the second the dictionary value to iterate across,
202
203
204
205
206
207
208





209
210
211
212
213
214
215
216
217
218
219
220
221
222
223





224
225
226
227
228
229
230
231
232
233
234
235
236
237
238





239
240
241
242
243
244
245
\fBdict set \fIdictionaryVariable key \fR?\fIkey ...\fR? \fIvalue\fR
.
This operation takes the name of a variable containing a dictionary
value and places an updated dictionary value in that variable
containing a mapping from the given key to the given value. When
multiple keys are present, this operation creates or updates a chain
of nested dictionaries. The updated dictionary value is returned.





.TP
\fBdict size \fIdictionaryValue\fR
.
Return the number of key/value mappings in the given dictionary value.
.TP
\fBdict unset \fIdictionaryVariable key \fR?\fIkey ...\fR?
.
This operation (the companion to \fBdict set\fR) takes the name of a
variable containing a dictionary value and places an updated
dictionary value in that variable that does not contain a mapping for
the given key. Where multiple keys are present, this describes a path
through nested dictionaries to the mapping to remove. At least one key
must be specified, but the last key on the key-path need not exist.
All other components on the path must exist. The updated dictionary
value is returned.





.TP
\fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR
.
Execute the Tcl script in \fIbody\fR with the value for each \fIkey\fR
(as found by reading the dictionary value in \fIdictionaryVariable\fR)
mapped to the variable \fIvarName\fR. There may be multiple
\fIkey\fR/\fIvarName\fR pairs. If a \fIkey\fR does not have a mapping,
that corresponds to an unset \fIvarName\fR. When \fIbody\fR
terminates, any changes made to the \fIvarName\fRs is reflected back
to the dictionary within \fIdictionaryVariable\fR (unless
\fIdictionaryVariable\fR itself becomes unreadable, when all updates
are silently discarded), even if the result of \fIbody\fR is an error
or some other kind of exceptional exit. The result of \fBdict
update\fR is (unless some kind of error occurs) the result of the
evaluation of \fIbody\fR.





.RS
.PP
Each \fIvarName\fR is mapped in the scope enclosing the \fBdict update\fR;
it is recommended that this command only be used in a local scope
(\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
this, the variables set by \fBdict update\fR will continue to
exist after the command finishes (unless explicitly \fBunset\fR).







>
>
>
>
>















>
>
>
>
>















>
>
>
>
>







217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
\fBdict set \fIdictionaryVariable key \fR?\fIkey ...\fR? \fIvalue\fR
.
This operation takes the name of a variable containing a dictionary
value and places an updated dictionary value in that variable
containing a mapping from the given key to the given value. When
multiple keys are present, this operation creates or updates a chain
of nested dictionaries. The updated dictionary value is returned.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the value insert/update operation.
.VE TIP508
.TP
\fBdict size \fIdictionaryValue\fR
.
Return the number of key/value mappings in the given dictionary value.
.TP
\fBdict unset \fIdictionaryVariable key \fR?\fIkey ...\fR?
.
This operation (the companion to \fBdict set\fR) takes the name of a
variable containing a dictionary value and places an updated
dictionary value in that variable that does not contain a mapping for
the given key. Where multiple keys are present, this describes a path
through nested dictionaries to the mapping to remove. At least one key
must be specified, but the last key on the key-path need not exist.
All other components on the path must exist. The updated dictionary
value is returned.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the value remove operation.
.VE TIP508
.TP
\fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR
.
Execute the Tcl script in \fIbody\fR with the value for each \fIkey\fR
(as found by reading the dictionary value in \fIdictionaryVariable\fR)
mapped to the variable \fIvarName\fR. There may be multiple
\fIkey\fR/\fIvarName\fR pairs. If a \fIkey\fR does not have a mapping,
that corresponds to an unset \fIvarName\fR. When \fIbody\fR
terminates, any changes made to the \fIvarName\fRs is reflected back
to the dictionary within \fIdictionaryVariable\fR (unless
\fIdictionaryVariable\fR itself becomes unreadable, when all updates
are silently discarded), even if the result of \fIbody\fR is an error
or some other kind of exceptional exit. The result of \fBdict
update\fR is (unless some kind of error occurs) the result of the
evaluation of \fIbody\fR.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the update operation.
.VE TIP508
.RS
.PP
Each \fIvarName\fR is mapped in the scope enclosing the \fBdict update\fR;
it is recommended that this command only be used in a local scope
(\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
this, the variables set by \fBdict update\fR will continue to
exist after the command finishes (unless explicitly \fBunset\fR).
266
267
268
269
270
271
272





273
274
275
276
277
278
279
for the execution of \fIbody\fR. As with \fBdict update\fR, making
\fIdictionaryVariable\fR unreadable will make the updates to the
dictionary be discarded, and this also happens if the contents of
\fIdictionaryVariable\fR are adjusted so that the chain of
dictionaries no longer exists. The result of \fBdict with\fR is
(unless some kind of error occurs) the result of the evaluation of
\fIbody\fR.





.RS
.PP
The variables are mapped in the scope enclosing the \fBdict with\fR;
it is recommended that this command only be used in a local scope
(\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
this, the variables set by \fBdict with\fR will continue to
exist after the command finishes (unless explicitly \fBunset\fR).







>
>
>
>
>







296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
for the execution of \fIbody\fR. As with \fBdict update\fR, making
\fIdictionaryVariable\fR unreadable will make the updates to the
dictionary be discarded, and this also happens if the contents of
\fIdictionaryVariable\fR are adjusted so that the chain of
dictionaries no longer exists. The result of \fBdict with\fR is
(unless some kind of error occurs) the result of the evaluation of
\fIbody\fR.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the updating operation.
.VE TIP508
.RS
.PP
The variables are mapped in the scope enclosing the \fBdict with\fR;
it is recommended that this command only be used in a local scope
(\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
this, the variables set by \fBdict with\fR will continue to
exist after the command finishes (unless explicitly \fBunset\fR).
Changes to doc/eof.n.
55
56
57
58
59
60
61




    puts "Read record: $record"
}
.CE
.SH "SEE ALSO"
file(n), open(n), close(n), fblocked(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, end of file











>
>
>
>
55
56
57
58
59
60
61
62
63
64
65
    puts "Read record: $record"
}
.CE
.SH "SEE ALSO"
file(n), open(n), close(n), fblocked(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, end of file
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/exec.n.
212
213
214
215
216
217
218













219
220
221
222
223
224
225
.QW \fB@\0\fIfileId\fR
notation, does not work.  When reading from a socket, a 16-bit DOS
application will hang and a 32-bit application will return immediately with
end-of-file.  When either type of application writes to a socket, the
information is instead sent to the console, if one is present, or is
discarded.
.RS













.PP
The Tk console text widget does not provide real standard IO capabilities.
Under Tk, when redirecting from standard input, all applications will see an
immediate end-of-file; information redirected to standard output or standard
error will be discarded.
.PP
Either forward or backward slashes are accepted as path separators for







>
>
>
>
>
>
>
>
>
>
>
>
>







212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
.QW \fB@\0\fIfileId\fR
notation, does not work.  When reading from a socket, a 16-bit DOS
application will hang and a 32-bit application will return immediately with
end-of-file.  When either type of application writes to a socket, the
information is instead sent to the console, if one is present, or is
discarded.
.RS
.PP
Note that the current escape resp. quoting of arguments for windows works only
with executables using CommandLineToArgv, CRT-library or similar, as well as
with the windows batch files (excepting the newline, see below).
Although it is the common escape algorithm, but, in fact, the way how the
executable parses the command-line (resp. splits it into single arguments)
is decisive.
.PP
Unfortunately, there is currently no way to supply newline character within
an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command
processor (\fBcmd.exe /c\fR), because this causes truncation of command-line
(also the argument chain) on the first newline character.
But it works properly with an executable (using CommandLineToArgv, etc).
.PP
The Tk console text widget does not provide real standard IO capabilities.
Under Tk, when redirecting from standard input, all applications will see an
immediate end-of-file; information redirected to standard output or standard
error will be discarded.
.PP
Either forward or backward slashes are accepted as path separators for
405
406
407
408
409
410
411




412
413
414
415
416
417
418
.CS
\fBexec\fR cmp.bat somefile.c -o somefile
.CE
.PP
With the file \fIcmp.bat\fR looking something like:
.PP
.CS




@gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
.CE
.SS "WORKING WITH COMMAND BUILT-INS"
.PP
Sometimes you need to be careful, as different programs may have the
same name and be in the path. It can then happen that typing a command
at the DOS prompt finds \fIa different program\fR than the same







>
>
>
>







418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
.CS
\fBexec\fR cmp.bat somefile.c -o somefile
.CE
.PP
With the file \fIcmp.bat\fR looking something like:
.PP
.CS
@gcc %*
.CE
or like another variant using single parameters:
.CS
@gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
.CE
.SS "WORKING WITH COMMAND BUILT-INS"
.PP
Sometimes you need to be careful, as different programs may have the
same name and be in the path. It can then happen that typing a command
at the DOS prompt finds \fIa different program\fR than the same
Changes to doc/exit.n.
45
46
47
48
49
50
51




    \fBexit\fR 2
}
.CE
.SH "SEE ALSO"
exec(n)
.SH KEYWORDS
abort, exit, process











>
>
>
>
45
46
47
48
49
50
51
52
53
54
55
    \fBexit\fR 2
}
.CE
.SH "SEE ALSO"
exec(n)
.SH KEYWORDS
abort, exit, process
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/fblocked.n.
61
62
63
64
65
66
67




socket -server connect 12345
vwait forever
.CE
.SH "SEE ALSO"
gets(n), open(n), read(n), socket(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, nonblocking











>
>
>
>
61
62
63
64
65
66
67
68
69
70
71
socket -server connect 12345
vwait forever
.CE
.SH "SEE ALSO"
gets(n), open(n), read(n), socket(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, nonblocking
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/fileevent.n.
150
151
152
153
154
155
156




\fBfileevent\fR is based on the \fBaddinput\fR command created
by Mark Diekhans.
.SH "SEE ALSO"
fconfigure(n), gets(n), interp(n), puts(n), read(n), Tcl_StandardChannels(3)
.SH KEYWORDS
asynchronous I/O, blocking, channel, event handler, nonblocking, readable,
script, writable.











>
>
>
>
150
151
152
153
154
155
156
157
158
159
160
\fBfileevent\fR is based on the \fBaddinput\fR command created
by Mark Diekhans.
.SH "SEE ALSO"
fconfigure(n), gets(n), interp(n), puts(n), read(n), Tcl_StandardChannels(3)
.SH KEYWORDS
asynchronous I/O, blocking, channel, event handler, nonblocking, readable,
script, writable.
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/filename.n.
172
173
174
175
176
177
178




.QW .....abc
is illegal.
.SH "SEE ALSO"
file(n), glob(n)
.SH KEYWORDS
current directory, absolute file name, relative file name,
volume-relative file name, portability











>
>
>
>
172
173
174
175
176
177
178
179
180
181
182
.QW .....abc
is illegal.
.SH "SEE ALSO"
file(n), glob(n)
.SH KEYWORDS
current directory, absolute file name, relative file name,
volume-relative file name, portability
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/flush.n.
39
40
41
42
43
44
45




gets stdin name
puts "Hello there, $name!"
.CE
.SH "SEE ALSO"
file(n), open(n), socket(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, buffer, channel, flush, nonblocking, output











>
>
>
>
39
40
41
42
43
44
45
46
47
48
49
gets stdin name
puts "Hello there, $name!"
.CE
.SH "SEE ALSO"
file(n), open(n), socket(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, buffer, channel, flush, nonblocking, output
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/foreach.n.
98
99
100
101
102
103
104




.CE

.SH "SEE ALSO"
for(n), while(n), break(n), continue(n)

.SH KEYWORDS
foreach, iteration, list, loop











>
>
>
>
98
99
100
101
102
103
104
105
106
107
108
.CE

.SH "SEE ALSO"
for(n), while(n), break(n), continue(n)

.SH KEYWORDS
foreach, iteration, list, loop
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/global.n.
52
53
54
55
56
57
58




    append accumulator $string \en
}
.CE
.SH "SEE ALSO"
namespace(n), upvar(n), variable(n)
.SH KEYWORDS
global, namespace, procedure, variable











>
>
>
>
52
53
54
55
56
57
58
59
60
61
62
    append accumulator $string \en
}
.CE
.SH "SEE ALSO"
namespace(n), upvar(n), variable(n)
.SH KEYWORDS
global, namespace, procedure, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/history.n.
96
97
98
99
100
101
102




is modified to eliminate the history command and replace it with
the result of the history command.
If you want to redo an event without modifying history, then use
the \fBevent\fR operation to retrieve some event,
and the \fBadd\fR operation to add it to history and execute it.
.SH KEYWORDS
event, history, record











>
>
>
>
96
97
98
99
100
101
102
103
104
105
106
is modified to eliminate the history command and replace it with
the result of the history command.
If you want to redo an event without modifying history, then use
the \fBevent\fR operation to retrieve some event,
and the \fBadd\fR operation to add it to history and execute it.
.SH KEYWORDS
event, history, record
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/http.n.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23


24
25
26
27
28
29
30
'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 by Ajuba Solutions.
'\" Copyright (c) 2004 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "http" n 2.7 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
http \- Client-side implementation of the HTTP/1.1 protocol
.SH SYNOPSIS
\fBpackage require http ?2.7?\fR
.\" See Also -useragent option documentation in body!
.sp
\fB::http::config ?\fI\-option value\fR ...?
.sp
\fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...?
.sp
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?


.sp
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
.sp
\fB::http::wait \fItoken\fR
.sp
\fB::http::status \fItoken\fR
.sp








|






|


|




>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 by Ajuba Solutions.
'\" Copyright (c) 2004 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "http" n 2.9 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
http \- Client-side implementation of the HTTP/1.1 protocol
.SH SYNOPSIS
\fBpackage require http\fI ?\fB2.8\fR?
.\" See Also -useragent option documentation in body!
.sp
\fB::http::config\fR ?\fI\-option value\fR ...?
.sp
\fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...?
.sp
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
.sp
\fB::http::quoteString\fR \fIvalue\fR
.sp
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
.sp
\fB::http::wait \fItoken\fR
.sp
\fB::http::status \fItoken\fR
.sp
40
41
42
43
44
45
46


47
48
49
50
51
52
53
54
55
56
57
58
59
.sp
\fB::http::error \fItoken\fR
.sp
\fB::http::cleanup \fItoken\fR
.sp
\fB::http::register \fIproto port command\fR
.sp


\fB::http::unregister \fIproto\fR
.BE
.SH DESCRIPTION
.PP
The \fBhttp\fR package provides the client side of the HTTP/1.1
protocol, as defined in RFC 2616.
The package implements the GET, POST, and HEAD operations
of HTTP/1.1.  It allows configuration of a proxy host to get through
firewalls.  The package is compatible with the \fBSafesock\fR security
policy, so it can be used by untrusted applets to do URL fetching from
a restricted set of hosts. This package can be extended to support
additional HTTP transport protocols, such as HTTPS, by providing
a custom \fBsocket\fR command, via \fB::http::register\fR.







>
>





|







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
.sp
\fB::http::error \fItoken\fR
.sp
\fB::http::cleanup \fItoken\fR
.sp
\fB::http::register \fIproto port command\fR
.sp
\fB::http::registerError \fIport\fR ?\fImessage\fR?
.sp
\fB::http::unregister \fIproto\fR
.BE
.SH DESCRIPTION
.PP
The \fBhttp\fR package provides the client side of the HTTP/1.1
protocol, as defined in RFC 7230 to RFC 7235, which supersede RFC 2616.
The package implements the GET, POST, and HEAD operations
of HTTP/1.1.  It allows configuration of a proxy host to get through
firewalls.  The package is compatible with the \fBSafesock\fR security
policy, so it can be used by untrusted applets to do URL fetching from
a restricted set of hosts. This package can be extended to support
additional HTTP transport protocols, such as HTTPS, by providing
a custom \fBsocket\fR command, via \fB::http::register\fR.
90
91
92
93
94
95
96













97
98
99
100
101
102
103
\fB\-accept\fR \fImimetypes\fR
.
The Accept header of the request.  The default is */*, which means that
all types of documents are accepted.  Otherwise you can supply a
comma-separated list of mime type patterns that you are
willing to receive.  For example,
.QW "image/gif, image/jpeg, text/*" .













.TP
\fB\-proxyhost\fR \fIhostname\fR
.
The name of the proxy host, if any.  If this value is the
empty string, the URL host is contacted directly.
.TP
\fB\-proxyport\fR \fInumber\fR







>
>
>
>
>
>
>
>
>
>
>
>
>







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
\fB\-accept\fR \fImimetypes\fR
.
The Accept header of the request.  The default is */*, which means that
all types of documents are accepted.  Otherwise you can supply a
comma-separated list of mime type patterns that you are
willing to receive.  For example,
.QW "image/gif, image/jpeg, text/*" .
.TP
\fB\-pipeline\fR \fIboolean\fR
.
Specifies whether HTTP/1.1 transactions on a persistent socket will be
pipelined.  See the \fBPERSISTENT SOCKETS\fR section for details. The default
is 1.
.TP
\fB\-postfresh\fR \fIboolean\fR
.
Specifies whether requests that use the \fBPOST\fR method will always use a
fresh socket, overriding the \fB-keepalive\fR option of
command \fBhttp::geturl\fR.  See the \fBPERSISTENT SOCKETS\fR section for details.
The default is 0.
.TP
\fB\-proxyhost\fR \fIhostname\fR
.
The name of the proxy host, if any.  If this value is the
empty string, the URL host is contacted directly.
.TP
\fB\-proxyport\fR \fInumber\fR
111
112
113
114
115
116
117












118
119
120
121

122
123
124
125
126
127
128
129
130
131










132




133
134
135
136
137
138
139
to determine if a proxy is required for a given host.  One argument, a
host name, is added to \fIcommand\fR when it is invoked.  If a proxy
is required, the callback should return a two-element list containing
the proxy server and proxy port.  Otherwise the filter should return
an empty list.  The default filter returns the values of the
\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
non-empty.












.TP
\fB\-urlencoding\fR \fIencoding\fR
.
The \fIencoding\fR used for creating the x-url-encoded URLs with

\fB::http::formatQuery\fR.  The default is \fButf-8\fR, as specified by RFC
2718.  Prior to http 2.5 this was unspecified, and that behavior can be
returned by specifying the empty string (\fB{}\fR), although
\fIiso8859-1\fR is recommended to restore similar behavior but without the
\fB::http::formatQuery\fR throwing an error processing non-latin-1
characters.
.TP
\fB\-useragent\fR \fIstring\fR
.
The value of the User-Agent header in the HTTP request.  The default is










.QW "\fBTcl http client package 2.7\fR" .




.RE
.TP
\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
.
The \fB::http::geturl\fR command is the main procedure in the package.
The \fB\-query\fR option causes a POST operation and
the \fB\-validate\fR option causes a HEAD operation;







>
>
>
>
>
>
>
>
>
>
>
>




>
|



|
|



|
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>







128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
to determine if a proxy is required for a given host.  One argument, a
host name, is added to \fIcommand\fR when it is invoked.  If a proxy
is required, the callback should return a two-element list containing
the proxy server and proxy port.  Otherwise the filter should return
an empty list.  The default filter returns the values of the
\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
non-empty.
.TP
\fB\-repost\fR \fIboolean\fR
.
Specifies what to do if a POST request over a persistent connection fails
because the server has half-closed the connection.  If boolean \fBtrue\fR, the
request
will be automatically retried; if boolean \fBfalse\fR it will not, and the
application
that uses \fBhttp::geturl\fR is expected to seek user confirmation before
retrying the POST.  The value \fBtrue\fR should be used only under certain
conditions. See the \fBPERSISTENT SOCKETS\fR section for details. The
default is 0.
.TP
\fB\-urlencoding\fR \fIencoding\fR
.
The \fIencoding\fR used for creating the x-url-encoded URLs with
\fB::http::formatQuery\fR and \fB::http::quoteString\fR.
The default is \fButf-8\fR, as specified by RFC
2718.  Prior to http 2.5 this was unspecified, and that behavior can be
returned by specifying the empty string (\fB{}\fR), although
\fIiso8859-1\fR is recommended to restore similar behavior but without the
\fB::http::formatQuery\fR or \fB::http::quoteString\fR
throwing an error processing non-latin-1 characters.
.TP
\fB\-useragent\fR \fIstring\fR
.
The value of the User-Agent header in the HTTP request.  In an unsafe
interpreter, the default value depends upon the operating system, and
the version numbers of \fBhttp\fR and \fBTcl\fR, and is (for example)
.QW "\fBMozilla/5.0 (Windows; U; Windows NT 10.0) http/2.8.12 Tcl/8.6.8\fR" .
A safe interpreter cannot determine its operating system, and so the default
in a safe interpreter is to use a Windows 10 value with the current version
numbers of \fBhttp\fR and \fBTcl\fR.
.TP
\fB\-zip\fR \fIboolean\fR
.
If the value is boolean \fBtrue\fR, then by default requests will send a header
.QW "\fBAccept-Encoding: gzip,deflate,compress\fR" .
If the value is boolean \fBfalse\fR, then by default this header will not be sent.
In either case the default can be overridden for an individual request by
supplying a custom \fBAccept-Encoding\fR header in the \fB-headers\fR option
of \fBhttp::geturl\fR. The default is 1.
.RE
.TP
\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
.
The \fB::http::geturl\fR command is the main procedure in the package.
The \fB\-query\fR option causes a POST operation and
the \fB\-validate\fR option causes a HEAD operation;
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
.CS
Pragma: no-cache
.CE
.RE
.TP
\fB\-keepalive\fR \fIboolean\fR
.
If true, attempt to keep the connection open for servicing
multiple requests.  Default is 0.
.TP
\fB\-method\fR \fItype\fR
.
Force the HTTP request method to \fItype\fR. \fB::http::geturl\fR will
auto-select GET, POST or HEAD based on other options, but this option
enables choices like PUT and DELETE for webdav support.







|







267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
.CS
Pragma: no-cache
.CE
.RE
.TP
\fB\-keepalive\fR \fIboolean\fR
.
If boolean \fBtrue\fR, attempt to keep the connection open for servicing
multiple requests.  Default is 0.
.TP
\fB\-method\fR \fItype\fR
.
Force the HTTP request method to \fItype\fR. \fB::http::geturl\fR will
auto-select GET, POST or HEAD based on other options, but this option
enables choices like PUT and DELETE for webdav support.
329
330
331
332
333
334
335





336
337
338
339
340
341
342
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
.
This procedure does x-url-encoding of query data.  It takes an even
number of arguments that are the keys and values of the query.  It
encodes the keys and values, and generates one string that has the
proper & and = separators.  The result is suitable for the
\fB\-query\fR value passed to \fB::http::geturl\fR.





.TP
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
.
This command resets the HTTP transaction identified by \fItoken\fR, if any.
This sets the \fBstate(status)\fR value to \fIwhy\fR, which defaults to
\fBreset\fR, and then calls the registered \fB\-command\fR callback.
.TP







>
>
>
>
>







373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
.
This procedure does x-url-encoding of query data.  It takes an even
number of arguments that are the keys and values of the query.  It
encodes the keys and values, and generates one string that has the
proper & and = separators.  The result is suitable for the
\fB\-query\fR value passed to \fB::http::geturl\fR.
.TP
\fB::http::quoteString\fR \fIvalue\fR
.
This procedure does x-url-encoding of string.  It takes a single argument and
encodes it.
.TP
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
.
This command resets the HTTP transaction identified by \fItoken\fR, if any.
This sets the \fBstate(status)\fR value to \fIwhy\fR, which defaults to
\fBreset\fR, and then calls the registered \fB\-command\fR callback.
.TP
410
411
412
413
414
415
416











417
418
419
420
421
422
423
package require tls

::http::register https 443 ::tls::socket

set token [::http::geturl https://my.secure.site/]
.CE
.RE











.TP
\fB::http::unregister\fR \fIproto\fR
.
This procedure unregisters a protocol handler that was previously
registered via \fB::http::register\fR, returning a two-item list of
the default port and handler command that was previously installed
(via \fB::http::register\fR) if there was such a handler, and an error if







>
>
>
>
>
>
>
>
>
>
>







459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
package require tls

::http::register https 443 ::tls::socket

set token [::http::geturl https://my.secure.site/]
.CE
.RE
.TP
\fB::http::registerError\fR \fIport\fR ?\fImessage\fR?
.
This procedure allows a registered protocol handler to deliver an error
message for use by \fBhttp\fR.  Calling this command does not raise an
error. The command is useful when a registered protocol detects an problem
(for example, an invalid TLS certificate) that will cause an error to
propagate to \fBhttp\fR.  The command allows \fBhttp\fR to provide a
precise error message rather than a general one.  The command returns the
value provided by the last call with argument \fImessage\fR, or the empty
string if no such call has been made.
.TP
\fB::http::unregister\fR \fIproto\fR
.
This procedure unregisters a protocol handler that was previously
registered via \fB::http::register\fR, returning a two-item list of
the default port and handler command that was previously installed
(via \fB::http::register\fR) if there was such a handler, and an error if
500
501
502
503
504
505
506








507
508
509
510
511
512
513
Once the data associated with the URL is no longer needed, the state
array should be unset to free up storage.
The \fB::http::cleanup\fR procedure is provided for that purpose.
The following elements of
the array are supported:
.RS
.TP








\fBbody\fR
.
The contents of the URL.  This will be empty if the \fB\-channel\fR
option has been specified.  This value is returned by the \fB::http::data\fR command.
.TP
\fBcharset\fR
.







>
>
>
>
>
>
>
>







560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
Once the data associated with the URL is no longer needed, the state
array should be unset to free up storage.
The \fB::http::cleanup\fR procedure is provided for that purpose.
The following elements of
the array are supported:
.RS
.TP
\fBbinary\fR
.
This is boolean \fBtrue\fR if (after decoding any compression specified
by the
.QW "Content-Encoding"
response header) the HTTP response is binary.  It is boolean \fBfalse\fR
if the HTTP response is text.
.TP
\fBbody\fR
.
The contents of the URL.  This will be empty if the \fB\-channel\fR
option has been specified.  This value is returned by the \fB::http::data\fR command.
.TP
\fBcharset\fR
.
598
599
600
601
602
603
604




































































































605
606
607
608
609
610
611
.
A copy of the \fBContent-Type\fR meta-data value.
.TP
\fBurl\fR
.
The requested URL.
.RE




































































































.SH EXAMPLE
.PP
This example creates a procedure to copy a URL to a file while printing a
progress meter, and prints the meta-data associated with the URL.
.PP
.CS
proc httpcopy { url file {chunk 4096} } {







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
.
A copy of the \fBContent-Type\fR meta-data value.
.TP
\fBurl\fR
.
The requested URL.
.RE
.SH "PERSISTENT CONNECTIONS"
.PP
.SS "BASICS"
.PP
See RFC 7230 Sec 6, which supersedes RFC 2616 Sec 8.1.
.PP
A persistent connection allows multiple HTTP/1.1 transactions to be
carried over the same TCP connection.  Pipelining allows a
client to make multiple requests over a persistent connection without
waiting for each response.  The server sends responses in the same order
that the requests were received.
.PP
If a POST request fails to complete, typically user confirmation is
needed before sending the request again.  The user may wish to verify
whether the server was modified by the failed POST request, before
sending the same request again.
.PP
A HTTP request will use a persistent socket if the call to
\fBhttp::geturl\fR has the option \fB-keepalive true\fR. It will use
pipelining where permitted if the \fBhttp::config\fR option
\fB-pipeline\fR is boolean \fBtrue\fR (its default value).
.PP
The http package maintains no more than one persistent connection to each
server (i.e. each value of
.QW "domain:port" ).
If \fBhttp::geturl\fR is called to make a request over a persistent
connection while the connection is busy with another request, the new
request will be held in a queue until the connection is free.
.PP
The http package does not support HTTP/1.0 persistent connections
controlled by the \fBKeep-Alive\fR header.
.SS "SPECIAL CASES"
.PP
This subsection discusses issues related to closure of the
persistent connection by the server, automatic retry of failed requests,
the special treatment necessary for POST requests, and the options for
dealing with these cases.
.PP
In accordance with RFC 7230, \fBhttp::geturl\fR does not pipeline
requests that use the POST method.  If a POST uses a persistent
connection and is not the first request on that connection,
\fBhttp::geturl\fR waits until it has received the response for the previous
request; or (if \fBhttp::config\fR option \fB-postfresh\fR is boolean \fBtrue\fR) it
uses a new connection for each POST.
.PP
If the server is processing a number of pipelined requests, and sends a
response header
.QW "\fBConnection: close\fR"
with one of the responses (other than the last), then subsequent responses
are unfulfilled. \fBhttp::geturl\fR will send the unfulfilled requests again
over a new connection.
.PP
A difficulty arises when a HTTP client sends a request over a persistent
connection that has been idle for a while.  The HTTP server may
half-close an apparently idle connection while the client is sending a
request, but before the request arrives at the server: in this case (an
.QW "asynchronous close event" )
the request will fail.  The difficulty arises because the client cannot
be certain whether the POST modified the state of the server.  For HEAD or
GET requests, \fBhttp::geturl\fR opens another connection and retransmits
the failed request. However, if the request was a POST, RFC 7230 forbids
automatic retry by default, suggesting either user confirmation, or
confirmation by user-agent software that has semantic understanding of
the application.  The \fBhttp::config\fR option \fB-repost\fR allows for
either possibility.
.PP
Asynchronous close events can occur only in a short interval of time.  The
\fBhttp\fR package monitors each persistent connection for closure by the
server.  Upon detection, the connection is also closed at the client end,
and subsequent requests will use a fresh connection.
.PP
If the \fBhttp::geturl\fR command is called with option \fB-keepalive true\fR,
then it will both try to use an existing persistent connection
(if one is available), and it will send the server a
.QW "\fBConnection: keep-alive\fR"
request header asking to keep the connection open for future requests.
.PP
The \fBhttp::config\fR options \fB-pipeline\fR, \fB-postfresh\fR, and
\fB-repost\fR relate to persistent connections.
.PP
Option \fB-pipeline\fR, if boolean \fBtrue\fR, will pipeline GET and HEAD requests
made
over a persistent connection.  POST requests will not be pipelined - if the
POST is not the first transaction on the connection, its request will not
be sent until the previous response has finished.  GET and HEAD requests
made after a POST will not be sent until the POST response has been
delivered, and will not be sent if the POST fails.
.PP
Option \fB-postfresh\fR, if boolean \fBtrue\fR, will override the \fBhttp::geturl\fR option
\fB-keepalive\fR, and always open a fresh connection for a POST request.
.PP
Option \fB-repost\fR, if \fBtrue\fR, permits automatic retry of a POST request
that fails because it uses a persistent connection that the server has
half-closed (an
.QW "asynchronous close event" ).
Subsequent GET and HEAD requests in a failed pipeline will also be retried.
\fIThe -repost option should be used only if the application understands
that the retry is appropriate\fR - specifically, the application must know
that if the failed POST successfully modified the state of the server, a repeat POST
would have no adverse effect.
.SH EXAMPLE
.PP
This example creates a procedure to copy a URL to a file while printing a
progress meter, and prints the meta-data associated with the URL.
.PP
.CS
proc httpcopy { url file {chunk 4096} } {
Changes to doc/incr.n.
23
24
25
26
27
28
29





30
31
32
33
34
35
36
1 is added to \fIvarName\fR.
The new value is stored as a decimal string in variable \fIvarName\fR
and also returned as result.
.PP
Starting with the Tcl 8.5 release, the variable \fIvarName\fR passed
to \fBincr\fR may be unset, and in that case, it will be set to
the value \fIincrement\fR or to the default increment value of \fB1\fR.





.SH EXAMPLES
.PP
Add one to the contents of the variable \fIx\fR:
.PP
.CS
\fBincr\fR x
.CE







>
>
>
>
>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
1 is added to \fIvarName\fR.
The new value is stored as a decimal string in variable \fIvarName\fR
and also returned as result.
.PP
Starting with the Tcl 8.5 release, the variable \fIvarName\fR passed
to \fBincr\fR may be unset, and in that case, it will be set to
the value \fIincrement\fR or to the default increment value of \fB1\fR.
.VS TIP508
If \fIvarName\fR indicate an element that does not exist of an array that has
a default value set, the sum of the default value and the \fIincrement\fR (or
1) will be stored in the array element.
.VE TIP508
.SH EXAMPLES
.PP
Add one to the contents of the variable \fIx\fR:
.PP
.CS
\fBincr\fR x
.CE
55
56
57
58
59
60
61




.CS
\fBincr\fR x 0
.CE
.SH "SEE ALSO"
expr(n), set(n)
.SH KEYWORDS
add, increment, variable, value











>
>
>
>
60
61
62
63
64
65
66
67
68
69
70
.CS
\fBincr\fR x 0
.CE
.SH "SEE ALSO"
expr(n), set(n)
.SH KEYWORDS
add, increment, variable, value
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Changes to doc/info.n.
39
40
41
42
43
44
45




































46
47
48
49
50
51
52
Returns information about the class, \fIclass\fR. The \fIsubcommand\fRs are
described in \fBCLASS INTROSPECTION\fR below.
.TP
\fBinfo cmdcount\fR
.
Returns a count of the total number of commands that have been invoked
in this interpreter.




































.TP
\fBinfo commands \fR?\fIpattern\fR?
.
If \fIpattern\fR is not specified,
returns a list of names of all the Tcl commands visible
(i.e. executable without using a qualified name) to the current namespace,
including both the built-in commands written in C and







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Returns information about the class, \fIclass\fR. The \fIsubcommand\fRs are
described in \fBCLASS INTROSPECTION\fR below.
.TP
\fBinfo cmdcount\fR
.
Returns a count of the total number of commands that have been invoked
in this interpreter.
.TP
\fBinfo cmdtype \fIcommandName\fR
.VS TIP426
Returns a description of the kind of command named by \fIcommandName\fR.  The
supported types are:
.RS
.IP \fBalias\fR
Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. Note that
safe interpreters can only see a subset of aliases (specifically those between
two commands within themselves).
.IP \fBcoroutine\fR
Indicates that \fIcommandName\fR was created by \fBcoroutine\fR.
.IP \fBensemble\fR
Indicates that \fIcommandName\fR was created by \fBnamespace ensemble\fR.
.IP \fBimport\fR
Indicates that \fIcommandName\fR was created by \fBnamespace import\fR.
.IP \fBnative\fR
Indicates that \fIcommandName\fR was created by the \fBTcl_CreateObjProc\fR
interface directly without further registration of the type of command.
.IP \fBobject\fR
Indicates that \fIcommandName\fR is the public command that represents an
instance of \fBoo::object\fR or one of its subclasses.
.IP \fBprivateObject\fR
Indicates that \fIcommandName\fR is the private command (\fBmy\fR by default)
that represents an instance of \fBoo::object\fR or one of its subclasses.
.IP \fBproc\fR
Indicates that \fIcommandName\fR was created by \fBproc\fR.
.IP \fBslave\fR
Indicates that \fIcommandName\fR was created by \fBinterp create\fR.
.IP \fBzlibStream\fR
Indicates that \fIcommandName\fR was created by \fBzlib stream\fR.
.PP
There may be other registered types as well; this is a set that is extensible
at the implementation level with \fBTcl_RegisterCommandTypeName\fR.
.RE
.VE TIP426
.TP
\fBinfo commands \fR?\fIpattern\fR?
.
If \fIpattern\fR is not specified,
returns a list of names of all the Tcl commands visible
(i.e. executable without using a qualified name) to the current namespace,
including both the built-in commands written in C and
Changes to doc/interp.n.
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
execution of all commands.
.PP
Note that once it is on, this flag cannot be switched back off: such
attempts are silently ignored. This is needed to maintain the
consistency of the underlying interpreter's state.
.RE
.TP
\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
.
Deletes zero or more interpreters given by the optional \fIpath\fR
arguments, and for each interpreter, it also deletes its slaves. The
command also deletes the slave command for each interpreter deleted.
For each \fIpath\fR argument, if no interpreter by that name
exists, the command raises an error.
.TP







|







232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
execution of all commands.
.PP
Note that once it is on, this flag cannot be switched back off: such
attempts are silently ignored. This is needed to maintain the
consistency of the underlying interpreter's state.
.RE
.TP
\fBinterp\fR \fBdelete \fR?\fIpath ...\fR?
.
Deletes zero or more interpreters given by the optional \fIpath\fR
arguments, and for each interpreter, it also deletes its slaves. The
command also deletes the slave command for each interpreter deleted.
For each \fIpath\fR argument, if no interpreter by that name
exists, the command raises an error.
.TP
Changes to doc/join.n.
38
39
40
41
42
43
44




\fBjoin\fR $data
     \fB\(-> 1 2 3 4 5 {6 7} 8\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), split(n)
.SH KEYWORDS
element, join, list, separator











>
>
>
>
38
39
40
41
42
43
44
45
46
47
48
\fBjoin\fR $data
     \fB\(-> 1 2 3 4 5 {6 7} 8\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), split(n)
.SH KEYWORDS
element, join, list, separator
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/lappend.n.
18
19
20
21
22
23
24






25
26
27
28
29
30
31
.SH DESCRIPTION
.PP
This command treats the variable given by \fIvarName\fR as a list
and appends each of the \fIvalue\fR arguments to that list as a separate
element, with spaces between elements.
If \fIvarName\fR does not exist, it is created as a list with elements
given by the \fIvalue\fR arguments.






\fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs
are appended as list elements rather than raw text.
This command provides a relatively efficient way to build up
large lists.  For example,
.QW "\fBlappend a $b\fR"
is much more efficient than
.QW "\fBset a [concat $a [list $b]]\fR"







>
>
>
>
>
>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
.SH DESCRIPTION
.PP
This command treats the variable given by \fIvarName\fR as a list
and appends each of the \fIvalue\fR arguments to that list as a separate
element, with spaces between elements.
If \fIvarName\fR does not exist, it is created as a list with elements
given by the \fIvalue\fR arguments.
.VS TIP508
If \fIvarName\fR indicate an element that does not exist of an array that has
a default value set, list that is comprised of the default value with all the
\fIvalue\fR arguments appended as elements will be stored in the array
element.
.VE TIP508
\fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs
are appended as list elements rather than raw text.
This command provides a relatively efficient way to build up
large lists.  For example,
.QW "\fBlappend a $b\fR"
is much more efficient than
.QW "\fBset a [concat $a [list $b]]\fR"
43
44
45
46
47
48
49




1 2 3 4 5
.CE
.SH "SEE ALSO"
list(n), lindex(n), linsert(n), llength(n), lset(n),
lsort(n), lrange(n)
.SH KEYWORDS
append, element, list, variable











>
>
>
>
49
50
51
52
53
54
55
56
57
58
59
1 2 3 4 5
.CE
.SH "SEE ALSO"
list(n), lindex(n), linsert(n), llength(n), lset(n),
lsort(n), lrange(n)
.SH KEYWORDS
append, element, list, variable
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Changes to doc/lindex.n.
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
.TH lindex n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lindex \- Retrieve an element from a list
.SH SYNOPSIS
\fBlindex \fIlist ?index ...?\fR
.BE
.SH DESCRIPTION
.PP
The \fBlindex\fR command accepts a parameter, \fIlist\fR, which
it treats as a Tcl list. It also accepts zero or more \fIindices\fR into
the list.  The indices may be presented either consecutively on the
command line, or grouped in a







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
.TH lindex n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lindex \- Retrieve an element from a list
.SH SYNOPSIS
\fBlindex \fIlist\fR ?\fIindex ...\fR?
.BE
.SH DESCRIPTION
.PP
The \fBlindex\fR command accepts a parameter, \fIlist\fR, which
it treats as a Tcl list. It also accepts zero or more \fIindices\fR into
the list.  The indices may be presented either consecutively on the
command line, or grouped in a
Added doc/link.n.
























































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
'\"
'\" Copyright (c) 2011-2015 Andreas Kupries
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH link n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
link \- create link from command to method of object
.SH SYNOPSIS
.nf
package require TclOO

\fBlink\fR \fImethodName\fR ?\fI...\fR?
\fBlink\fR \fB{\fIcommandName methodName\fB}\fR ?\fI...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBlink\fR command is available within methods. It takes a series of one
or more method names (\fImethodName ...\fR) and/or pairs of command- and
method-name (\fB{\fIcommandName methodName\fB}\fR) and makes the named methods
available as commands without requiring the explicit use of the name of the
object or the \fBmy\fR command. The method does not need to exist at the time
that the link is made; if the link command is invoked when the method does not
exist, the standard \fBunknown\fR method handling system is used.
.PP
The command name under which the method becomes available defaults to the
method name, except where explicitly specified through an alias/method pair.
Formally, every argument must be a list; if the list has two elements, the
first element is the name of the command to create and the second element is
the name of the method of the current object to which the command links;
otherwise, the name of the command and the name of the method are the same
string (the first element of the list).
.PP
If the name of the command is not a fully-qualified command name, it will be
resolved with respect to the current namespace (i.e., the object namespace).
.SH EXAMPLES
This demonstrates linking a single method in various ways. First it makes a
simple link, then a renamed link, then an external link. Note that the method
itself is unexported, but that it can still be called directly from outside
the class.
.PP
.CS
oo::class create ABC {
    method Foo {} {
        puts "This is Foo in [self]"
    }

    constructor {} {
        \fBlink\fR Foo
        # The method foo is now directly accessible as foo here
        \fBlink\fR {bar Foo}
        # The method foo is now directly accessible as bar
        \fBlink\fR {::ExternalCall Foo}
        # The method foo is now directly accessible in the global
        # namespace as ExternalCall
    }

    method grill {} {
        puts "Step 1:"
        Foo
        puts "Step 2:"
        bar
    }
}

ABC create abc
abc grill
        \fI\(-> Step 1:\fR
        \fI\(-> This is foo in ::abc\fR
        \fI\(-> Step 2:\fR
        \fI\(-> This is foo in ::abc\fR
# Direct access via the linked command
puts "Step 3:"; ExternalCall
        \fI\(-> Step 3:\fR
        \fI\(-> This is foo in ::abc\fR
.CE
.PP
This example shows that multiple linked commands can be made in a call to
\fBlink\fR, and that they can handle arguments.
.PP
.CS
oo::class create Ex {
    constructor {} {
        \fBlink\fR a b c
        # The methods a, b, and c (defined below) are all now
        # directly acessible within methods under their own names.
    }

    method a {} {
        puts "This is a"
    }
    method b {x} {
        puts "This is b($x)"
    }
    method c {y z} {
        puts "This is c($y,$z)"
    }

    method call {p q r} {
        a
        b $p
        c $q $r
    }
}

set o [Ex new]
$o 3 5 7
        \fI\(-> This is a\fR
        \fI\(-> This is b(3)\fR
        \fI\(-> This is c(5,7)\fR
.CE
.SH "SEE ALSO"
interp(n), my(n), oo::class(n), oo::define(n)
.SH KEYWORDS
command, method, object
.\" Local Variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Changes to doc/llength.n.
49
50
51
52
53
54
55




1,0
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), lsearch(n),
lset(n), lsort(n), lrange(n), lreplace(n)
.SH KEYWORDS
element, list, length











>
>
>
>
49
50
51
52
53
54
55
56
57
58
59
1,0
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), lsearch(n),
lset(n), lsort(n), lrange(n), lreplace(n)
.SH KEYWORDS
element, list, length
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/load.n.
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
.SH EXAMPLE
.PP
The following is a minimal extension:
.PP
.CS
#include <tcl.h>
#include <stdio.h>
static int fooCmd(ClientData clientData,
        Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    printf("called with %d arguments\en", objc);
    return TCL_OK;
}
int Foo_Init(Tcl_Interp *interp) {
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
	return TCL_ERROR;







|







150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
.SH EXAMPLE
.PP
The following is a minimal extension:
.PP
.CS
#include <tcl.h>
#include <stdio.h>
static int fooCmd(void *clientData,
        Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    printf("called with %d arguments\en", objc);
    return TCL_OK;
}
int Foo_Init(Tcl_Interp *interp) {
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
	return TCL_ERROR;
Changes to doc/lrange.n.
72
73
74
75
76
77
78




.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lreplace(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, range, sublist











>
>
>
>
72
73
74
75
76
77
78
79
80
81
82
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lreplace(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, range, sublist
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/lrepeat.n.
29
30
31
32
33
34
35
36
37
38




\fBlrepeat\fR 3 a b c
      \fI\(-> a b c a b c a b c\fR
\fBlrepeat\fR 3 [\fBlrepeat\fR 2 a] b c
      \fI\(-> {a a} b c {a a} b c {a a} b c\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), linsert(n), llength(n), lset(n)

.SH KEYWORDS
element, index, list











<


>
>
>
>
29
30
31
32
33
34
35

36
37
38
39
40
41
\fBlrepeat\fR 3 a b c
      \fI\(-> a b c a b c a b c\fR
\fBlrepeat\fR 3 [\fBlrepeat\fR 2 a] b c
      \fI\(-> {a a} b c {a a} b c {a a} b c\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), linsert(n), llength(n), lset(n)

.SH KEYWORDS
element, index, list
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/lreplace.n.
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33


34
35



36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
.SH NAME
lreplace \- Replace elements in a list with new elements
.SH SYNOPSIS
\fBlreplace \fIlist first last \fR?\fIelement element ...\fR?
.BE
.SH DESCRIPTION
.PP
\fBlreplace\fR returns a new list formed by replacing one or more elements of
\fIlist\fR with the \fIelement\fR arguments.
\fIfirst\fR and \fIlast\fR are index values specifying the first and
last elements of the range to replace.
The index values \fIfirst\fR and \fIlast\fR are interpreted
the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the
end of the list.
0 refers to the first element of the
list, and \fBend\fR refers to the last element of the list.
If \fIlist\fR is empty, then \fIfirst\fR and \fIlast\fR are ignored.
.PP
If \fIfirst\fR is less than zero, it is considered to refer to before the
first element of the list.  For non-empty lists, the element indicated


by \fIfirst\fR must exist or \fIfirst\fR must indicate before the
start of the list.



.PP
If \fIlast\fR is less than \fIfirst\fR, then any specified elements
will be inserted into the list before the point specified by \fIfirst\fR
with no elements being deleted.
.PP
The \fIelement\fR arguments specify zero or more new arguments to
be added to the list in place of those that were deleted.
Each \fIelement\fR argument will become a separate element of
the list.  If no \fIelement\fR arguments are specified, then the elements
between \fIfirst\fR and \fIlast\fR are simply deleted.  If \fIlist\fR
is empty, any \fIelement\fR arguments are added to the end of the list.
.SH EXAMPLES
.PP
Replacing an element of a list with another:
.PP
.CS
% \fBlreplace\fR {a b c d e} 1 1 foo
a foo c d e







|









<

|
|
>
>
|
|
>
>
>


|


|



|
<







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

50
51
52
53
54
55
56
.SH NAME
lreplace \- Replace elements in a list with new elements
.SH SYNOPSIS
\fBlreplace \fIlist first last \fR?\fIelement element ...\fR?
.BE
.SH DESCRIPTION
.PP
\fBlreplace\fR returns a new list formed by replacing zero or more elements of
\fIlist\fR with the \fIelement\fR arguments.
\fIfirst\fR and \fIlast\fR are index values specifying the first and
last elements of the range to replace.
The index values \fIfirst\fR and \fIlast\fR are interpreted
the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the
end of the list.
0 refers to the first element of the
list, and \fBend\fR refers to the last element of the list.

.PP
If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered
to refer to before the first element of the list. This allows \fBlreplace\fR
to prepend elements to \fIlist\fR.
.VS TIP505
If either \fIfirst\fR or \fIlast\fR indicates a position greater than the
index of the last element of the list, it is treated as if it is an
index one greater than the last element. This allows \fBlreplace\fR to
append elements to \fIlist\fR.
.VE TIP505
.PP
If \fIlast\fR is less than \fIfirst\fR, then any specified elements
will be inserted into the list before the element specified by \fIfirst\fR
with no elements being deleted.
.PP
The \fIelement\fR arguments specify zero or more new elements to
be added to the list in place of those that were deleted.
Each \fIelement\fR argument will become a separate element of
the list.  If no \fIelement\fR arguments are specified, then the elements
between \fIfirst\fR and \fIlast\fR are simply deleted.

.SH EXAMPLES
.PP
Replacing an element of a list with another:
.PP
.CS
% \fBlreplace\fR {a b c d e} 1 1 foo
a foo c d e
74
75
76
77
78
79
80













81
82
83
84
85
86




.CS
proc lremove {listVariable value} {
    upvar 1 $listVariable var
    set idx [lsearch -exact $var $value]
    set var [\fBlreplace\fR $var $idx $idx]
}
.CE













.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lrange(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, replace











>
>
>
>
>
>
>
>
>
>
>
>
>






>
>
>
>
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
.CS
proc lremove {listVariable value} {
    upvar 1 $listVariable var
    set idx [lsearch -exact $var $value]
    set var [\fBlreplace\fR $var $idx $idx]
}
.CE
.PP
.VS TIP505
Appending elements to the list; note that \fBend+2\fR will initially
be treated as if it is \fB6\fR here, but both that and \fB12345\fR are greater
than the index of the final item so they behave identically:
.PP
.CS
% set var {a b c d e}
a b c d e
% set var [\fBlreplace\fR $var 12345 end+2 f g h i]
a b c d e f g h i
.CE
.VE TIP505
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lrange(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, replace
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Changes to doc/memory.n.
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
.TP
\fBmemory active\fR \fIfile\fR
.
Write a list of all currently allocated memory to the specified \fIfile\fR.
.TP
\fBmemory break_on_malloc\fR \fIcount\fR
.
After the \fIcount\fR allocations have been performed, \fBckalloc\fR
outputs a message to this effect and that it is now attempting to enter
the C debugger.  Tcl will then issue a \fISIGINT\fR signal against itself.
If you are running Tcl under a C debugger, it should then enter the debugger
command mode.
.TP
\fBmemory info\fR
.
Returns a report containing the total allocations and frees since
Tcl began, the current packets allocated (the current
number of calls to \fBckalloc\fR not met by a corresponding call
to \fBckfree\fR), the current bytes allocated, and the maximum number
of packets and bytes allocated.
.TP
\fBmemory init \fR[\fBon\fR|\fBoff\fR]
.
Turn on or off the pre-initialization of all allocated memory
with bogus bytes.  Useful for detecting the use of uninitialized
values.







|









|
|







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
.TP
\fBmemory active\fR \fIfile\fR
.
Write a list of all currently allocated memory to the specified \fIfile\fR.
.TP
\fBmemory break_on_malloc\fR \fIcount\fR
.
After the \fIcount\fR allocations have been performed, \fBTcl_Alloc\fR
outputs a message to this effect and that it is now attempting to enter
the C debugger.  Tcl will then issue a \fISIGINT\fR signal against itself.
If you are running Tcl under a C debugger, it should then enter the debugger
command mode.
.TP
\fBmemory info\fR
.
Returns a report containing the total allocations and frees since
Tcl began, the current packets allocated (the current
number of calls to \fBTcl_Alloc\fR not met by a corresponding call
to \fBTcl_Free\fR), the current bytes allocated, and the maximum number
of packets and bytes allocated.
.TP
\fBmemory init \fR[\fBon\fR|\fBoff\fR]
.
Turn on or off the pre-initialization of all allocated memory
with bogus bytes.  Useful for detecting the use of uninitialized
values.
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
.
Causes a list of all allocated memory to be written to the specified \fIfile\fR
during the finalization of Tcl's memory subsystem.  Useful for checking
that memory is properly cleaned up during process exit.
.TP
\fBmemory tag\fR \fIstring\fR
.
Each packet of memory allocated by \fBckalloc\fR can have associated
with it a string-valued tag.  In the lists of allocated memory generated
by \fBmemory active\fR and \fBmemory onexit\fR, the tag for each packet
is printed along with other information about the packet.  The
\fBmemory tag\fR command sets the tag value for subsequent calls
to \fBckalloc\fR to be \fIstring\fR.
.TP
\fBmemory trace \fR[\fBon\fR|\fBoff\fR]
.
Turns memory tracing on or off.  When memory tracing is on, every call
to \fBckalloc\fR causes a line of trace information to be written to
\fIstderr\fR, consisting of the word \fIckalloc\fR, followed by the
address returned, the amount of memory allocated, and the C filename
and line number of the code performing the allocation.  For example:
.RS
.PP
.CS
ckalloc 40e478 98 tclProc.c 1406
.CE
.PP
Calls to \fBckfree\fR are traced in the same manner.
.RE
.TP
\fBmemory trace_on_at_malloc\fR \fIcount\fR
.
Enable memory tracing after \fIcount\fR \fBckalloc\fRs have been performed.
For example, if you enter \fBmemory trace_on_at_malloc 100\fR,
after the 100th call to \fBckalloc\fR, memory trace information will begin
being displayed for all allocations and frees.  Since there can be a lot
of memory activity before a problem occurs, judicious use of this option
can reduce the slowdown caused by tracing (and the amount of trace information
produced), if you can identify a number of allocations that occur before
the problem sets in.  The current number of memory allocations that have
occurred since Tcl started is printed on a guard zone failure.
.TP
\fBmemory validate \fR[\fBon\fR|\fBoff\fR]
.
Turns memory validation on or off. When memory validation is enabled,
on every call to \fBckalloc\fR or \fBckfree\fR, the guard zones are
checked for every piece of memory currently in existence that was
allocated by \fBckalloc\fR.  This has a large performance impact and
should only be used when overwrite problems are strongly suspected.
The advantage of enabling memory validation is that a guard zone
overwrite can be detected on the first call to \fBckalloc\fR or
\fBckfree\fR after the overwrite occurred, rather than when the
specific memory with the overwritten guard zone(s) is freed, which may
occur long after the overwrite occurred.
.SH "SEE ALSO"
ckalloc, ckfree, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG
.SH KEYWORDS
memory, debug
'\"Local Variables:
'\"mode: nroff
'\"End:







|




|




|
|





|


|




|

|










|

|


|
|



|





55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
.
Causes a list of all allocated memory to be written to the specified \fIfile\fR
during the finalization of Tcl's memory subsystem.  Useful for checking
that memory is properly cleaned up during process exit.
.TP
\fBmemory tag\fR \fIstring\fR
.
Each packet of memory allocated by \fBTcl_Alloc\fR can have associated
with it a string-valued tag.  In the lists of allocated memory generated
by \fBmemory active\fR and \fBmemory onexit\fR, the tag for each packet
is printed along with other information about the packet.  The
\fBmemory tag\fR command sets the tag value for subsequent calls
to \fBTcl_Alloc\fR to be \fIstring\fR.
.TP
\fBmemory trace \fR[\fBon\fR|\fBoff\fR]
.
Turns memory tracing on or off.  When memory tracing is on, every call
to \fBTcl_Alloc\fR causes a line of trace information to be written to
\fIstderr\fR, consisting of the word \fITcl_Alloc\fR, followed by the
address returned, the amount of memory allocated, and the C filename
and line number of the code performing the allocation.  For example:
.RS
.PP
.CS
Tcl_Alloc 40e478 98 tclProc.c 1406
.CE
.PP
Calls to \fBTcl_Free\fR are traced in the same manner.
.RE
.TP
\fBmemory trace_on_at_malloc\fR \fIcount\fR
.
Enable memory tracing after \fIcount\fR \fBTcl_Alloc\fRs have been performed.
For example, if you enter \fBmemory trace_on_at_malloc 100\fR,
after the 100th call to \fBTcl_Alloc\fR, memory trace information will begin
being displayed for all allocations and frees.  Since there can be a lot
of memory activity before a problem occurs, judicious use of this option
can reduce the slowdown caused by tracing (and the amount of trace information
produced), if you can identify a number of allocations that occur before
the problem sets in.  The current number of memory allocations that have
occurred since Tcl started is printed on a guard zone failure.
.TP
\fBmemory validate \fR[\fBon\fR|\fBoff\fR]
.
Turns memory validation on or off. When memory validation is enabled,
on every call to \fBTcl_Alloc\fR or \fBTcl_Free\fR, the guard zones are
checked for every piece of memory currently in existence that was
allocated by \fBTcl_Alloc\fR.  This has a large performance impact and
should only be used when overwrite problems are strongly suspected.
The advantage of enabling memory validation is that a guard zone
overwrite can be detected on the first call to \fBTcl_Alloc\fR or
\fBTcl_Free\fR after the overwrite occurred, rather than when the
specific memory with the overwritten guard zone(s) is freed, which may
occur long after the overwrite occurred.
.SH "SEE ALSO"
Tcl_Alloc, Tcl_Free, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG
.SH KEYWORDS
memory, debug
'\"Local Variables:
'\"mode: nroff
'\"End:
Changes to doc/my.n.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

18
19
20
21
22
23





24
25
26
27
28
29

30
31
32
33







34
35

36
37
38
39
40
41
42
'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH my n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
my \- invoke any method of current object
.SH SYNOPSIS
.nf
package require TclOO

\fBmy\fI methodName\fR ?\fIarg ...\fR?

.fi
.BE
.SH DESCRIPTION
.PP
The \fBmy\fR command is used to allow methods of objects to invoke methods
of the object (or its class). In particular, the set of valid values for





\fImethodName\fR is the set of all methods supported by an object and its
superclasses, including those that are not exported
.VS TIP500
and private methods of the object or class when used within another method
defined by that object or class.
.VE TIP500

The object upon which the method is invoked is the one that owns the namespace
that the \fBmy\fR command is contained in initially (\fBNB:\fR the link
remains if the command is renamed), which is the currently invoked object by
default.







.PP
Each object has its own \fBmy\fR command, contained in its instance namespace.

.SH EXAMPLES
.PP
This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of
the \fBoo::object\fR class, which is not publicly visible by default:
.PP
.CS
oo::class create c {











|





>





|
>
>
>
>
>






>
|
|


>
>
>
>
>
>
>

|
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH my n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
my, myclass \- invoke any method of current object or its class
.SH SYNOPSIS
.nf
package require TclOO

\fBmy\fI methodName\fR ?\fIarg ...\fR?
\fBmyclass\fI methodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
.PP
The \fBmy\fR command is used to allow methods of objects to invoke methods
of the object (or its class),
.VS TIP478
and he \fBmyclass\fR command is used to allow methods of objects to invoke
methods of the current class of the object \fIas an object\fR.
.VE TIP478
In particular, the set of valid values for
\fImethodName\fR is the set of all methods supported by an object and its
superclasses, including those that are not exported
.VS TIP500
and private methods of the object or class when used within another method
defined by that object or class.
.VE TIP500
.PP
The object upon which the method is invoked via \fBmy\fR is the one that owns
the namespace that the \fBmy\fR command is contained in initially (\fBNB:\fR the link
remains if the command is renamed), which is the currently invoked object by
default.
.VS TIP478
Similarly, the object on which the method is invoked via \fBmyclass\fR is the
object that is the current class of the object that owns the namespace that
the \fBmyclass\fR command is contained in initially. As with \fBmy\fR, the
link remains even if the command is renamed into another namespace, and
defaults to being the manufacturing class of the current object.
.VE TIP478
.PP
Each object has its own \fBmy\fR and \fBmyclass\fR commands, contained in its
instance namespace.
.SH EXAMPLES
.PP
This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of
the \fBoo::object\fR class, which is not publicly visible by default:
.PP
.CS
oo::class create c {
50
51
52
53
54
55
56
57

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
































76
77
78
79
80
81
82
83
o count              \fI\(-> prints "1"\fR
o count              \fI\(-> prints "2"\fR
o count              \fI\(-> prints "3"\fR
.CE
.PP
This example shows how you can use \fBmy\fR to make callbacks to private
methods from outside the object (from a \fBtrace\fR), using
\fBnamespace code\fR to enter the correct context:

.PP
.CS
oo::class create HasCallback {
    method makeCallback {} {
        return [namespace code {
            \fBmy\fR Callback
        }]
    }

    method Callback {args} {
        puts "callback: $args"
    }
}

set o [HasCallback new]
trace add variable xyz write [$o makeCallback]
set xyz "called"     \fI\(-> prints "callback: xyz {} write"\fR
.CE
































.SH "SEE ALSO"
next(n), oo::object(n), self(n)
.SH KEYWORDS
method, method visibility, object, private method, public method
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:







|
>


















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
o count              \fI\(-> prints "1"\fR
o count              \fI\(-> prints "2"\fR
o count              \fI\(-> prints "3"\fR
.CE
.PP
This example shows how you can use \fBmy\fR to make callbacks to private
methods from outside the object (from a \fBtrace\fR), using
\fBnamespace code\fR to enter the correct context. (See the \fBcallback\fR
command for the recommended way of doing this.)
.PP
.CS
oo::class create HasCallback {
    method makeCallback {} {
        return [namespace code {
            \fBmy\fR Callback
        }]
    }

    method Callback {args} {
        puts "callback: $args"
    }
}

set o [HasCallback new]
trace add variable xyz write [$o makeCallback]
set xyz "called"     \fI\(-> prints "callback: xyz {} write"\fR
.CE
.PP
.VS TIP478
This example shows how to access a private method of a class from an instance
of that class. (See the \fBclassmethod\fR declaration in \fBoo::define\fR for
a higher level interface for doing this.)
.PP
.CS
oo::class create CountedSteps {
    self {
        variable count
        method Count {} {
            return [incr count]
        }
    }
    method advanceTwice {} {
        puts "in [self] step A: [\fBmyclass\fR Count]"
        puts "in [self] step B: [\fBmyclass\fR Count]"
    }
}

CountedSteps create x
CountedSteps create y
x advanceTwice       \fI\(-> prints "in ::x step A: 1"\fR
                     \fI\(-> prints "in ::x step B: 2"\fR
y advanceTwice       \fI\(-> prints "in ::y step A: 3"\fR
                     \fI\(-> prints "in ::y step B: 4"\fR
x advanceTwice       \fI\(-> prints "in ::x step A: 5"\fR
                     \fI\(-> prints "in ::x step B: 6"\fR
y advanceTwice       \fI\(-> prints "in ::y step A: 7"\fR
                     \fI\(-> prints "in ::y step B: 8"\fR
.CE
.VE TIP478
.SH "SEE ALSO"
next(n), oo::object(n), self(n)
.SH KEYWORDS
method, method visibility, object, private method, public method
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Changes to doc/packagens.n.
44
45
46
47
48
49
50




specified.
.PP
At least one \fB\-load\fR or \fB\-source\fR parameter must be given.
.SH "SEE ALSO"
package(n)
.SH KEYWORDS
auto-load, index, package, version











>
>
>
>
44
45
46
47
48
49
50
51
52
53
54
specified.
.PP
At least one \fB\-load\fR or \fB\-source\fR parameter must be given.
.SH "SEE ALSO"
package(n)
.SH KEYWORDS
auto-load, index, package, version
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/pid.n.
39
40
41
42
43
44
45
46
47
48




puts [string repeat - 70]
puts [read $pipeline]
close $pipeline
.CE

.SH "SEE ALSO"
exec(n), open(n)

.SH KEYWORDS
file, pipeline, process identifier











<


>
>
>
>
39
40
41
42
43
44
45

46
47
48
49
50
51
puts [string repeat - 70]
puts [read $pipeline]
close $pipeline
.CE

.SH "SEE ALSO"
exec(n), open(n)

.SH KEYWORDS
file, pipeline, process identifier
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/platform.n.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
platform \- System identification support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require platform ?1.0.10?\fR
.sp
\fBplatform::generic\fR
\fBplatform::identify\fR
\fBplatform::patterns \fIidentifier\fR
.fi
.BE
.SH DESCRIPTION







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
platform \- System identification support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require platform\fR ?\fB1.0.10\fR?
.sp
\fBplatform::generic\fR
\fBplatform::identify\fR
\fBplatform::patterns \fIidentifier\fR
.fi
.BE
.SH DESCRIPTION
Changes to doc/platform_shell.n.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
platform::shell \- System identification support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require platform::shell ?1.1.4?\fR
.sp
\fBplatform::shell::generic \fIshell\fR
\fBplatform::shell::identify \fIshell\fR
\fBplatform::shell::platform \fIshell\fR
.fi
.BE
.SH DESCRIPTION







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
platform::shell \- System identification support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require platform::shell\fR ?\fB1.1.4\fR?
.sp
\fBplatform::shell::generic \fIshell\fR
\fBplatform::shell::identify \fIshell\fR
\fBplatform::shell::platform \fIshell\fR
.fi
.BE
.SH DESCRIPTION
51
52
53
54
55
56
57




for the specified Tcl shell, in contrast to the running shell.
.TP
\fBplatform::shell::platform \fIshell\fR
This command returns the contents of \fBtcl_platform(platform)\fR for
the specified Tcl shell.
.SH KEYWORDS
operating system, cpu architecture, platform, architecture











>
>
>
>
51
52
53
54
55
56
57
58
59
60
61
for the specified Tcl shell, in contrast to the running shell.
.TP
\fBplatform::shell::platform \fIshell\fR
This command returns the contents of \fBtcl_platform(platform)\fR for
the specified Tcl shell.
.SH KEYWORDS
operating system, cpu architecture, platform, architecture
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/prefix.n.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcl::prefix \- facilities for prefix matching
.SH SYNOPSIS
.nf
\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix match\fR \fI?option ...?\fR \fItable\fR \fIstring\fR
.fi
.BE
.SH DESCRIPTION
.PP
This document describes commands looking up a prefix in a list of strings.
The following commands are supported:
.TP
\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
.
Returns a list of all elements in \fItable\fR that begin with the prefix
\fIstring\fR.
.TP
\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
.
Returns the longest common prefix of all elements in \fItable\fR that
begin with the prefix \fIstring\fR.
.TP
\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable\fR \fIstring\fR
.
If \fIstring\fR equals one element in \fItable\fR or is a prefix to exactly
one element, the matched element is returned. If not, the result depends
on the \fB\-error\fR option. (It is recommended that the \fItable\fR be sorted
before use with this subcommand, so that the list of matches presented in the
error message also becomes sorted, though this is not strictly necessary for
the operation of this subcommand itself.)







|
|
|







|




|




|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcl::prefix \- facilities for prefix matching
.SH SYNOPSIS
.nf
\fB::tcl::prefix all\fR \fItable string\fR
\fB::tcl::prefix longest\fR \fItable string\fR
\fB::tcl::prefix match\fR ?\fIoption ...\fR? \fItable string\fR
.fi
.BE
.SH DESCRIPTION
.PP
This document describes commands looking up a prefix in a list of strings.
The following commands are supported:
.TP
\fB::tcl::prefix all\fR \fItable string\fR
.
Returns a list of all elements in \fItable\fR that begin with the prefix
\fIstring\fR.
.TP
\fB::tcl::prefix longest\fR \fItable string\fR
.
Returns the longest common prefix of all elements in \fItable\fR that
begin with the prefix \fIstring\fR.
.TP
\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable string\fR
.
If \fIstring\fR equals one element in \fItable\fR or is a prefix to exactly
one element, the matched element is returned. If not, the result depends
on the \fB\-error\fR option. (It is recommended that the \fItable\fR be sorted
before use with this subcommand, so that the list of matches presented in the
error message also becomes sorted, though this is not strictly necessary for
the operation of this subcommand itself.)
Changes to doc/process.n.
12
13
14
15
16
17
18

19
20










21
22
23









24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104


105



106
107
108
109
110
111
112
113


114




115
116
117

118
119
120
121
122
123
124
125

126
127
128
129
130
131
tcl::process \- Subprocess management
.SH SYNOPSIS
\fB::tcl::process \fIoption \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command provides a way to manage subprocesses created by the \fBopen\fR

and \fBexec\fR commands. The legal \fIoptions\fR (which may be abbreviated) are:
.TP










\fB::tcl::process list\fR
.
Returns the list of subprocess PIDs.









.TP
\fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR?
.
Returns a dictionary mapping subprocess PIDs to their respective status. If
\fIpids\fR is specified as a list of PIDs then the command only returns the
status of the matching subprocesses if they exist, and raises an error
otherwise. For active processes, the status is an empty value. For terminated
processes, the status is a list with the following format:
.QW "{code ?\fImsg errorCode\fR?}" ,
where:
.RS
.TP
\fBcode\fR\0
.
is a standard Tcl return code,

.TP
\fBmsg\fR\0
.
is the human-readable error message,
.TP
\fBerrorCode\fR\0
.
uses the same format as the \fBerrorCode\fR global variable
.RE
Note that \fBmsg\fR and \fBerrorCode\fR are only present for abnormally
terminated processes (i.e. those where \fBcode\fR is nonzero). Under the hood
this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for
non-blocking behavior, unless the \fB\-wait\fR switch is set (see below).
.RS
.PP
Additionally, \fB::tcl::process status\fR accepts the following switches:
.TP
\fB\-wait\fR\0
.
By default the command returns immediately (the underlying \fBTcl_WaitPid\fR is
called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fBpids\fR
is specified as a list of PIDs then the command waits until the status of the
matching subprocesses are available. If \fBpids\fR is not specified then it
waits for all known subprocesses.
.TP
\fB\-\|\-\fR
.
Marks the end of switches.  The argument following this one will
be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
.RE
.TP
\fB::tcl::process purge ?\fIpids\fR?
.
Cleans up all data associated with terminated subprocesses. If \fBpids\fR is
specified as a list of PIDs then the command only cleanup data for the matching
subprocesses if they exist, and raises an error otherwise. If the process is
still active then it does nothing.
.TP
\fB::tcl::process autopurge ?\fIflag\fR?
.
Automatic purge facility. If \fBflag\fR is specified as a boolean value then it
activates or deactivate autopurge. In all cases it returns the current status as
a boolean value. When autopurge is active, \fBTcl_ReapDetachedProcs\fR is called
each time the exec command is executed or a pipe channel created by open is
closed. When autopurge is inactive, \fB::tcl::process\fR purge must be called
explicitly. By default autopurge is active.
.RE
.SH "EXAMPLES"
.PP
.CS
\fB::tcl::process autopurge\fR
     \fI\(-> true\fR
\fB::tcl::process autopurge\fR false
     \fI\(-> false\fR

set pid1 [exec command1 a b c | command2 d e f &]
     \fI\(-> 123 456\fR
set chan [open "|command1 a b c | command2 d e f"]
     \fI\(-> file123\fR
set pid2 [pid $chan]
     \fI\(-> 789 1011\fR

\fB::tcl::process list\fR
     \fI\(-> 123 456 789 1011\fR

\fB::tcl::process status\fR


     \fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {}\fR




\fB::tcl::process status\fR 123
     \fI\(-> 123 0\fR

\fB::tcl::process status\fR 1011
     \fI\(-> 1011 {}\fR

\fB::tcl::process status\fR -wait


     \fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR





\fB::tcl::process status\fR 1011
     \fI\(-> 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR


\fB::tcl::process purge\fR
exec command1 1 2 3 &
     \fI\(-> 1213\fR
\fB::tcl::process list\fR
     \fI\(-> 1213\fR
.CE
.SH "SEE ALSO"

exec(n), open(n), Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
.SH "KEYWORDS"
background, child, detach, process, wait
'\" Local Variables:
'\" mode: nroff
'\" End:







>
|

>
>
>
>
>
>
>
>
>
>


|
>
>
>
>
>
>
>
>
>








|



|

|
>

|



|


|

|
|

<






|

|
|






|
<
|
<
<
<
<
<
|
<
<
<
<
<
|
<
<
<


















>
>
|
>
>
>








>
>
|
>
>
>
>


|
>








>
|





12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89

90





91





92



93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
tcl::process \- Subprocess management
.SH SYNOPSIS
\fB::tcl::process \fIoption \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command provides a way to manage subprocesses created by the \fBopen\fR
and \fBexec\fR commands, as identified by the process identifiers (PIDs) of
those subprocesses. The legal \fIoptions\fR (which may be abbreviated) are:
.TP
\fB::tcl::process autopurge\fR ?\fIflag\fR?
.
Automatic purge facility. If \fIflag\fR is specified as a boolean value then
it activates or deactivate autopurge. In all cases it returns the current
status as a boolean value. When autopurge is active,
\fBTcl_ReapDetachedProcs\fR is called each time the \fBexec\fR command is
executed or a pipe channel created by \fBopen\fR is closed. When autopurge is
inactive, \fB::tcl::process\fR purge must be called explicitly. By default
autopurge is active.
.TP
\fB::tcl::process list\fR
.
Returns the list of subprocess PIDs. This includes all currently executing
subprocesses and all terminated subprocesses that have not yet had their
corresponding process table entries purged.
.TP
\fB::tcl::process purge\fR ?\fIpids\fR?
.
Cleans up all data associated with terminated subprocesses. If \fIpids\fR is
specified as a list of PIDs then the command only cleanup data for the matching
subprocesses if they exist, and raises an error otherwise. If a process listed is
still active, this command does nothing to that process.
.TP
\fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR?
.
Returns a dictionary mapping subprocess PIDs to their respective status. If
\fIpids\fR is specified as a list of PIDs then the command only returns the
status of the matching subprocesses if they exist, and raises an error
otherwise. For active processes, the status is an empty value. For terminated
processes, the status is a list with the following format:
.QW "\fB{\fIcode\fR ?\fImsg errorCode\fR?\fB}\fR" ,
where:
.RS
.TP
\fIcode\fR\0
.
is a standard Tcl return code, i.e., \fB0\fR for TCL_OK and \fB1\fR
for TCL_ERROR,
.TP
\fImsg\fR\0
.
is the human-readable error message,
.TP
\fIerrorCode\fR\0
.
uses the same format as the \fBerrorCode\fR global variable
.PP
Note that \fBmsg\fR and \fBerrorCode\fR are only present for abnormally
terminated processes (i.e. those where the \fIcode\fR is nonzero). Under the
hood this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for
non-blocking behavior, unless the \fB\-wait\fR switch is set (see below).

.PP
Additionally, \fB::tcl::process status\fR accepts the following switches:
.TP
\fB\-wait\fR\0
.
By default the command returns immediately (the underlying \fBTcl_WaitPid\fR is
called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fIpids\fR
is specified as a list of PIDs then the command waits until the status of the
matching subprocesses are available. If \fIpids\fR was not specified, this
command will wait for all known subprocesses.
.TP
\fB\-\|\-\fR
.
Marks the end of switches.  The argument following this one will
be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
.RE
.SH "EXAMPLES"

.PP





These show the use of \fB::tcl::process\fR. Some of the results from





\fB::tcl::process status\fR are split over multiple lines for readability.



.PP
.CS
\fB::tcl::process autopurge\fR
     \fI\(-> true\fR
\fB::tcl::process autopurge\fR false
     \fI\(-> false\fR

set pid1 [exec command1 a b c | command2 d e f &]
     \fI\(-> 123 456\fR
set chan [open "|command1 a b c | command2 d e f"]
     \fI\(-> file123\fR
set pid2 [pid $chan]
     \fI\(-> 789 1011\fR

\fB::tcl::process list\fR
     \fI\(-> 123 456 789 1011\fR

\fB::tcl::process status\fR
     \fI\(-> 123 0
       456 {1 "child killed: write on pipe with no readers" {
         CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
       789 {1 "child suspended: background tty read" {
         CHILDSUSP 789 SIGTTIN "background tty read"}}
       1011 {}\fR

\fB::tcl::process status\fR 123
     \fI\(-> 123 0\fR

\fB::tcl::process status\fR 1011
     \fI\(-> 1011 {}\fR

\fB::tcl::process status\fR -wait
     \fI\(-> 123 0
       456 {1 "child killed: write on pipe with no readers" {
         CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
       789 {1 "child suspended: background tty read" {
         CHILDSUSP 789 SIGTTIN "background tty read"}}
       1011 {1 "child process exited abnormally" {
         CHILDSTATUS 1011 -1}}\fR

\fB::tcl::process status\fR 1011
     \fI\(-> 1011 {1 "child process exited abnormally" {
         CHILDSTATUS 1011 -1}}\fR

\fB::tcl::process purge\fR
exec command1 1 2 3 &
     \fI\(-> 1213\fR
\fB::tcl::process list\fR
     \fI\(-> 1213\fR
.CE
.SH "SEE ALSO"
exec(n), open(n), pid(n),
Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
.SH "KEYWORDS"
background, child, detach, process, wait
'\" Local Variables:
'\" mode: nroff
'\" End:
Changes to doc/puts.n.
92
93
94
95
96
97
98




\fBputs\fR $chan "$timestamp - Hello, World!"
close $chan
.CE
.SH "SEE ALSO"
file(n), fileevent(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, newline, output, write











>
>
>
>
92
93
94
95
96
97
98
99
100
101
102
\fBputs\fR $chan "$timestamp - Hello, World!"
close $chan
.CE
.SH "SEE ALSO"
file(n), fileevent(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, newline, output, write
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/pwd.n.
33
34
35
36
37
38
39




exec tar -xf $tarFile
cd $savedDir
.CE
.SH "SEE ALSO"
file(n), cd(n), glob(n), filename(n)
.SH KEYWORDS
working directory











>
>
>
>
33
34
35
36
37
38
39
40
41
42
43
exec tar -xf $tarFile
cd $savedDir
.CE
.SH "SEE ALSO"
file(n), cd(n), glob(n), filename(n)
.SH KEYWORDS
working directory
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/rename.n.
39
40
41
42
43
44
45




    uplevel 1 ::theRealSource $args
}
.CE
.SH "SEE ALSO"
namespace(n), proc(n)
.SH KEYWORDS
command, delete, namespace, rename











>
>
>
>
39
40
41
42
43
44
45
46
47
48
49
    uplevel 1 ::theRealSource $args
}
.CE
.SH "SEE ALSO"
namespace(n), proc(n)
.SH KEYWORDS
command, delete, namespace, rename
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/set.n.
69
70
71
72
73
74
75




\fBset\fR vbl in[expr {rand() >= 0.5}]
\fBset\fR out [\fBset\fR $vbl]
.CE
.SH "SEE ALSO"
expr(n), global(n), namespace(n), proc(n), trace(n), unset(n), upvar(n), variable(n)
.SH KEYWORDS
read, write, variable











>
>
>
>
69
70
71
72
73
74
75
76
77
78
79
\fBset\fR vbl in[expr {rand() >= 0.5}]
\fBset\fR out [\fBset\fR $vbl]
.CE
.SH "SEE ALSO"
expr(n), global(n), namespace(n), proc(n), trace(n), unset(n), upvar(n), variable(n)
.SH KEYWORDS
read, write, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Added doc/singleton.n.






































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH singleton n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::singleton \- a class that does only allows one instance of itself
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::singleton\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR
       \(-> \fBoo::singleton\fR
.fi
.BE
.SH DESCRIPTION
Singleton classes are classes that only permit at most one instance of
themselves to exist. They unexport the \fBcreate\fR and
\fBcreateWithNamespace\fR methods entirely, and override the \fBnew\fR method
so that it only makes a new instance if there is no existing instance.  It is
not recommended to inherit from a singleton class; singleton-ness is \fInot\fR
inherited. It is not recommended that a singleton class's constructor take any
arguments.
.PP
Instances have their\fB destroy\fR method overridden with a method that always
returns an error in order to discourage destruction of the object, but
destruction remains possible if strictly necessary (e.g., by destroying the
class or using \fBrename\fR to delete it). They also have a (non-exported)
\fB<cloned>\fR method defined on them that similarly always returns errors to
make attempts to use the singleton instance with \fBoo::copy\fR fail.
.SS CONSTRUCTOR
The \fBoo::singleton\fR class does not define an explicit constructor; this
means that it is effectively the same as the constructor of the
\fBoo::class\fR class.
.SS DESTRUCTOR
The \fBoo::singleton\fR class does not define an explicit destructor;
destroying an instance of it is just like destroying an ordinary class (and
will destroy the singleton object).
.SS "EXPORTED METHODS"
.TP
\fIcls \fBnew \fR?\fIarg ...\fR?
.
This returns the current instance of the singleton class, if one exists, and
creates a new instance only if there is no existing instance. The additional
arguments, \fIarg ...\fR, are only used if a new instance is actually
manufactured; that construction is via the \fBoo::class\fR class's \fBnew\fR
method.
.RS
.PP
This is an override of the behaviour of a superclass's method with an
identical call signature to the superclass's implementation.
.RE
.SS "NON-EXPORTED METHODS"
The \fBoo::singleton\fR class explicitly states that \fBcreate\fR and
\fBcreateWithNamespace\fR are unexported; callers should not assume that they
have control over either the name or the namespace name of the singleton instance.
.SH EXAMPLE
.PP
This example demonstrates that there is only one instance even though the
\fBnew\fR method is called three times.
.PP
.CS
\fBoo::singleton\fR create Highlander {
    method say {} {
        puts "there can be only one"
    }
}

set h1 [Highlander new]
set h2 [Highlander new]
if {$h1 eq $h2} {
    puts "equal objects"    \fI\(-> prints "equal objects"\fR
}
set h3 [Highlander new]
if {$h1 eq $h3} {
    puts "equal objects"    \fI\(-> prints "equal objects"\fR
}
.CE
.PP
Note that the name of the instance of the singleton is not guaranteed to be
anything in particular.
.SH "SEE ALSO"
oo::class(n)
.SH KEYWORDS
class, metaclass, object, single instance
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
Changes to doc/source.n.
65
66
67
68
69
70
71




    \fBsource\fR $scriptFile
}
.CE
.SH "SEE ALSO"
file(n), cd(n), encoding(n), info(n)
.SH KEYWORDS
file, script











>
>
>
>
65
66
67
68
69
70
71
72
73
74
75
    \fBsource\fR $scriptFile
}
.CE
.SH "SEE ALSO"
file(n), cd(n), encoding(n), info(n)
.SH KEYWORDS
file, script
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/string.n.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.TH string n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
string \- Manipulate strings
.SH SYNOPSIS
\fBstring \fIoption arg \fR?\fIarg ...?\fR
.BE
.SH DESCRIPTION
.PP
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR?







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.TH string n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
string \- Manipulate strings
.SH SYNOPSIS
\fBstring \fIoption arg \fR?\fIarg ...\fR?
.BE
.SH DESCRIPTION
.PP
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR?
Changes to doc/tclsh.1.
139
140
141
142
143
144
145









146
147
148
149
The variable \fBtcl_prompt2\fR is used in a similar way when
a newline is typed but the current command is not yet complete;
if \fBtcl_prompt2\fR is not set then no prompt is output for
incomplete commands.
.SH "STANDARD CHANNELS"
.PP
See \fBTcl_StandardChannels\fR for more explanations.









.SH "SEE ALSO"
auto_path(n), encoding(n), env(n), fconfigure(n)
.SH KEYWORDS
application, argument, interpreter, prompt, script file, shell







>
>
>
>
>
>
>
>
>




139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
The variable \fBtcl_prompt2\fR is used in a similar way when
a newline is typed but the current command is not yet complete;
if \fBtcl_prompt2\fR is not set then no prompt is output for
incomplete commands.
.SH "STANDARD CHANNELS"
.PP
See \fBTcl_StandardChannels\fR for more explanations.
.SH ZIPVFS
.PP
When a zipfile is concatenated to the end of a \fBtclsh\fR, on
startup the contents of the zip archive will be mounted as the
virtual file system /zvfs. If a top level directory tcl8.6 is
present in the zip archive, it will become the directory loaded
as env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present
in the top level directory of the zip archive, it will be sourced
instead of the shell's normal command line handing.
.SH "SEE ALSO"
auto_path(n), encoding(n), env(n), fconfigure(n)
.SH KEYWORDS
application, argument, interpreter, prompt, script file, shell
Changes to doc/tell.n.
42
43
44
45
46
47
48




    seek $chan $offset
}
.CE
.SH "SEE ALSO"
file(n), open(n), close(n), gets(n), seek(n), Tcl_StandardChannels(3)
.SH KEYWORDS
access position, channel, seeking











>
>
>
>
42
43
44
45
46
47
48
49
50
51
52
    seek $chan $offset
}
.CE
.SH "SEE ALSO"
file(n), open(n), close(n), gets(n), seek(n), Tcl_StandardChannels(3)
.SH KEYWORDS
access position, channel, seeking
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/trace.n.
16
17
18
19
20
21
22
23

24
25
26
27
28
29
30
\fBtrace \fIoption\fR ?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command causes Tcl commands to be executed whenever certain operations are
invoked.  The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBtrace add \fItype name ops ?args?\fR

Where \fItype\fR is \fBcommand\fR, \fBexecution\fR, or \fBvariable\fR.
.RS
.TP
\fBtrace add command\fR \fIname ops commandPrefix\fR
.
Arrange for \fIcommandPrefix\fR to be executed (with additional arguments)
whenever command \fIname\fR is modified in one of the ways given by the list







|
>







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
\fBtrace \fIoption\fR ?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command causes Tcl commands to be executed whenever certain operations are
invoked.  The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBtrace add \fItype name ops\fR ?\fIargs\fR?
.
Where \fItype\fR is \fBcommand\fR, \fBexecution\fR, or \fBvariable\fR.
.RS
.TP
\fBtrace add command\fR \fIname ops commandPrefix\fR
.
Arrange for \fIcommandPrefix\fR to be executed (with additional arguments)
whenever command \fIname\fR is modified in one of the ways given by the list
Changes to doc/unknown.n.
85
86
87
88
89
90
91




    uplevel 1 [list _original_unknown {*}$args]
}
.CE
.SH "SEE ALSO"
info(n), proc(n), interp(n), library(n), namespace(n)
.SH KEYWORDS
error, non-existent command, unknown











>
>
>
>
85
86
87
88
89
90
91
92
93
94
95
    uplevel 1 [list _original_unknown {*}$args]
}
.CE
.SH "SEE ALSO"
info(n), proc(n), interp(n), library(n), namespace(n)
.SH KEYWORDS
error, non-existent command, unknown
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/update.n.
59
60
61
62
63
64
65




    \fBupdate\fR
}
.CE
.SH "SEE ALSO"
after(n), interp(n)
.SH KEYWORDS
asynchronous I/O, event, flush, handler, idle, update











>
>
>
>
59
60
61
62
63
64
65
66
67
68
69
    \fBupdate\fR
}
.CE
.SH "SEE ALSO"
after(n), interp(n)
.SH KEYWORDS
asynchronous I/O, event, flush, handler, idle, update
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/uplevel.n.
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
been passed to \fBconcat\fR; the result is then evaluated in the
variable context indicated by \fIlevel\fR.  \fBUplevel\fR returns
the result of that evaluation.
.PP
If \fIlevel\fR is an integer then
it gives a distance (up the procedure calling stack) to move before
executing the command.  If \fIlevel\fR consists of \fB#\fR followed by
a number then the number gives an absolute level number.  If \fIlevel\fR
is omitted then it defaults to \fB1\fR.  \fILevel\fR cannot be
defaulted if the first \fIcommand\fR argument starts with a digit or \fB#\fR.
.PP
For example, suppose that procedure \fBa\fR was invoked
from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR.
Suppose that \fBc\fR invokes the \fBuplevel\fR command.  If \fIlevel\fR
is \fB1\fR or \fB#2\fR  or omitted, then the command will be executed
in the variable context of \fBb\fR.  If \fIlevel\fR is \fB2\fR or \fB#1\fR
then the command will be executed in the variable context of \fBa\fR.







|

|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
been passed to \fBconcat\fR; the result is then evaluated in the
variable context indicated by \fIlevel\fR.  \fBUplevel\fR returns
the result of that evaluation.
.PP
If \fIlevel\fR is an integer then
it gives a distance (up the procedure calling stack) to move before
executing the command.  If \fIlevel\fR consists of \fB#\fR followed by
a integer then the level gives an absolute level.  If \fIlevel\fR
is omitted then it defaults to \fB1\fR.  \fILevel\fR cannot be
defaulted if the first \fIcommand\fR argument is an integer or starts with \fB#\fR.
.PP
For example, suppose that procedure \fBa\fR was invoked
from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR.
Suppose that \fBc\fR invokes the \fBuplevel\fR command.  If \fIlevel\fR
is \fB1\fR or \fB#2\fR  or omitted, then the command will be executed
in the variable context of \fBb\fR.  If \fIlevel\fR is \fB2\fR or \fB#1\fR
then the command will be executed in the variable context of \fBa\fR.
Changes to doc/while.n.
59
60
61
62
63
64
65




    puts "[incr lineCount]: $line"
}
.CE
.SH "SEE ALSO"
break(n), continue(n), for(n), foreach(n)
.SH KEYWORDS
boolean, loop, test, while











>
>
>
>
59
60
61
62
63
64
65
66
67
68
69
    puts "[incr lineCount]: $line"
}
.CE
.SH "SEE ALSO"
break(n), continue(n), for(n), foreach(n)
.SH KEYWORDS
boolean, loop, test, while
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Added doc/zipfs.3.












































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
'\"
'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de>
'\" Copyright (c) 2017 Sean Woods <yoda@etoyoc.com>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
TclZipfs_AppHook, Tclzipfs_Mount, TclZipfs_MountBuffer, Tclzipfs_Unmount \- handle ZIP files as Tcl virtual filesystems
.SH SYNOPSIS
.nf
int
\fBTclZipfs_AppHook(\fIargcPtr, argvPtr\fR)
.sp
int
\fBTclzipfs_Mount\fR(\fIinterp, mountpoint, zipname, password\fR)
.sp
int
\fBTclZipfs_MountBuffer\fR(\fIinterp, mountpoint, data, dataLen, copy\fR)
.sp
int
\fBTclzipfs_Unmount\fR(\fIinterp, mountpoint\fR)
.fi
.SH ARGUMENTS
.AS Tcl_Interp *mountpoint in
.AP "int" *argcPtr in
Pointer to a variable holding the number of command line arguments from
\fBmain\fR().
.AP "char" ***argvPtr in
Pointer to an array of strings containing the command line arguments to
\fBmain\fR().
.AP Tcl_Interp *interp in
Interpreter in which the ZIP file system is mounted.  The interpreter's result is
modified to hold the result or error message from the script.
.AP "const char" *zipname in
Name of a ZIP file. Must not be NULL when either mounting or unmounting a ZIP.
.AP "const char" *mountpoint in
Name of a mount point, which must be a legal Tcl file or directory name. May
be NULL to query current mount points.
.AP "const char" *password in
An (optional) password. Use NULL if no password is wanted to read the file.
.AP "unsigned char" *data in
A data buffer to mount. The data buffer must hold the contents of a ZIP
archive, and must not be NULL.
.AP size_t dataLen in
The number of bytes in the supplied data buffer argument, \fIdata\fR.
.AP int copy in
If non-zero, the ZIP archive in the data buffer will be internally copied
before mounting, allowing the data buffer to be disposed once
\fBTclZipfs_MountBuffer\fR returns. If zero, the caller guarantees that the
buffer will be valid to read from for the duration of the mount.
.BE
.SH DESCRIPTION
\fBTclZipfs_AppHook\fR is a utility function to perform standard application
initialization procedures, taking into account available ZIP archives as
follows:
.IP [1]
If the current application has a mountable ZIP archive, that archive is
mounted under \fIZIPFS_VOLUME\fB/app\fR as a read-only Tcl virtual file
system. \fIZIPFS_VOLUME\fR is usually \fB//zipfs:\fR on all platforms, but
\fBzipfs:\fR may also be used on Windows (due to differences in the
platform's filename parsing).
.IP [2]
If a file named \fBmain.tcl\fR is located in the root directory of that file
system (i.e., at \fIZIPROOT\fB/app/main.tcl\fR after the ZIP archive is
mounted as described above) it is treated as the startup script for the
process.
.IP [3]
If the file \fIZIPROOT\fB/app/tcl_library/init.tcl\fR is present, the
\fBtcl_library\fR global variable in the initial Tcl interpreter is set to
\fIZIPROOT\fB/app/tcl_library\fR.
.IP [4]
If the directory \fBtcl_library\fR was not found in the main application
mount, the system will then search for it as either a VFS attached to the
application dynamic library, or as a zip archive named
\fBlibtcl_\fImajor\fB_\fIminor\fB_\fIpatchlevel\fB.zip\fR either in the
present working directory or in the standard Tcl install location. (For
example, the Tcl 8.7.2 release would be searched for in a file
\fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only.
.PP
On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since
it uses WCHAR in stead of char. As a result, it requires your application to
be compiled with the UNICODE preprocessor symbol defined (e.g., via the
\fB-DUNICODE\fR compiler flag).
.PP
The result of \fBTclZipfs_AppHook\fR is a Tcl result code (e.g., \fBTCL_OK\fR
when the function is successful). The function \fImay\fR modify the variables
pointed to by \fIargcPtr\fR and \fIargvPtr\fR to remove arguments; the
current implementation does not do so, but callers \fIshould not\fR assume
that this will be true in the future.
.PP
\fBTclzipfs_Mount\fR mounts the ZIP archive \fIzipname\fR on the mount point
given in \fImountpoint\fR using the optional ZIP password \fIpassword\fR.
Errors during that process are reported in the interpreter \fIinterp\fR.  If
\fImountpoint\fR is a NULL pointer, information on all currently mounted ZIP
file systems is written into \fIinterp\fR's result as a sequence of mount
points and ZIP file names.  The result of this call is a standard Tcl result
code.
.PP
\fBTclzipfs_MountBuffer\fR mounts the ZIP archive in the buffer pointed to by
\fIdata\fR on the mount point given in \fImountpoint\fR. The ZIP archive is
assumed to be not password protected.  Errors during that process are reported
in the interpreter \fIinterp\fR. The \fIcopy\fR argument determines whether
the buffer is internally copied before mounting or not. The result of this
call is a standard Tcl result code.
.PP
\fBTclzipfs_Unmount\fR undoes the effect of \fBTclzipfs_Mount\fR, i.e., it
unmounts the mounted ZIP file system that was mounted from \fIzipname\fR (at
\fImountpoint\fR). Errors are reported in the interpreter \fIinterp\fR.  The
result of this call is a standard Tcl result code.
.SH "SEE ALSO"
zipfs(n)
.SH KEYWORDS
compress, filesystem, zip
Added doc/zipfs.n.






























































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
'\"
'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de>
'\" Copyright (c) 2015 Sean Woods <yoda@etoyoc.com>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH zipfs n 1.0 Zipfs "zipfs Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
zipfs \- Mount and work with ZIP files within Tcl
.SH SYNOPSIS
.nf
\fBpackage require zipfs \fR?\fB1.0\fR?
.sp
\fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR?
\fBzipfs exists\fR \fIfilename\fR
\fBzipfs find\fR \fIdirectoryName\fR
\fBzipfs info\fR \fIfilename\fR
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR?
\fBzipfs mkkey\fR \fIpassword\fR
\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
\fBzipfs mount\fR ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
\fBzipfs root\fR
\fBzipfs unmount\fR \fImountpoint\fR
.fi
'\" The following subcommand is *UNDOCUMENTED*
'\" \fBzipfs mount_data\fR ?\fImountpoint\fR? ?\fIdata\fR?
.BE
.SH DESCRIPTION
.PP
The \fBzipfs\fR command (the sole public command provided by the built-in
package with the same name) provides Tcl with the ability to mount the
contents of a ZIP archive file as a virtual file system. ZIP archives support
simple encryption, sufficient to prevent casual inspection of their contents
but not able to prevent access by even a moderately determined attacker.
.TP
\fBzipfs canonical\fR ?\fImountpoint\fR? \fIfilename\fR ?\fIinZipfs\fR?
.
This takes the name of a file, \fIfilename\fR, and produces where it would be
mapped into a zipfs mount as its result. If specified, \fImountpoint\fR says
within which mount the mapping will be done; if omitted, the main root of the
zipfs system is used. The \fIinZipfs\fR argument is a an optional boolean
which controls whether to fully canonicalise the name; it defaults to true.
.TP
\fBzipfs exists\fR \fIfilename\fR
.
Return 1 if the given filename exists in the mounted zipfs and 0 if it does not.
.TP
\fBzipfs find\fR \fIdirectoryName\fR
.
Recursively lists files including and below the directory \fIdirectoryName\fR.
The result list consists of relative path names starting from the given
directory. This command is also used by the \fBzipfs mkzip\fR and \fBzipfs
mkimg\fR commands.
.TP
\fBzipfs info\fR \fIfile\fR
.
Return information about the given \fIfile\fR in the mounted zipfs.  The
information consists of:
.RS
.IP (1)
the name of the ZIP archive file that contains the file,
.IP (2)
the size of the file after decompressions,
.IP (3)
the compressed size of the file, and
.IP (4)
the offset of the compressed data in the ZIP archive file.
.PP
Note: querying the mount point gives the start of the zip data as the offset
in (4), which can be used to truncate the zip information from an executable.
.RE
.TP
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
.
Return a list of all files in the mounted zipfs, or just those matching
\fIpattern\fR (optionally controlled by the option parameters).  The order of
the names in the list is arbitrary.
.TP
\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
.
The \fBzipfs mount\fR command mounts a ZIP archive file as a Tcl virtual
filesystem at \fImountpoint\fR.  After this command executes, files contained
in \fIzipfile\fR will appear to Tcl to be regular files at the mount point.
.RS
.PP
With no \fIzipfile\fR, returns the zipfile mounted at \fImountpoint\fR.  With
no \fImountpoint\fR, return all zipfile/mount pairs.  If \fImountpoint\fR is
specified as an empty string, mount on file path.
.PP
\fBNB:\fR because the current working directory is a concept maintained by the
operating system, using \fBcd\fR into a mounted archive will only work in the
current process, and then not entirely consistently (e.g., if a shared library
uses direct access to the OS rather than through Tcl's filesystem API, it will
not see the current directory as being inside the mount and will not be able
to access the files inside the mount).
.RE
.TP
\fBzipfs root\fR
.
Returns a constant string which indicates the mount point for zipfs volumes
for the current platform. On Windows, this value is
.QW \fBzipfs:/\fR .
On Unix, this value is
.QW \fB//zipfs:/\fR .
.RE
.TP
\fBzipfs unmount \fImountpoint\fR
.
Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
.SS "ZIP CREATION COMMANDS"
This package also provides several commands to aid the creation of ZIP
archives as Tcl applications.
.TP
\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
.
Creates a ZIP archive file named \fIoutfile\fR from the contents of the input
directory \fIindir\fR (contained regular files only) with optional ZIP
password \fIpassword\fR. While processing the files below \fIindir\fR the
optional file name prefix given in \fIstrip\fR is stripped off the beginning
of the respective file name.  When stripping, it is common to remove either
the whole source directory name or the name of its parent directory.
.RS
.PP
\fBCaution:\fR the choice of the \fIindir\fR parameter (less the optional
stripped prefix) determines the later root name of the archive's content.
.RE
.TP
\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR?
.
Creates an image (potentially a new executable file) similar to \fBzipfs
mkzip\fR; see that command for a description of most parameters to this
command, as they behave identically here.
.RS
.PP
If the \fIinfile\fR parameter is specified, this file is prepended in front of
the ZIP archive, otherwise the file returned by \fBinfo nameofexecutable\fR
(i.e., the executable file of the running process) is used. If the
\fIpassword\fR parameter is not empty, an obfuscated version of that password
(see \fBzipfs mkkey\fR) is placed between the image and ZIP chunks of the
output file and the contents of the ZIP chunk are protected with that
password.
.PP
If there is a file, \fBmain.tcl\fR, in the root directory of the resulting
archive and the image file that the archive is attached to is a \fBtclsh\fR
(or \fBwish\fR) instance (true by default, but depends on your configuration),
then the resulting image is an executable that will \fBsource\fR the script in
that \fBmain.tcl\fR after mounting the ZIP archive, and will \fBexit\fR once
that script has been executed.
.PP
\fBCaution:\fR highly experimental, not usable on Android, only partially
tested on Linux and Windows.
.RE
.TP
\fBzipfs mkkey\fR \fIpassword\fR
.
Given the clear text \fIpassword\fR argument, an obfuscated string version is
returned with the same format used in the \fBzipfs mkimg\fR command.
.TP
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
.
This command is like \fBzipfs mkimg\fR, but instead of an input directory,
\fIinlist\fR must be a Tcl list where the odd elements are the names of files
to be copied into the archive in the image, and the even elements are their
respective names within that archive.
.TP
\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
.
This command is like \fBzipfs mkzip\fR, but instead of an input directory,
\fIinlist\fR must be a Tcl list where the odd elements are the names of files
to be copied into the archive, and the even elements are their respective
names within that archive.
.SH "EXAMPLES"
.PP
Mounting an ZIP archive as an application directory and running code out of it
before unmounting it again:
.PP
.CS
set zip myApp.zip
set base [file join [\fbzipfs root\fR] myApp]

\fBzipfs mount\fR $base $zip
# $base now has the contents of myApp.zip

source [file join $base app.tcl]
# use the contents, load libraries from it, etc...

\fBzipfs unmount\fR $zip
.CE
.PP
Creating a ZIP archive, given that a directory exists containing the content
to put in the archive. Note that the source directory is given twice, in order
to strip the exterior directory name from each filename in the archive.
.PP
.CS
set sourceDirectory [file normalize myApp]
set targetZip myApp.zip

\fBzipfs mkzip\fR $targetZip $sourceDirectory $sourceDirectory
.CE
.PP
Encryption can be applied to ZIP archives by providing a password when
building the ZIP and when mounting it.
.PP
.CS
set zip myApp.zip
set sourceDir [file normalize myApp]
set password "hunter2"
set base [file join [\fbzipfs root\fR] myApp]

# Create with password
\fBzipfs mkzip\fR $targetZip $sourceDir $sourceDir $password

# Mount with password
\fBzipfs mount\fR $base $zip $password
.CE
.PP
When creating an executable image with a password, the password is placed
within the executable in a shrouded form so that the application can read
files inside the embedded ZIP archive yet casual inspection cannot read it.
.PP
.CS
set appDir [file normalize myApp]
set img "myApp.bin"
set password "hunter2"

# Create some simple content to define a basic application
file mkdir $appDir
set f [open $appDir/main.tcl]
puts $f {
    puts "Hi. This is [info script]"
}
close $f

# Create the executable
\fBzipfs mkimg\fR $img $appDir $appDir $password

# Launch the executable, printing its output to stdout
exec $img >@stdout
#    prints: \fIHi. This is //zipfs:/app/main.tcl\fR
.CE
.SH "SEE ALSO"
tclsh(1), file(n), zipfs(3), zlib(n)
.SH "KEYWORDS"
compress, filesystem, zip
'\" Local Variables:
'\" mode: nroff
'\" End:
Changes to generic/regc_locale.c.
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
    NOTE(REG_ULOCALE);

    /*
     * Search table.
     */

    Tcl_DStringInit(&ds);
    np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
    for (cn=cnames; cn->name!=NULL; cn++) {
	if (strlen(cn->name)==len && strncmp(cn->name, np, len)==0) {
	    break;			/* NOTE BREAK OUT */
	}
    }
    Tcl_DStringFree(&ds);
    if (cn->name != NULL) {







|







824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
    NOTE(REG_ULOCALE);

    /*
     * Search table.
     */

    Tcl_DStringInit(&ds);
    np = Tcl_UniCharToUtfDString(startp, len, &ds);
    for (cn=cnames; cn->name!=NULL; cn++) {
	if (strlen(cn->name)==len && strncmp(cn->name, np, len)==0) {
	    break;			/* NOTE BREAK OUT */
	}
    }
    Tcl_DStringFree(&ds);
    if (cn->name != NULL) {
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010

    /*
     * Extract the class name
     */

    len = endp - startp;
    Tcl_DStringInit(&ds);
    np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);

    /*
     * Map the name to the corresponding enumerated value.
     */

    index = -1;
    for (namePtr=classNames,i=0 ; *namePtr!=NULL ; namePtr++,i++) {







|







996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010

    /*
     * Extract the class name
     */

    len = endp - startp;
    Tcl_DStringInit(&ds);
    np = Tcl_UniCharToUtfDString(startp, len, &ds);

    /*
     * Map the name to the corresponding enumerated value.
     */

    index = -1;
    for (namePtr=classNames,i=0 ; *namePtr!=NULL ; namePtr++,i++) {
Changes to generic/regcustom.h.
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

#include "regex.h"

/*
 * Overrides for regguts.h definitions, if any.
 */

#define	MALLOC(n)		(void*)(attemptckalloc(n))
#define	FREE(p)			ckfree((void*)(p))
#define	REALLOC(p,n)		(void*)(attemptckrealloc((void*)(p),n))

/*
 * Do not insert extras between the "begin" and "end" lines - this chunk is
 * automatically extracted to be fitted into regex.h.
 */

/* --- begin --- */







|
|
|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

#include "regex.h"

/*
 * Overrides for regguts.h definitions, if any.
 */

#define	MALLOC(n)		Tcl_AttemptAlloc(n)
#define	FREE(p)			Tcl_Free(p)
#define	REALLOC(p,n)		Tcl_AttemptRealloc(p,n)

/*
 * Do not insert extras between the "begin" and "end" lines - this chunk is
 * automatically extracted to be fitted into regex.h.
 */

/* --- begin --- */
Changes to generic/tcl.decls.
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
	    const char *name, const char *version, int exact,
	    void *clientDataPtr)
}
declare 2 {
    TCL_NORETURN void Tcl_Panic(const char *format, ...)
}
declare 3 {
    char *Tcl_Alloc(unsigned int size)
}
declare 4 {
    void Tcl_Free(char *ptr)
}
declare 5 {
    char *Tcl_Realloc(char *ptr, unsigned int size)
}
declare 6 {
    char *Tcl_DbCkalloc(unsigned int size, const char *file, int line)
}
declare 7 {
    void Tcl_DbCkfree(char *ptr, const char *file, int line)
}
declare 8 {
    char *Tcl_DbCkrealloc(char *ptr, unsigned int size,
	    const char *file, int line)
}

# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix,
# but they are part of the old generic interface, so we include them here for
# compatibility reasons.

declare 9 unix {
    void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc,
	    ClientData clientData)
}
declare 10 unix {
    void Tcl_DeleteFileHandler(int fd)
}
declare 11 {
    void Tcl_SetTimer(const Tcl_Time *timePtr)
}
declare 12 {
    void Tcl_Sleep(int ms)
}
declare 13 {
    int Tcl_WaitForEvent(const Tcl_Time *timePtr)
}
declare 14 {
    int Tcl_AppendAllObjTypes(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 15 {
    void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...)
}
declare 16 {
    void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, int length)
}
declare 17 {
    Tcl_Obj *Tcl_ConcatObj(int objc, Tcl_Obj *const objv[])
}
declare 18 {
    int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    const Tcl_ObjType *typePtr)







|


|


|


|


|


|









|




















|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
	    const char *name, const char *version, int exact,
	    void *clientDataPtr)
}
declare 2 {
    TCL_NORETURN void Tcl_Panic(const char *format, ...)
}
declare 3 {
    void *Tcl_Alloc(size_t size)
}
declare 4 {
    void Tcl_Free(void *ptr)
}
declare 5 {
    void *Tcl_Realloc(void *ptr, size_t size)
}
declare 6 {
    void *Tcl_DbCkalloc(size_t size, const char *file, int line)
}
declare 7 {
    void Tcl_DbCkfree(void *ptr, const char *file, int line)
}
declare 8 {
    void *Tcl_DbCkrealloc(void *ptr, size_t size,
	    const char *file, int line)
}

# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix,
# but they are part of the old generic interface, so we include them here for
# compatibility reasons.

declare 9 unix {
    void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc,
	    void *clientData)
}
declare 10 unix {
    void Tcl_DeleteFileHandler(int fd)
}
declare 11 {
    void Tcl_SetTimer(const Tcl_Time *timePtr)
}
declare 12 {
    void Tcl_Sleep(int ms)
}
declare 13 {
    int Tcl_WaitForEvent(const Tcl_Time *timePtr)
}
declare 14 {
    int Tcl_AppendAllObjTypes(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 15 {
    void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...)
}
declare 16 {
    void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, size_t length)
}
declare 17 {
    Tcl_Obj *Tcl_ConcatObj(int objc, Tcl_Obj *const objv[])
}
declare 18 {
    int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    const Tcl_ObjType *typePtr)
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
    int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 22 {
#    Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
#}
declare 23 {
    Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length,
	    const char *file, int line)
}
declare 24 {
    Tcl_Obj *Tcl_DbNewDoubleObj(double doubleValue, const char *file,
	    int line)
}
declare 25 {
    Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
	    const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 26 {
#    Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
#}
declare 27 {
    Tcl_Obj *Tcl_DbNewObj(const char *file, int line)
}
declare 28 {
    Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, int length,
	    const char *file, int line)
}
declare 29 {
    Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr)
}
declare 30 {
    void TclFreeObj(Tcl_Obj *objPtr)







|


















|







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
    int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 22 {
#    Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
#}
declare 23 {
    Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, size_t length,
	    const char *file, int line)
}
declare 24 {
    Tcl_Obj *Tcl_DbNewDoubleObj(double doubleValue, const char *file,
	    int line)
}
declare 25 {
    Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
	    const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 26 {
#    Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
#}
declare 27 {
    Tcl_Obj *Tcl_DbNewObj(const char *file, int line)
}
declare 28 {
    Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, size_t length,
	    const char *file, int line)
}
declare 29 {
    Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr)
}
declare 30 {
    void TclFreeObj(Tcl_Obj *objPtr)
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
	    int count, int objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 49 {
#    Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
#}
declare 50 {
    Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length)
}
declare 51 {
    Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
# Removed in 9.0 (changed to macro):
#declare 52 {
#    Tcl_Obj *Tcl_NewIntObj(int intValue)
#}
declare 53 {
    Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 54 {
#    Tcl_Obj *Tcl_NewLongObj(long longValue)
#}
declare 55 {
    Tcl_Obj *Tcl_NewObj(void)
}
declare 56 {
    Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}
# Removed in 9.0 (changed to macro):
#declare 57 {
#    void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
#}
declare 58 {
    unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
}
declare 59 {
    void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes,
	    int length)
}
declare 60 {
    void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
# Removed in 9.0 (changed to macro):
#declare 61 {
#    void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
#}
declare 62 {
    void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 63 {
#    void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
#}
declare 64 {
    void Tcl_SetObjLength(Tcl_Obj *objPtr, int length)
}
declare 65 {
    void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length)
}
# Removed in 9.0, replaced by macro.
#declare 66 {deprecated {No longer in use, changed to macro}} {
#    void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
#}
# Removed in 9.0, replaced by macro.
#declare 67 {deprecated {No longer in use, changed to macro}} {







|



















|






|



|
















|


|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
	    int count, int objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 49 {
#    Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
#}
declare 50 {
    Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, size_t length)
}
declare 51 {
    Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
# Removed in 9.0 (changed to macro):
#declare 52 {
#    Tcl_Obj *Tcl_NewIntObj(int intValue)
#}
declare 53 {
    Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 54 {
#    Tcl_Obj *Tcl_NewLongObj(long longValue)
#}
declare 55 {
    Tcl_Obj *Tcl_NewObj(void)
}
declare 56 {
    Tcl_Obj *Tcl_NewStringObj(const char *bytes, size_t length)
}
# Removed in 9.0 (changed to macro):
#declare 57 {
#    void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
#}
declare 58 {
    unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, size_t length)
}
declare 59 {
    void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes,
	    size_t length)
}
declare 60 {
    void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
# Removed in 9.0 (changed to macro):
#declare 61 {
#    void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
#}
declare 62 {
    void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 63 {
#    void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
#}
declare 64 {
    void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length)
}
declare 65 {
    void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, size_t length)
}
# Removed in 9.0, replaced by macro.
#declare 66 {deprecated {No longer in use, changed to macro}} {
#    void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
#}
# Removed in 9.0, replaced by macro.
#declare 67 {deprecated {No longer in use, changed to macro}} {
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
    void Tcl_AppendElement(Tcl_Interp *interp, const char *element)
}
declare 70 {
    void Tcl_AppendResult(Tcl_Interp *interp, ...)
}
declare 71 {
    Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc,
	    ClientData clientData)
}
declare 72 {
    void Tcl_AsyncDelete(Tcl_AsyncHandler async)
}
declare 73 {
    int Tcl_AsyncInvoke(Tcl_Interp *interp, int code)
}







|







277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
    void Tcl_AppendElement(Tcl_Interp *interp, const char *element)
}
declare 70 {
    void Tcl_AppendResult(Tcl_Interp *interp, ...)
}
declare 71 {
    Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc,
	    void *clientData)
}
declare 72 {
    void Tcl_AsyncDelete(Tcl_AsyncHandler async)
}
declare 73 {
    int Tcl_AsyncInvoke(Tcl_Interp *interp, int code)
}
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
#}
declare 78 {
    int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
	    const char *optionList)
}
declare 79 {
    void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
	    ClientData clientData)
}
declare 80 {
    void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData)
}
declare 81 {
    int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 82 {
    int Tcl_CommandComplete(const char *cmd)
}
declare 83 {
    char *Tcl_Concat(int argc, const char *const *argv)
}
declare 84 {
    int Tcl_ConvertElement(const char *src, char *dst, int flags)
}
declare 85 {
    int Tcl_ConvertCountedElement(const char *src, int length, char *dst,
	    int flags)
}
declare 86 {
    int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
	    Tcl_Interp *target, const char *targetCmd, int argc,
	    const char *const *argv)
}
declare 87 {
    int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
	    Tcl_Interp *target, const char *targetCmd, int objc,
	    Tcl_Obj *const objv[])
}
declare 88 {
    Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
	    const char *chanName, ClientData instanceData, int mask)
}
declare 89 {
    void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
	    Tcl_ChannelProc *proc, ClientData clientData)
}
declare 90 {
    void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
	    ClientData clientData)
}
declare 91 {
    Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName,
	    Tcl_CmdProc *proc, ClientData clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 92 {
    void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
	    Tcl_EventCheckProc *checkProc, ClientData clientData)
}
declare 93 {
    void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 94 {
    Tcl_Interp *Tcl_CreateInterp(void)
}
# Removed in 9.0:
#declare 95 {deprecated {}} {
#    void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
#	    int numArgs, Tcl_ValueType *argTypes,
#	    Tcl_MathProc *proc, ClientData clientData)
#}
declare 96 {
    Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
	    const char *cmdName,
	    Tcl_ObjCmdProc *proc, ClientData clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 97 {
    Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName,
	    int isSafe)
}
declare 98 {
    Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
	    Tcl_TimerProc *proc, ClientData clientData)
}
declare 99 {
    Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level,
	    Tcl_CmdTraceProc *proc, ClientData clientData)
}
declare 100 {
    void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name)
}
declare 101 {
    void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc,
	    ClientData clientData)
}
declare 102 {
    void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
	    ClientData clientData)
}
declare 103 {
    int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName)
}
declare 104 {
    int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command)
}
declare 105 {
    void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData)
}
declare 106 {
    void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
	    Tcl_EventCheckProc *checkProc, ClientData clientData)
}
declare 107 {
    void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 108 {
    void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr)
}
declare 109 {
    void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr)
}







|


|











|


|














|



|



|



|




|


|








|




|








|



|






|



|








|



|


|







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
#}
declare 78 {
    int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
	    const char *optionList)
}
declare 79 {
    void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
	    void *clientData)
}
declare 80 {
    void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, void *clientData)
}
declare 81 {
    int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 82 {
    int Tcl_CommandComplete(const char *cmd)
}
declare 83 {
    char *Tcl_Concat(int argc, const char *const *argv)
}
declare 84 {
    size_t Tcl_ConvertElement(const char *src, char *dst, int flags)
}
declare 85 {
    size_t Tcl_ConvertCountedElement(const char *src, size_t length, char *dst,
	    int flags)
}
declare 86 {
    int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
	    Tcl_Interp *target, const char *targetCmd, int argc,
	    const char *const *argv)
}
declare 87 {
    int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
	    Tcl_Interp *target, const char *targetCmd, int objc,
	    Tcl_Obj *const objv[])
}
declare 88 {
    Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
	    const char *chanName, void *instanceData, int mask)
}
declare 89 {
    void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
	    Tcl_ChannelProc *proc, void *clientData)
}
declare 90 {
    void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
	    void *clientData)
}
declare 91 {
    Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName,
	    Tcl_CmdProc *proc, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 92 {
    void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
	    Tcl_EventCheckProc *checkProc, void *clientData)
}
declare 93 {
    void Tcl_CreateExitHandler(Tcl_ExitProc *proc, void *clientData)
}
declare 94 {
    Tcl_Interp *Tcl_CreateInterp(void)
}
# Removed in 9.0:
#declare 95 {deprecated {}} {
#    void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
#	    int numArgs, Tcl_ValueType *argTypes,
#	    Tcl_MathProc *proc, void *clientData)
#}
declare 96 {
    Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
	    const char *cmdName,
	    Tcl_ObjCmdProc *proc, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 97 {
    Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName,
	    int isSafe)
}
declare 98 {
    Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
	    Tcl_TimerProc *proc, void *clientData)
}
declare 99 {
    Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level,
	    Tcl_CmdTraceProc *proc, void *clientData)
}
declare 100 {
    void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name)
}
declare 101 {
    void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc,
	    void *clientData)
}
declare 102 {
    void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
	    void *clientData)
}
declare 103 {
    int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName)
}
declare 104 {
    int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command)
}
declare 105 {
    void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, void *clientData)
}
declare 106 {
    void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
	    Tcl_EventCheckProc *checkProc, void *clientData)
}
declare 107 {
    void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, void *clientData)
}
declare 108 {
    void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr)
}
declare 109 {
    void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr)
}
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
    void Tcl_DeleteTimerHandler(Tcl_TimerToken token)
}
declare 113 {
    void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace)
}
declare 114 {
    void Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
	    Tcl_InterpDeleteProc *proc, ClientData clientData)
}
declare 115 {
    int Tcl_DoOneEvent(int flags)
}
declare 116 {
    void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData)
}
declare 117 {
    char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, int length)
}
declare 118 {
    char *Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element)
}
declare 119 {
    void Tcl_DStringEndSublist(Tcl_DString *dsPtr)
}
declare 120 {
    void Tcl_DStringFree(Tcl_DString *dsPtr)
}
declare 121 {
    void Tcl_DStringGetResult(Tcl_Interp *interp, Tcl_DString *dsPtr)
}
declare 122 {
    void Tcl_DStringInit(Tcl_DString *dsPtr)
}
declare 123 {
    void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr)
}
declare 124 {
    void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length)
}
declare 125 {
    void Tcl_DStringStartSublist(Tcl_DString *dsPtr)
}
declare 126 {
    int Tcl_Eof(Tcl_Channel chan)
}







|





|


|




















|







433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
    void Tcl_DeleteTimerHandler(Tcl_TimerToken token)
}
declare 113 {
    void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace)
}
declare 114 {
    void Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
	    Tcl_InterpDeleteProc *proc, void *clientData)
}
declare 115 {
    int Tcl_DoOneEvent(int flags)
}
declare 116 {
    void Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData)
}
declare 117 {
    char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, size_t length)
}
declare 118 {
    char *Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element)
}
declare 119 {
    void Tcl_DStringEndSublist(Tcl_DString *dsPtr)
}
declare 120 {
    void Tcl_DStringFree(Tcl_DString *dsPtr)
}
declare 121 {
    void Tcl_DStringGetResult(Tcl_Interp *interp, Tcl_DString *dsPtr)
}
declare 122 {
    void Tcl_DStringInit(Tcl_DString *dsPtr)
}
declare 123 {
    void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr)
}
declare 124 {
    void Tcl_DStringSetLength(Tcl_DString *dsPtr, size_t length)
}
declare 125 {
    void Tcl_DStringStartSublist(Tcl_DString *dsPtr)
}
declare 126 {
    int Tcl_Eof(Tcl_Channel chan)
}
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
    int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
# Removed in 9.0, replaced by macro.
#declare 131 {
#    int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
declare 132 {
    void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
}
declare 133 {
    TCL_NORETURN void Tcl_Exit(int status)
}
declare 134 {
    int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken,
	    const char *cmdName)







|







489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
    int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
# Removed in 9.0, replaced by macro.
#declare 131 {
#    int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
declare 132 {
    void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc)
}
declare 133 {
    TCL_NORETURN void Tcl_Exit(int status)
}
declare 134 {
    int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken,
	    const char *cmdName)
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
}
declare 149 {
    int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
	    int *objcPtr, Tcl_Obj ***objv)
}
declare 150 {
    ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name,
	    Tcl_InterpDeleteProc **procPtr)
}
declare 151 {
    Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName,
	    int *modePtr)
}
declare 152 {
    int Tcl_GetChannelBufferSize(Tcl_Channel chan)
}
declare 153 {
    int Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
	    ClientData *handlePtr)
}
declare 154 {
    ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan)
}
declare 155 {
    int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 {
    const char *Tcl_GetChannelName(Tcl_Channel chan)
}







|











|


|







551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
}
declare 149 {
    int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
	    int *objcPtr, Tcl_Obj ***objv)
}
declare 150 {
    void *Tcl_GetAssocData(Tcl_Interp *interp, const char *name,
	    Tcl_InterpDeleteProc **procPtr)
}
declare 151 {
    Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName,
	    int *modePtr)
}
declare 152 {
    int Tcl_GetChannelBufferSize(Tcl_Channel chan)
}
declare 153 {
    int Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
	    void **handlePtr)
}
declare 154 {
    void *Tcl_GetChannelInstanceData(Tcl_Channel chan)
}
declare 155 {
    int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 {
    const char *Tcl_GetChannelName(Tcl_Channel chan)
}
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
}

# Tcl_GetOpenFile is only available on unix, but it is a part of the old
# generic interface, so we inlcude it here for compatibility reasons.

declare 167 unix {
    int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting,
	    int checkUsage, ClientData *filePtr)
}
# Obsolete.  Should now use Tcl_FSGetPathType which is objectified
# and therefore usually faster.
declare 168 {
    Tcl_PathType Tcl_GetPathType(const char *path)
}
declare 169 {
    int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr)
}
declare 170 {
    int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 171 {
    int Tcl_GetServiceMode(void)
}
declare 172 {
    Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName)
}







|







|


|







613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
}

# Tcl_GetOpenFile is only available on unix, but it is a part of the old
# generic interface, so we inlcude it here for compatibility reasons.

declare 167 unix {
    int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting,
	    int checkUsage, void **filePtr)
}
# Obsolete.  Should now use Tcl_FSGetPathType which is objectified
# and therefore usually faster.
declare 168 {
    Tcl_PathType Tcl_GetPathType(const char *path)
}
declare 169 {
    size_t Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr)
}
declare 170 {
    size_t Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 171 {
    int Tcl_GetServiceMode(void)
}
declare 172 {
    Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName)
}
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713

# This slot is reserved for use by the plus patch:
#  declare 188 {
#	Tcl_MainLoop
#  }

declare 189 {
    Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode)
}
declare 190 {
    int Tcl_MakeSafe(Tcl_Interp *interp)
}
declare 191 {
    Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
}
declare 192 {
    char *Tcl_Merge(int argc, const char *const *argv)
}
declare 193 {
    Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
}







|





|







693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713

# This slot is reserved for use by the plus patch:
#  declare 188 {
#	Tcl_MainLoop
#  }

declare 189 {
    Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode)
}
declare 190 {
    int Tcl_MakeSafe(Tcl_Interp *interp)
}
declare 191 {
    Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket)
}
declare 192 {
    char *Tcl_Merge(int argc, const char *const *argv)
}
declare 193 {
    Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
}
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
declare 199 {
    Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
	    const char *address, const char *myaddr, int myport, int async)
}
declare 200 {
    Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
	    const char *host, Tcl_TcpAcceptProc *acceptProc,
	    ClientData callbackData)
}
declare 201 {
    void Tcl_Preserve(ClientData data)
}
declare 202 {
    void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst)
}
declare 203 {
    int Tcl_PutEnv(const char *assignment)
}
declare 204 {
    const char *Tcl_PosixError(Tcl_Interp *interp)
}
declare 205 {
    void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
}
declare 206 {
    int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead)
}
declare 207 {
    void Tcl_ReapDetachedProcs(void)
}
declare 208 {
    int Tcl_RecordAndEval(Tcl_Interp *interp, const char *cmd, int flags)
}







|


|














|







734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
declare 199 {
    Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
	    const char *address, const char *myaddr, int myport, int async)
}
declare 200 {
    Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
	    const char *host, Tcl_TcpAcceptProc *acceptProc,
	    void *callbackData)
}
declare 201 {
    void Tcl_Preserve(void *data)
}
declare 202 {
    void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst)
}
declare 203 {
    int Tcl_PutEnv(const char *assignment)
}
declare 204 {
    const char *Tcl_PosixError(Tcl_Interp *interp)
}
declare 205 {
    void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
}
declare 206 {
    size_t Tcl_Read(Tcl_Channel chan, char *bufPtr, size_t toRead)
}
declare 207 {
    void Tcl_ReapDetachedProcs(void)
}
declare 208 {
    int Tcl_RecordAndEval(Tcl_Interp *interp, const char *cmd, int flags)
}
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
	    const char *text, const char *start)
}
declare 214 {
    int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
	    const char *pattern)
}
declare 215 {
    void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
	    const char **startPtr, const char **endPtr)
}
declare 216 {
    void Tcl_Release(ClientData clientData)
}
declare 217 {
    void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 {
    int Tcl_ScanElement(const char *src, int *flagPtr)
}
declare 219 {
    int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
# Removed in 9.0:
#declare 220 {
#    int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
#}
declare 221 {
    int Tcl_ServiceAll(void)
}
declare 222 {
    int Tcl_ServiceEvent(int flags)
}
declare 223 {
    void Tcl_SetAssocData(Tcl_Interp *interp, const char *name,
	    Tcl_InterpDeleteProc *proc, ClientData clientData)
}
declare 224 {
    void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz)
}
declare 225 {
    int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
	    const char *optionName, const char *newValue)







|



|





|


|













|







781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
	    const char *text, const char *start)
}
declare 214 {
    int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
	    const char *pattern)
}
declare 215 {
    void Tcl_RegExpRange(Tcl_RegExp regexp, size_t index,
	    const char **startPtr, const char **endPtr)
}
declare 216 {
    void Tcl_Release(void *clientData)
}
declare 217 {
    void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 {
    size_t Tcl_ScanElement(const char *src, int *flagPtr)
}
declare 219 {
    size_t Tcl_ScanCountedElement(const char *src, size_t length, int *flagPtr)
}
# Removed in 9.0:
#declare 220 {
#    int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
#}
declare 221 {
    int Tcl_ServiceAll(void)
}
declare 222 {
    int Tcl_ServiceEvent(int flags)
}
declare 223 {
    void Tcl_SetAssocData(Tcl_Interp *interp, const char *name,
	    Tcl_InterpDeleteProc *proc, void *clientData)
}
declare 224 {
    void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz)
}
declare 225 {
    int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
	    const char *optionName, const char *newValue)
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
# Removed in 9.0, replaced by macro.
#declare 247 {deprecated {No longer in use, changed to macro}} {
#    int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
#	    Tcl_VarTraceProc *proc, ClientData clientData)
#}
declare 248 {
    int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags, Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 249 {
    char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name,
	    Tcl_DString *bufferPtr)
}
declare 250 {
    int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead)
}
declare 251 {
    void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName)
}
declare 252 {
    int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}







|






|







898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
# Removed in 9.0, replaced by macro.
#declare 247 {deprecated {No longer in use, changed to macro}} {
#    int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
#	    Tcl_VarTraceProc *proc, ClientData clientData)
#}
declare 248 {
    int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags, Tcl_VarTraceProc *proc, void *clientData)
}
declare 249 {
    char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name,
	    Tcl_DString *bufferPtr)
}
declare 250 {
    size_t Tcl_Ungets(Tcl_Channel chan, const char *str, size_t len, int atHead)
}
declare 251 {
    void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName)
}
declare 252 {
    int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
#declare 255 {deprecated {No longer in use, changed to macro}} {
#    void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
#	    Tcl_VarTraceProc *proc, ClientData clientData)
#}
declare 256 {
    void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *proc,
	    ClientData clientData)
}
declare 257 {
    void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
}
# Removed in 9.0, replaced by macro.
#declare 258 {deprecated {No longer in use, changed to macro}} {
#    int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,







|







929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
#declare 255 {deprecated {No longer in use, changed to macro}} {
#    void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
#	    Tcl_VarTraceProc *proc, ClientData clientData)
#}
declare 256 {
    void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *proc,
	    void *clientData)
}
declare 257 {
    void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
}
# Removed in 9.0, replaced by macro.
#declare 258 {deprecated {No longer in use, changed to macro}} {
#    int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
#}
# Removed in 9.0, replaced by macro.
#declare 261 {deprecated {No longer in use, changed to macro}} {
#    ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
#	    int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
#}
declare 262 {
    ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *procPtr,
	    ClientData prevClientData)
}
declare 263 {
    int Tcl_Write(Tcl_Channel chan, const char *s, int slen)
}
declare 264 {
    void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
	    Tcl_Obj *const objv[], const char *message)
}
declare 265 {
    int Tcl_DumpActiveMemory(const char *fileName)







|

|


|







953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
#}
# Removed in 9.0, replaced by macro.
#declare 261 {deprecated {No longer in use, changed to macro}} {
#    ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
#	    int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
#}
declare 262 {
    void *Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *procPtr,
	    void *prevClientData)
}
declare 263 {
    size_t Tcl_Write(Tcl_Channel chan, const char *s, size_t slen)
}
declare 264 {
    void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
	    Tcl_Obj *const objv[], const char *message)
}
declare 265 {
    int Tcl_DumpActiveMemory(const char *fileName)
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
# to the alphabetical order used elsewhere in this file, but I decided
# against that to ease the maintenance of the patch across new tcl versions
# (patch usually has no problems to integrate the patch file for the last
# version into the new one).

declare 281 {
    Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp,
	    const Tcl_ChannelType *typePtr, ClientData instanceData,
	    int mask, Tcl_Channel prevChan)
}
declare 282 {
    int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 283 {
    Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan)







|







1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
# to the alphabetical order used elsewhere in this file, but I decided
# against that to ease the maintenance of the patch across new tcl versions
# (patch usually has no problems to integrate the patch file for the last
# version into the new one).

declare 281 {
    Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp,
	    const Tcl_ChannelType *typePtr, void *instanceData,
	    int mask, Tcl_Channel prevChan)
}
declare 282 {
    int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 283 {
    Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan)
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
declare 286 {
    void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr)
}
declare 287 {
    Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr)
}
declare 288 {
    void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 289 {
    void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
# Removed in 9.0, replaced by macro.
#declare 290 {
#    void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
#}
declare 291 {
    int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes,
	    int flags)
}
declare 292 {
    int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
	    int flags)
}
declare 293 {
    int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
declare 294 {
    TCL_NORETURN void Tcl_ExitThread(int status)
}
declare 295 {
    int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding,
	    const char *src, int srcLen, int flags,
	    Tcl_EncodingState *statePtr, char *dst, int dstLen,
	    int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 296 {
    char *Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
	    const char *src, int srcLen, Tcl_DString *dsPtr)
}
declare 297 {
    void Tcl_FinalizeThread(void)
}
declare 298 {
    void Tcl_FinalizeNotifier(ClientData clientData)
}
declare 299 {
    void Tcl_FreeEncoding(Tcl_Encoding encoding)
}
declare 300 {
    Tcl_ThreadId Tcl_GetCurrentThread(void)
}
declare 301 {
    Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name)
}
declare 302 {
    const char *Tcl_GetEncodingName(Tcl_Encoding encoding)
}
declare 303 {
    void Tcl_GetEncodingNames(Tcl_Interp *interp)
}
declare 304 {
    int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    const void *tablePtr, int offset, const char *msg, int flags,
	    int *indexPtr)
}
declare 305 {
    void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size)
}
declare 306 {
    Tcl_Obj *Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags)
}
declare 307 {
    ClientData Tcl_InitNotifier(void)
}
declare 308 {
    void Tcl_MutexLock(Tcl_Mutex *mutexPtr)
}
declare 309 {
    void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr)
}
declare 310 {
    void Tcl_ConditionNotify(Tcl_Condition *condPtr)
}
declare 311 {
    void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr,
	    const Tcl_Time *timePtr)
}
declare 312 {
    int Tcl_NumUtfChars(const char *src, int length)
}
declare 313 {
    int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead,
	    int appendFlag)
}
# Removed in 9.0, replaced by macro.
#declare 314 {deprecated {No longer in use, changed to macro}} {
#    void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
#}
# Removed in 9.0, replaced by macro.
#declare 315 {deprecated {No longer in use, changed to macro}} {







|


|






|














|
|




|





|


















|



|






|















|


|
|







1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
declare 286 {
    void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr)
}
declare 287 {
    Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr)
}
declare 288 {
    void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, void *clientData)
}
declare 289 {
    void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, void *clientData)
}
# Removed in 9.0, replaced by macro.
#declare 290 {
#    void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
#}
declare 291 {
    int Tcl_EvalEx(Tcl_Interp *interp, const char *script, size_t numBytes,
	    int flags)
}
declare 292 {
    int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
	    int flags)
}
declare 293 {
    int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
declare 294 {
    TCL_NORETURN void Tcl_ExitThread(int status)
}
declare 295 {
    int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding,
	    const char *src, size_t srcLen, int flags,
	    Tcl_EncodingState *statePtr, char *dst, size_t dstLen,
	    int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 296 {
    char *Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
	    const char *src, size_t srcLen, Tcl_DString *dsPtr)
}
declare 297 {
    void Tcl_FinalizeThread(void)
}
declare 298 {
    void Tcl_FinalizeNotifier(void *clientData)
}
declare 299 {
    void Tcl_FreeEncoding(Tcl_Encoding encoding)
}
declare 300 {
    Tcl_ThreadId Tcl_GetCurrentThread(void)
}
declare 301 {
    Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name)
}
declare 302 {
    const char *Tcl_GetEncodingName(Tcl_Encoding encoding)
}
declare 303 {
    void Tcl_GetEncodingNames(Tcl_Interp *interp)
}
declare 304 {
    int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    const void *tablePtr, size_t offset, const char *msg, int flags,
	    int *indexPtr)
}
declare 305 {
    void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, size_t size)
}
declare 306 {
    Tcl_Obj *Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags)
}
declare 307 {
    void *Tcl_InitNotifier(void)
}
declare 308 {
    void Tcl_MutexLock(Tcl_Mutex *mutexPtr)
}
declare 309 {
    void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr)
}
declare 310 {
    void Tcl_ConditionNotify(Tcl_Condition *condPtr)
}
declare 311 {
    void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr,
	    const Tcl_Time *timePtr)
}
declare 312 {
    size_t Tcl_NumUtfChars(const char *src, size_t length)
}
declare 313 {
    size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
	    size_t charsToRead, int appendFlag)
}
# Removed in 9.0, replaced by macro.
#declare 314 {deprecated {No longer in use, changed to macro}} {
#    void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
#}
# Removed in 9.0, replaced by macro.
#declare 315 {deprecated {No longer in use, changed to macro}} {
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
    void Tcl_ThreadAlert(Tcl_ThreadId threadId)
}
declare 319 {
    void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr,
	    Tcl_QueuePosition position)
}
declare 320 {
    int Tcl_UniCharAtIndex(const char *src, int index)
}
declare 321 {
    int Tcl_UniCharToLower(int ch)
}
declare 322 {
    int Tcl_UniCharToTitle(int ch)
}
declare 323 {
    int Tcl_UniCharToUpper(int ch)
}
declare 324 {
    int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
    const char *Tcl_UtfAtIndex(const char *src, int index)
}
declare 326 {
    int Tcl_UtfCharComplete(const char *src, int length)
}
declare 327 {
    int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
}
declare 328 {
    const char *Tcl_UtfFindFirst(const char *src, int ch)
}
declare 329 {
    const char *Tcl_UtfFindLast(const char *src, int ch)
}
declare 330 {
    const char *Tcl_UtfNext(const char *src)
}
declare 331 {
    const char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 332 {
    int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
	    const char *src, int srcLen, int flags,
	    Tcl_EncodingState *statePtr, char *dst, int dstLen,
	    int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 333 {
    char *Tcl_UtfToExternalDString(Tcl_Encoding encoding,
	    const char *src, int srcLen, Tcl_DString *dsPtr)
}
declare 334 {
    int Tcl_UtfToLower(char *src)
}
declare 335 {
    int Tcl_UtfToTitle(char *src)
}
declare 336 {
    int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr)
}
declare 337 {
    int Tcl_UtfToUpper(char *src)
}
declare 338 {
    int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen)
}
declare 339 {
    int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 {
    char *Tcl_GetString(Tcl_Obj *objPtr)
}
# Removed in 9.0:
#declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
#    const char *Tcl_GetDefaultEncodingDir(void)
#}
# Removed in 9.0:
#declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
#    void Tcl_SetDefaultEncodingDir(const char *path)
#}
declare 343 {
    void Tcl_AlertNotifier(ClientData clientData)
}
declare 344 {
    void Tcl_ServiceModeHook(int mode)
}
declare 345 {
    int Tcl_UniCharIsAlnum(int ch)
}







|














|


|


|















|
|




|














|


|













|







1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
    void Tcl_ThreadAlert(Tcl_ThreadId threadId)
}
declare 319 {
    void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr,
	    Tcl_QueuePosition position)
}
declare 320 {
    int Tcl_UniCharAtIndex(const char *src, size_t index)
}
declare 321 {
    int Tcl_UniCharToLower(int ch)
}
declare 322 {
    int Tcl_UniCharToTitle(int ch)
}
declare 323 {
    int Tcl_UniCharToUpper(int ch)
}
declare 324 {
    int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
    const char *Tcl_UtfAtIndex(const char *src, size_t index)
}
declare 326 {
    int Tcl_UtfCharComplete(const char *src, size_t length)
}
declare 327 {
    size_t Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
}
declare 328 {
    const char *Tcl_UtfFindFirst(const char *src, int ch)
}
declare 329 {
    const char *Tcl_UtfFindLast(const char *src, int ch)
}
declare 330 {
    const char *Tcl_UtfNext(const char *src)
}
declare 331 {
    const char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 332 {
    int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
	    const char *src, size_t srcLen, int flags,
	    Tcl_EncodingState *statePtr, char *dst, size_t dstLen,
	    int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 333 {
    char *Tcl_UtfToExternalDString(Tcl_Encoding encoding,
	    const char *src, size_t srcLen, Tcl_DString *dsPtr)
}
declare 334 {
    int Tcl_UtfToLower(char *src)
}
declare 335 {
    int Tcl_UtfToTitle(char *src)
}
declare 336 {
    int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr)
}
declare 337 {
    int Tcl_UtfToUpper(char *src)
}
declare 338 {
    size_t Tcl_WriteChars(Tcl_Channel chan, const char *src, size_t srcLen)
}
declare 339 {
    size_t Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 {
    char *Tcl_GetString(Tcl_Obj *objPtr)
}
# Removed in 9.0:
#declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
#    const char *Tcl_GetDefaultEncodingDir(void)
#}
# Removed in 9.0:
#declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
#    void Tcl_SetDefaultEncodingDir(const char *path)
#}
declare 343 {
    void Tcl_AlertNotifier(void *clientData)
}
declare 344 {
    void Tcl_ServiceModeHook(int mode)
}
declare 345 {
    int Tcl_UniCharIsAlnum(int ch)
}
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325

1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
declare 350 {
    int Tcl_UniCharIsUpper(int ch)
}
declare 351 {
    int Tcl_UniCharIsWordChar(int ch)
}
declare 352 {
    int Tcl_UniCharLen(const Tcl_UniChar *uniStr)
}
declare 353 {
    int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
	    unsigned long numChars)
}
declare 354 {
    char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr,
	    int uniLength, Tcl_DString *dsPtr)
}
declare 355 {
    Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src,
	    int length, Tcl_DString *dsPtr)
}
declare 356 {
    Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
	    int flags)
}
# Removed in 9.0:
#declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
#    Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
#	    int count)
#}
declare 358 {
    void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
declare 359 {
    void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script,
	    const char *command, int length)
}
declare 360 {
    int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes,
	    Tcl_Parse *parsePtr, int append, const char **termPtr)

}
declare 361 {
    int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes,
	    int nested, Tcl_Parse *parsePtr)
}
declare 362 {
    int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes,
	    Tcl_Parse *parsePtr)
}
declare 363 {
    int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start,
	    int numBytes, Tcl_Parse *parsePtr, int append,
	    const char **termPtr)
}
declare 364 {
    int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes,
	    Tcl_Parse *parsePtr, int append)
}
# These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir,
# Tcl_FSAccess and Tcl_FSStat
declare 365 {
    char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 366 {
   int Tcl_Chdir(const char *dirName)
}
declare 367 {
   int Tcl_Access(const char *path, int mode)
}
declare 368 {
    int Tcl_Stat(const char *path, struct stat *bufPtr)
}
declare 369 {
    int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n)
}
declare 370 {
    int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n)
}
declare 371 {
    int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase)
}
declare 372 {
    int Tcl_UniCharIsControl(int ch)
}
declare 373 {
    int Tcl_UniCharIsGraph(int ch)
}
declare 374 {
    int Tcl_UniCharIsPrint(int ch)
}
declare 375 {
    int Tcl_UniCharIsPunct(int ch)
}
declare 376 {
    int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp,
	    Tcl_Obj *textObj, int offset, int nmatches, int flags)
}
declare 377 {
    void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)
}
declare 378 {
    Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, int numChars)
}
declare 379 {
    void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
	    int numChars)
}
declare 380 {
    int Tcl_GetCharLength(Tcl_Obj *objPtr)
}
declare 381 {
    int Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
}
# Removed in 9.0, replaced by macro.
#declare 382 {deprecated {No longer in use, changed to macro}} {
#    Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
#}
declare 383 {
    Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last)
}
declare 384 {
    void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
	    int length)
}
declare 385 {
    int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj,
	    Tcl_Obj *patternObj)
}
declare 386 {
    void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr)
}
declare 387 {
    Tcl_Mutex *Tcl_GetAllocMutex(void)
}
declare 388 {
    int Tcl_GetChannelNames(Tcl_Interp *interp)
}
declare 389 {
    int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern)
}
declare 390 {
    int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 391 {
    void Tcl_ConditionFinalize(Tcl_Condition *condPtr)
}
declare 392 {
    void Tcl_MutexFinalize(Tcl_Mutex *mutex)
}
declare 393 {
    int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc,
	    ClientData clientData, int stackSize, int flags)
}

# Introduced in 8.3.2
declare 394 {
    int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead)
}
declare 395 {
    int Tcl_WriteRaw(Tcl_Channel chan, const char *src, int srcLen)
}
declare 396 {
    Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan)
}
declare 397 {
    int Tcl_ChannelBuffered(Tcl_Channel chan)
}







|



|



|



|















|


|
|
>


|
|


|




|



|
|
















|


|


















|





|



|


|


|






|



|


















|










|




|


|







1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
declare 350 {
    int Tcl_UniCharIsUpper(int ch)
}
declare 351 {
    int Tcl_UniCharIsWordChar(int ch)
}
declare 352 {
    size_t Tcl_UniCharLen(const Tcl_UniChar *uniStr)
}
declare 353 {
    int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
	    size_t numChars)
}
declare 354 {
    char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr,
	    size_t uniLength, Tcl_DString *dsPtr)
}
declare 355 {
    Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src,
	    size_t length, Tcl_DString *dsPtr)
}
declare 356 {
    Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
	    int flags)
}
# Removed in 9.0:
#declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
#    Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
#	    int count)
#}
declare 358 {
    void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
declare 359 {
    void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script,
	    const char *command, size_t length)
}
declare 360 {
    int Tcl_ParseBraces(Tcl_Interp *interp, const char *start,
	    size_t numBytes, Tcl_Parse *parsePtr, int append,
	    const char **termPtr)
}
declare 361 {
    int Tcl_ParseCommand(Tcl_Interp *interp, const char *start,
	    size_t numBytes, int nested, Tcl_Parse *parsePtr)
}
declare 362 {
    int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, size_t numBytes,
	    Tcl_Parse *parsePtr)
}
declare 363 {
    int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start,
	    size_t numBytes, Tcl_Parse *parsePtr, int append,
	    const char **termPtr)
}
declare 364 {
    int Tcl_ParseVarName(Tcl_Interp *interp, const char *start,
	    size_t numBytes, Tcl_Parse *parsePtr, int append)
}
# These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir,
# Tcl_FSAccess and Tcl_FSStat
declare 365 {
    char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 366 {
   int Tcl_Chdir(const char *dirName)
}
declare 367 {
   int Tcl_Access(const char *path, int mode)
}
declare 368 {
    int Tcl_Stat(const char *path, struct stat *bufPtr)
}
declare 369 {
    int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n)
}
declare 370 {
    int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n)
}
declare 371 {
    int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase)
}
declare 372 {
    int Tcl_UniCharIsControl(int ch)
}
declare 373 {
    int Tcl_UniCharIsGraph(int ch)
}
declare 374 {
    int Tcl_UniCharIsPrint(int ch)
}
declare 375 {
    int Tcl_UniCharIsPunct(int ch)
}
declare 376 {
    int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp,
	    Tcl_Obj *textObj, size_t offset, size_t nmatches, int flags)
}
declare 377 {
    void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)
}
declare 378 {
    Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, size_t numChars)
}
declare 379 {
    void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
	    size_t numChars)
}
declare 380 {
    size_t Tcl_GetCharLength(Tcl_Obj *objPtr)
}
declare 381 {
    int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index)
}
# Removed in 9.0, replaced by macro.
#declare 382 {deprecated {No longer in use, changed to macro}} {
#    Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
#}
declare 383 {
    Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last)
}
declare 384 {
    void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
	    size_t length)
}
declare 385 {
    int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj,
	    Tcl_Obj *patternObj)
}
declare 386 {
    void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr)
}
declare 387 {
    Tcl_Mutex *Tcl_GetAllocMutex(void)
}
declare 388 {
    int Tcl_GetChannelNames(Tcl_Interp *interp)
}
declare 389 {
    int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern)
}
declare 390 {
    int Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 391 {
    void Tcl_ConditionFinalize(Tcl_Condition *condPtr)
}
declare 392 {
    void Tcl_MutexFinalize(Tcl_Mutex *mutex)
}
declare 393 {
    int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc,
	    void *clientData, size_t stackSize, int flags)
}

# Introduced in 8.3.2
declare 394 {
    size_t Tcl_ReadRaw(Tcl_Channel chan, char *dst, size_t bytesToRead)
}
declare 395 {
    size_t Tcl_WriteRaw(Tcl_Channel chan, const char *src, size_t srcLen)
}
declare 396 {
    Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan)
}
declare 397 {
    int Tcl_ChannelBuffered(Tcl_Channel chan)
}
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
    void Tcl_ClearChannelHandlers(Tcl_Channel channel)
}
declare 418 {
    int Tcl_IsChannelExisting(const char *channelName)
}
declare 419 {
    int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
	    unsigned long numChars)
}
declare 420 {
    int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
	    const Tcl_UniChar *uniPattern, int nocase)
}
# Removed in 9.0, as it is actually a macro:
#declare 421 {







|







1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
    void Tcl_ClearChannelHandlers(Tcl_Channel channel)
}
declare 418 {
    int Tcl_IsChannelExisting(const char *channelName)
}
declare 419 {
    int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
	    size_t numChars)
}
declare 420 {
    int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
	    const Tcl_UniChar *uniPattern, int nocase)
}
# Removed in 9.0, as it is actually a macro:
#declare 421 {
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
    void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
	    const Tcl_HashKeyType *typePtr)
}
declare 424 {
    void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
}
declare 425 {
    ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_CommandTraceProc *procPtr,
	    ClientData prevClientData)
}
declare 426 {
    int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags,
	    Tcl_CommandTraceProc *proc, ClientData clientData)
}
declare 427 {
    void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_CommandTraceProc *proc, ClientData clientData)
}
declare 428 {
    char *Tcl_AttemptAlloc(unsigned int size)
}
declare 429 {
    char *Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line)
}
declare 430 {
    char *Tcl_AttemptRealloc(char *ptr, unsigned int size)
}
declare 431 {
    char *Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
	    const char *file, int line)
}
declare 432 {
    int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length)
}

# TIP#10 (thread-aware channels) akupries
declare 433 {
    Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel)
}

# introduced in 8.4a3
declare 434 {
    Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}

# TIP#15 (math function introspection) dkf
# Removed in 9.0:
#declare 435 {deprecated {}} {
#    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
#	    int *numArgsPtr, Tcl_ValueType **argTypesPtr,
#	    Tcl_MathProc **procPtr, ClientData *clientDataPtr)
#}
# Removed in 9.0:
#declare 436 {deprecated {}} {
#    Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
#}
# TIP#36 (better access to 'subst') dkf
declare 437 {







|

|



|



|


|


|


|


|



|

















|







1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
    void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
	    const Tcl_HashKeyType *typePtr)
}
declare 424 {
    void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
}
declare 425 {
    void *Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_CommandTraceProc *procPtr,
	    void *prevClientData)
}
declare 426 {
    int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags,
	    Tcl_CommandTraceProc *proc, void *clientData)
}
declare 427 {
    void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_CommandTraceProc *proc, void *clientData)
}
declare 428 {
    void *Tcl_AttemptAlloc(size_t size)
}
declare 429 {
    void *Tcl_AttemptDbCkalloc(size_t size, const char *file, int line)
}
declare 430 {
    void *Tcl_AttemptRealloc(void *ptr, size_t size)
}
declare 431 {
    void *Tcl_AttemptDbCkrealloc(void *ptr, size_t size,
	    const char *file, int line)
}
declare 432 {
    int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, size_t length)
}

# TIP#10 (thread-aware channels) akupries
declare 433 {
    Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel)
}

# introduced in 8.4a3
declare 434 {
    Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}

# TIP#15 (math function introspection) dkf
# Removed in 9.0:
#declare 435 {deprecated {}} {
#    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
#	    int *numArgsPtr, Tcl_ValueType **argTypesPtr,
#	    Tcl_MathProc **procPtr, void **clientDataPtr)
#}
# Removed in 9.0:
#declare 436 {deprecated {}} {
#    Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
#}
# TIP#36 (better access to 'subst') dkf
declare 437 {
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
    Tcl_Obj *Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
declare 464 {
    Tcl_Obj *Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
	    Tcl_Obj *const objv[])
}
declare 465 {
    ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
	    const Tcl_Filesystem *fsPtr)
}
declare 466 {
    Tcl_Obj *Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
declare 467 {
    int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName)
}
declare 468 {
    Tcl_Obj *Tcl_FSNewNativePath(const Tcl_Filesystem *fromFilesystem,
	    ClientData clientData)
}
declare 469 {
    const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr)
}
declare 470 {
    Tcl_Obj *Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr)
}
declare 471 {
    Tcl_Obj *Tcl_FSPathSeparator(Tcl_Obj *pathPtr)
}
declare 472 {
    Tcl_Obj *Tcl_FSListVolumes(void)
}
declare 473 {
    int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr)
}
declare 474 {
    int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr)
}
declare 475 {
    ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr)
}
declare 476 {
    const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
	    Tcl_Obj *pathPtr)
}
declare 477 {
    const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)







|










|














|





|







1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
    Tcl_Obj *Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
declare 464 {
    Tcl_Obj *Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
	    Tcl_Obj *const objv[])
}
declare 465 {
    void *Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
	    const Tcl_Filesystem *fsPtr)
}
declare 466 {
    Tcl_Obj *Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
declare 467 {
    int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName)
}
declare 468 {
    Tcl_Obj *Tcl_FSNewNativePath(const Tcl_Filesystem *fromFilesystem,
	    void *clientData)
}
declare 469 {
    const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr)
}
declare 470 {
    Tcl_Obj *Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr)
}
declare 471 {
    Tcl_Obj *Tcl_FSPathSeparator(Tcl_Obj *pathPtr)
}
declare 472 {
    Tcl_Obj *Tcl_FSListVolumes(void)
}
declare 473 {
    int Tcl_FSRegister(void *clientData, const Tcl_Filesystem *fsPtr)
}
declare 474 {
    int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr)
}
declare 475 {
    void *Tcl_FSData(const Tcl_Filesystem *fsPtr)
}
declare 476 {
    const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
	    Tcl_Obj *pathPtr)
}
declare 477 {
    const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
declare 480 {
    void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr)
}

# TIP#56 (evaluate a parsed script) msofer
declare 481 {
    int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr,
	    int count)
}

# TIP#73 (access to current time) kbk
declare 482 {
    void Tcl_GetTime(Tcl_Time *timeBuf)
}

# TIP#32 (object-enabled traces) kbk
declare 483 {
    Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags,
	    Tcl_CmdObjTraceProc *objProc, ClientData clientData,
	    Tcl_CmdObjTraceDeleteProc *delProc)
}
declare 484 {
    int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr)
}
declare 485 {
    int Tcl_SetCommandInfoFromToken(Tcl_Command token,







|










|







1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
declare 480 {
    void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr)
}

# TIP#56 (evaluate a parsed script) msofer
declare 481 {
    int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr,
	    size_t count)
}

# TIP#73 (access to current time) kbk
declare 482 {
    void Tcl_GetTime(Tcl_Time *timeBuf)
}

# TIP#32 (object-enabled traces) kbk
declare 483 {
    Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags,
	    Tcl_CmdObjTraceProc *objProc, void *clientData,
	    Tcl_CmdObjTraceDeleteProc *delProc)
}
declare 484 {
    int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr)
}
declare 485 {
    int Tcl_SetCommandInfoFromToken(Tcl_Command token,
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
	    const Tcl_Config *configuration, const char *valEncoding)
}

# TIP #139 (partial exposure of namespace API - transferred from tclInt.decls)
# dkf, API by Brent Welch?
declare 506 {
    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
	    ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
declare 507 {
    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
}
declare 508 {
    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    Tcl_Obj *objPtr)







|







1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
	    const Tcl_Config *configuration, const char *valEncoding)
}

# TIP #139 (partial exposure of namespace API - transferred from tclInt.decls)
# dkf, API by Brent Welch?
declare 506 {
    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
	    void *clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
declare 507 {
    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
}
declare 508 {
    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    Tcl_Obj *objPtr)
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
declare 519 {
    Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
}

# TIP#143 (resource limits) dkf
declare 520 {
    void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
	    Tcl_LimitHandlerProc *handlerProc, ClientData clientData,
	    Tcl_LimitHandlerDeleteProc *deleteProc)
}
declare 521 {
    void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
	    Tcl_LimitHandlerProc *handlerProc, ClientData clientData)
}
declare 522 {
    int Tcl_LimitReady(Tcl_Interp *interp)
}
declare 523 {
    int Tcl_LimitCheck(Tcl_Interp *interp)
}







|




|







1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
declare 519 {
    Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
}

# TIP#143 (resource limits) dkf
declare 520 {
    void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
	    Tcl_LimitHandlerProc *handlerProc, void *clientData,
	    Tcl_LimitHandlerDeleteProc *deleteProc)
}
declare 521 {
    void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
	    Tcl_LimitHandlerProc *handlerProc, void *clientData)
}
declare 522 {
    int Tcl_LimitReady(Tcl_Interp *interp)
}
declare 523 {
    int Tcl_LimitCheck(Tcl_Interp *interp)
}
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
	    Tcl_Namespace **namespacePtrPtr)
}

# TIP#233 (virtualized time) akupries
declare 552 {
    void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
	    Tcl_ScaleTimeProc *scaleProc,
	    ClientData clientData)
}
declare 553 {
    void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
	    Tcl_ScaleTimeProc **scaleProc,
	    ClientData *clientData)
}

# TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4
declare 554 {
    Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(
	    const Tcl_ChannelType *chanTypePtr)
}







|




|







2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
	    Tcl_Namespace **namespacePtrPtr)
}

# TIP#233 (virtualized time) akupries
declare 552 {
    void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
	    Tcl_ScaleTimeProc *scaleProc,
	    void *clientData)
}
declare 553 {
    void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
	    Tcl_ScaleTimeProc **scaleProc,
	    void **clientData)
}

# TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4
declare 554 {
    Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(
	    const Tcl_ChannelType *chanTypePtr)
}
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
}

# TIP#270 (utility C routines for string formatting) dgp
declare 574 {
    void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 575 {
    void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, int length,
	    int limit, const char *ellipsis)
}
declare 576 {
    Tcl_Obj *Tcl_Format(Tcl_Interp *interp, const char *format, int objc,
	    Tcl_Obj *const objv[])
}
declare 577 {
    int Tcl_AppendFormatToObj(Tcl_Interp *interp, Tcl_Obj *objPtr,







|
|







2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
}

# TIP#270 (utility C routines for string formatting) dgp
declare 574 {
    void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 575 {
    void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes,
	    size_t length, size_t limit, const char *ellipsis)
}
declare 576 {
    Tcl_Obj *Tcl_Format(Tcl_Interp *interp, const char *format, int objc,
	    Tcl_Obj *const objv[])
}
declare 577 {
    int Tcl_AppendFormatToObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
}

# ----- BASELINE -- FOR -- 8.5.0 ----- #

# TIP #285 (script cancellation support) jmistachkin
declare 580 {
    int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr,
	    ClientData clientData, int flags)
}
declare 581 {
    int Tcl_Canceled(Tcl_Interp *interp, int flags)
}

# TIP#304 (chan pipe) aferrieux
declare 582 {
    int Tcl_CreatePipe(Tcl_Interp  *interp, Tcl_Channel *rchan,
	    Tcl_Channel *wchan, int flags)
}

# TIP #322 (NRE public interface) msofer
declare 583 {
    Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp,
	    const char *cmdName, Tcl_ObjCmdProc *proc,
	    Tcl_ObjCmdProc *nreProc, ClientData clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 584 {
    int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
declare 585 {
    int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
	    int flags)
}
declare 586 {
    int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc,
	    Tcl_Obj *const objv[], int flags)
}
declare 587 {
    void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr,
	    ClientData data0, ClientData data1, ClientData data2,
	    ClientData data3)
}
# For use by NR extenders, to have a simple way to also provide a (required!)
# classic objProc
declare 588 {
    int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc,
	    ClientData clientData, int objc, Tcl_Obj *const objv[])
}

# TIP#316 (Tcl_StatBuf reader functions) dkf
declare 589 {
    unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr)
}
declare 590 {







|















|






|
|







|
|





|







2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
}

# ----- BASELINE -- FOR -- 8.5.0 ----- #

# TIP #285 (script cancellation support) jmistachkin
declare 580 {
    int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr,
	    void *clientData, int flags)
}
declare 581 {
    int Tcl_Canceled(Tcl_Interp *interp, int flags)
}

# TIP#304 (chan pipe) aferrieux
declare 582 {
    int Tcl_CreatePipe(Tcl_Interp  *interp, Tcl_Channel *rchan,
	    Tcl_Channel *wchan, int flags)
}

# TIP #322 (NRE public interface) msofer
declare 583 {
    Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp,
	    const char *cmdName, Tcl_ObjCmdProc *proc,
	    Tcl_ObjCmdProc *nreProc, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 584 {
    int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
declare 585 {
    int Tcl_NREvalObjv(Tcl_Interp *interp, int objc,
	    Tcl_Obj *const objv[], int flags)
}
declare 586 {
    int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc,
	    Tcl_Obj *const objv[], int flags)
}
declare 587 {
    void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr,
	    void *data0, void *data1, void *data2,
	    void *data3)
}
# For use by NR extenders, to have a simple way to also provide a (required!)
# classic objProc
declare 588 {
    int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc,
	    void *clientData, int objc, Tcl_Obj *const objv[])
}

# TIP#316 (Tcl_StatBuf reader functions) dkf
declare 589 {
    unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr)
}
declare 590 {
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322

2323
2324
2325
2326
2327
2328
2329
# TIP#234 (zlib interface) dkf/Pascal Scheffers
declare 610 {
    int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
	    int level, Tcl_Obj *gzipHeaderDictObj)
}
declare 611 {
    int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
	    int buffersize, Tcl_Obj *gzipHeaderDictObj)
}
declare 612 {
    unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf,
	    int len)
}
declare 613 {
    unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf,
	    int len)
}
declare 614 {
    int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format,
	    int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle)
}
declare 615 {
    Tcl_Obj *Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle)
}
declare 616 {
    int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle)
}
declare 617 {
    int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle)
}
declare 618 {
    int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush)
}
declare 619 {
    int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count)

}
declare 620 {
    int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle)
}
declare 621 {
    int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle)
}







|



|



|


















|
>







2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
# TIP#234 (zlib interface) dkf/Pascal Scheffers
declare 610 {
    int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
	    int level, Tcl_Obj *gzipHeaderDictObj)
}
declare 611 {
    int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
	    size_t buffersize, Tcl_Obj *gzipHeaderDictObj)
}
declare 612 {
    unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf,
	    size_t len)
}
declare 613 {
    unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf,
	    size_t len)
}
declare 614 {
    int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format,
	    int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle)
}
declare 615 {
    Tcl_Obj *Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle)
}
declare 616 {
    int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle)
}
declare 617 {
    int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle)
}
declare 618 {
    int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush)
}
declare 619 {
    int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data,
	    size_t count)
}
declare 620 {
    int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle)
}
declare 621 {
    int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle)
}
2373
2374
2375
2376
2377
2378
2379
2380
















2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428

# ----- BASELINE -- FOR -- 8.6.0 ----- #

# TIP #456
declare 631 {
    Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service,
	    const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc,
	    ClientData callbackData)
















}

# ----- BASELINE -- FOR -- 8.7.0 ----- #



##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

interface tclPlat

################################
# Unix specific functions
#   (none)

################################
# Windows specific functions

# Added in Tcl 8.1

declare 0 win {
    TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr)
}
declare 1 win {
    char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
}

################################
# Mac OS X specific functions

declare 0 macosx {
    int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
	    const char *bundleName, int hasResourceFile,
	    int maxPathLen, char *libraryPath)
}
declare 1 macosx {
    int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
	    const char *bundleName, const char *bundleVersion,
	    int hasResourceFile, int maxPathLen, char *libraryPath)
}

##############################################################################

# Public functions that are not accessible via the stubs table.

export {







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



<
<


















|


|








|




|







2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401


2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444

# ----- BASELINE -- FOR -- 8.6.0 ----- #

# TIP #456
declare 631 {
    Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service,
	    const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc,
	    void *callbackData)
}

# TIP #430
declare 632 {
    int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint,
	    const char *zipname, const char *passwd)
}
declare 633 {
    int TclZipfs_Unmount(Tcl_Interp *interp, const char *mountPoint)
}
declare 634 {
    Tcl_Obj *TclZipfs_TclLibrary(void)
}
declare 635 {
    int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint,
	    unsigned char *data, size_t datalen, int copy)
}

# ----- BASELINE -- FOR -- 8.7.0 ----- #



##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

interface tclPlat

################################
# Unix specific functions
#   (none)

################################
# Windows specific functions

# Added in Tcl 8.1

declare 0 win {
    TCHAR *Tcl_WinUtfToTChar(const char *str, size_t len, Tcl_DString *dsPtr)
}
declare 1 win {
    char *Tcl_WinTCharToUtf(const TCHAR *str, size_t len, Tcl_DString *dsPtr)
}

################################
# Mac OS X specific functions

declare 0 macosx {
    int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
	    const char *bundleName, int hasResourceFile,
	    size_t maxPathLen, char *libraryPath)
}
declare 1 macosx {
    int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
	    const char *bundleName, const char *bundleVersion,
	    int hasResourceFile, size_t maxPathLen, char *libraryPath)
}

##############################################################################

# Public functions that are not accessible via the stubs table.

export {
Changes to generic/tcl.h.
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
 *----------------------------------------------------------------------------
 * Definition of the interface to functions implementing threads. A function
 * following this definition is given to each call of 'Tcl_CreateThread' and
 * will be called as the main fuction of the new thread created by that call.
 */

#if defined _WIN32
typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData);
#else
typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
#endif

/*
 * Threading function return types used for abstracting away platform
 * differences when writing a Tcl_ThreadCreateProc. See the NewThread function
 * in generic/tclThreadTest.c for it's usage.
 */







|

|







356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
 *----------------------------------------------------------------------------
 * Definition of the interface to functions implementing threads. A function
 * following this definition is given to each call of 'Tcl_CreateThread' and
 * will be called as the main fuction of the new thread created by that call.
 */

#if defined _WIN32
typedef unsigned (__stdcall Tcl_ThreadCreateProc) (void *clientData);
#else
typedef void (Tcl_ThreadCreateProc) (void *clientData);
#endif

/*
 * Threading function return types used for abstracting away platform
 * differences when writing a Tcl_ThreadCreateProc. See the NewThread function
 * in generic/tclThreadTest.c for it's usage.
 */
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564

/*
 *----------------------------------------------------------------------------
 * Function types defined by Tcl:
 */

typedef int (Tcl_AppInitProc) (Tcl_Interp *interp);
typedef int (Tcl_AsyncProc) (ClientData clientData, Tcl_Interp *interp,
	int code);
typedef void (Tcl_ChannelProc) (ClientData clientData, int mask);
typedef void (Tcl_CloseProc) (ClientData data);
typedef void (Tcl_CmdDeleteProc) (ClientData clientData);
typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp,
	int argc, const char *argv[]);
typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp,
	int level, char *command, Tcl_CmdProc *proc,
	ClientData cmdClientData, int argc, const char *argv[]);
typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp,
	int level, const char *command, Tcl_Command commandInfo, int objc,
	struct Tcl_Obj *const *objv);
typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData);
typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
	struct Tcl_Obj *dupPtr);
typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src,
	int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst,
	int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
typedef void (Tcl_EncodingFreeProc) (ClientData clientData);
typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags);
typedef void (Tcl_EventCheckProc) (ClientData clientData, int flags);
typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, ClientData clientData);
typedef void (Tcl_EventSetupProc) (ClientData clientData, int flags);
typedef void (Tcl_ExitProc) (ClientData clientData);
typedef void (Tcl_FileProc) (ClientData clientData, int mask);
typedef void (Tcl_FileFreeProc) (ClientData clientData);
typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr);
typedef void (Tcl_FreeProc) (char *blockPtr);
typedef void (Tcl_IdleProc) (ClientData clientData);
typedef void (Tcl_InterpDeleteProc) (ClientData clientData,
	Tcl_Interp *interp);
typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp,
	int objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp);
typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags);
typedef void (Tcl_PanicProc) (const char *format, ...);
typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan,
	char *address, int port);
typedef void (Tcl_TimerProc) (ClientData clientData);
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr);
typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp,
	const char *part1, const char *part2, int flags);
typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp,
	const char *oldName, const char *newName, int flags);
typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc,
	ClientData clientData);
typedef void (Tcl_DeleteFileHandlerProc) (int fd);
typedef void (Tcl_AlertNotifierProc) (ClientData clientData);
typedef void (Tcl_ServiceModeHookProc) (int mode);
typedef ClientData (Tcl_InitNotifierProc) (void);
typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData);
typedef void (Tcl_MainLoopProc) (void);

/*
 *----------------------------------------------------------------------------
 * The following structure represents a type of object, which is a particular
 * internal representation for an object plus a set of functions that provide
 * standard operations on objects of that type.







|

|
|
|
|

|

|
|


|


|


|

|
|
|
|
|
|

|
|
|

|
|




|

|


|

|


|

|

|
|







497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564

/*
 *----------------------------------------------------------------------------
 * Function types defined by Tcl:
 */

typedef int (Tcl_AppInitProc) (Tcl_Interp *interp);
typedef int (Tcl_AsyncProc) (void *clientData, Tcl_Interp *interp,
	int code);
typedef void (Tcl_ChannelProc) (void *clientData, int mask);
typedef void (Tcl_CloseProc) (void *data);
typedef void (Tcl_CmdDeleteProc) (void *clientData);
typedef int (Tcl_CmdProc) (void *clientData, Tcl_Interp *interp,
	int argc, const char *argv[]);
typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, char *command, Tcl_CmdProc *proc,
	void *cmdClientData, int argc, const char *argv[]);
typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, const char *command, Tcl_Command commandInfo, int objc,
	struct Tcl_Obj *const *objv);
typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData);
typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
	struct Tcl_Obj *dupPtr);
typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src,
	int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst,
	int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
#define Tcl_EncodingFreeProc Tcl_FreeProc
typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags);
typedef void (Tcl_EventCheckProc) (void *clientData, int flags);
typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, void *clientData);
typedef void (Tcl_EventSetupProc) (void *clientData, int flags);
#define Tcl_ExitProc Tcl_FreeProc
typedef void (Tcl_FileProc) (void *clientData, int mask);
#define Tcl_FileFreeProc Tcl_FreeProc
typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr);
typedef void (Tcl_FreeProc) (void *blockPtr);
typedef void (Tcl_IdleProc) (void *clientData);
typedef void (Tcl_InterpDeleteProc) (void *clientData,
	Tcl_Interp *interp);
typedef void (Tcl_NamespaceDeleteProc) (void *clientData);
typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp,
	int objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp);
typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags);
typedef void (Tcl_PanicProc) (const char *format, ...);
typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan,
	char *address, int port);
typedef void (Tcl_TimerProc) (void *clientData);
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr);
typedef char * (Tcl_VarTraceProc) (void *clientData, Tcl_Interp *interp,
	const char *part1, const char *part2, int flags);
typedef void (Tcl_CommandTraceProc) (void *clientData, Tcl_Interp *interp,
	const char *oldName, const char *newName, int flags);
typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc,
	void *clientData);
typedef void (Tcl_DeleteFileHandlerProc) (int fd);
typedef void (Tcl_AlertNotifierProc) (void *clientData);
typedef void (Tcl_ServiceModeHookProc) (int mode);
typedef void *(Tcl_InitNotifierProc) (void);
typedef void (Tcl_FinalizeNotifierProc) (void *clientData);
typedef void (Tcl_MainLoopProc) (void);

/*
 *----------------------------------------------------------------------------
 * The following structure represents a type of object, which is a particular
 * internal representation for an object plus a set of functions that provide
 * standard operations on objects of that type.
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
/*
 * One of the following structures exists for each object in the Tcl system.
 * An object stores a value as either a string, some internal representation,
 * or both.
 */

typedef struct Tcl_Obj {
    int refCount;		/* When 0 the object will be freed. */
    char *bytes;		/* This points to the first byte of the
				 * object's string representation. The array
				 * must be followed by a null byte (i.e., at
				 * offset length) but may also contain
				 * embedded null characters. The array's
				 * storage is allocated by ckalloc. NULL means
				 * the string rep is invalid and must be
				 * regenerated from the internal rep.  Clients
				 * should use Tcl_GetStringFromObj or
				 * Tcl_GetString to get a pointer to the byte
				 * array as a readonly value. */
    int length;			/* The number of bytes at *bytes, not
				 * including the terminating null. */
    const Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
				 * corresponds to the type of the object's
				 * internal rep. NULL indicates the object has
				 * no internal rep (has no type). */
    union {			/* The internal representation: */
	long longValue;		/*   - an long integer value. */







|





|





|







585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
/*
 * One of the following structures exists for each object in the Tcl system.
 * An object stores a value as either a string, some internal representation,
 * or both.
 */

typedef struct Tcl_Obj {
    size_t refCount;		/* When 0 the object will be freed. */
    char *bytes;		/* This points to the first byte of the
				 * object's string representation. The array
				 * must be followed by a null byte (i.e., at
				 * offset length) but may also contain
				 * embedded null characters. The array's
				 * storage is allocated by Tcl_Alloc. NULL means
				 * the string rep is invalid and must be
				 * regenerated from the internal rep.  Clients
				 * should use Tcl_GetStringFromObj or
				 * Tcl_GetString to get a pointer to the byte
				 * array as a readonly value. */
    size_t length;		/* The number of bytes at *bytes, not
				 * including the terminating null. */
    const Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
				 * corresponds to the type of the object's
				 * internal rep. NULL indicates the object has
				 * no internal rep (has no type). */
    union {			/* The internal representation: */
	long longValue;		/*   - an long integer value. */
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
typedef struct Tcl_Namespace {
    char *name;			/* The namespace's name within its parent
				 * namespace. This contains no ::'s. The name
				 * of the global namespace is "" although "::"
				 * is an synonym. */
    char *fullName;		/* The namespace's fully qualified name. This
				 * starts with ::. */
    ClientData clientData;	/* Arbitrary value associated with this
				 * namespace. */
    Tcl_NamespaceDeleteProc *deleteProc;
				/* Function invoked when deleting the
				 * namespace to, e.g., free clientData. */
    struct Tcl_Namespace *parentPtr;
				/* Points to the namespace that contains this
				 * one. NULL if this is the global







|







660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
typedef struct Tcl_Namespace {
    char *name;			/* The namespace's name within its parent
				 * namespace. This contains no ::'s. The name
				 * of the global namespace is "" although "::"
				 * is an synonym. */
    char *fullName;		/* The namespace's fully qualified name. This
				 * starts with ::. */
    void *clientData;	/* Arbitrary value associated with this
				 * namespace. */
    Tcl_NamespaceDeleteProc *deleteProc;
				/* Function invoked when deleting the
				 * namespace to, e.g., free clientData. */
    struct Tcl_Namespace *parentPtr;
				/* Points to the namespace that contains this
				 * one. NULL if this is the global
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774

typedef struct Tcl_CmdInfo {
    int isNativeObjectProc;	/* 1 if objProc was registered by a call to
				 * Tcl_CreateObjCommand; 0 otherwise.
				 * Tcl_SetCmdInfo does not modify this
				 * field. */
    Tcl_ObjCmdProc *objProc;	/* Command's object-based function. */
    ClientData objClientData;	/* ClientData for object proc. */
    Tcl_CmdProc *proc;		/* Command's string-based function. */
    ClientData clientData;	/* ClientData for string proc. */
    Tcl_CmdDeleteProc *deleteProc;
				/* Function to call when command is
				 * deleted. */
    ClientData deleteData;	/* Value to pass to deleteProc (usually the
				 * same as clientData). */
    Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this
				 * command. Note that Tcl_SetCmdInfo will not
				 * change a command's namespace; use
				 * TclRenameCommand or Tcl_Eval (of 'rename')
				 * to do that. */
} Tcl_CmdInfo;

/*
 *----------------------------------------------------------------------------
 * The structure defined below is used to hold dynamic strings. The only
 * fields that clients should use are string and length, accessible via the
 * macros Tcl_DStringValue and Tcl_DStringLength.
 */

#define TCL_DSTRING_STATIC_SIZE 200
typedef struct Tcl_DString {
    char *string;		/* Points to beginning of string: either
				 * staticSpace below or a malloced array. */
    int length;			/* Number of non-NULL characters in the
				 * string. */
    int spaceAvl;		/* Total number of bytes available for the
				 * string and its terminating NULL char. */
    char staticSpace[TCL_DSTRING_STATIC_SIZE];
				/* Space to use in common case where string is
				 * small. */
} Tcl_DString;

#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)







|

|



|



















|

|







732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774

typedef struct Tcl_CmdInfo {
    int isNativeObjectProc;	/* 1 if objProc was registered by a call to
				 * Tcl_CreateObjCommand; 0 otherwise.
				 * Tcl_SetCmdInfo does not modify this
				 * field. */
    Tcl_ObjCmdProc *objProc;	/* Command's object-based function. */
    void *objClientData;	/* ClientData for object proc. */
    Tcl_CmdProc *proc;		/* Command's string-based function. */
    void *clientData;	/* ClientData for string proc. */
    Tcl_CmdDeleteProc *deleteProc;
				/* Function to call when command is
				 * deleted. */
    void *deleteData;	/* Value to pass to deleteProc (usually the
				 * same as clientData). */
    Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this
				 * command. Note that Tcl_SetCmdInfo will not
				 * change a command's namespace; use
				 * TclRenameCommand or Tcl_Eval (of 'rename')
				 * to do that. */
} Tcl_CmdInfo;

/*
 *----------------------------------------------------------------------------
 * The structure defined below is used to hold dynamic strings. The only
 * fields that clients should use are string and length, accessible via the
 * macros Tcl_DStringValue and Tcl_DStringLength.
 */

#define TCL_DSTRING_STATIC_SIZE 200
typedef struct Tcl_DString {
    char *string;		/* Points to beginning of string: either
				 * staticSpace below or a malloced array. */
    size_t length;		/* Number of non-NULL characters in the
				 * string. */
    size_t spaceAvl;		/* Total number of bytes available for the
				 * string and its terminating NULL char. */
    char staticSpace[TCL_DSTRING_STATIC_SIZE];
				/* Space to use in common case where string is
				 * small. */
} Tcl_DString;

#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932

/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */

#ifndef TCL_HASH_TYPE
#  define TCL_HASH_TYPE unsigned
#endif

typedef struct Tcl_HashKeyType Tcl_HashKeyType;
typedef struct Tcl_HashTable Tcl_HashTable;
typedef struct Tcl_HashEntry Tcl_HashEntry;

typedef TCL_HASH_TYPE (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);







|







918
919
920
921
922
923
924
925
926
927
928
929
930
931
932

/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */

#ifndef TCL_HASH_TYPE
#  define TCL_HASH_TYPE size_t
#endif

typedef struct Tcl_HashKeyType Tcl_HashKeyType;
typedef struct Tcl_HashTable Tcl_HashTable;
typedef struct Tcl_HashEntry Tcl_HashEntry;

typedef TCL_HASH_TYPE (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
 * should access any of these fields directly; use the macros defined below.
 */

struct Tcl_HashEntry {
    Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this hash bucket,
				 * or NULL for end of chain. */
    Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
    unsigned int hash;		/* Hash value. */
    ClientData clientData;	/* Application stores something here with
				 * Tcl_SetHashValue. */
    union {			/* Key has one of these forms: */
	char *oneWordValue;	/* One-word value for key. */
	Tcl_Obj *objPtr;	/* Tcl_Obj * key value. */
	int words[1];		/* Multiple integer words for key. The actual
				 * size will be as large as necessary for this
				 * table's keys. */







|
|







940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
 * should access any of these fields directly; use the macros defined below.
 */

struct Tcl_HashEntry {
    Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this hash bucket,
				 * or NULL for end of chain. */
    Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
    size_t hash;		/* Hash value. */
    void *clientData;		/* Application stores something here with
				 * Tcl_SetHashValue. */
    union {			/* Key has one of these forms: */
	char *oneWordValue;	/* One-word value for key. */
	Tcl_Obj *objPtr;	/* Tcl_Obj * key value. */
	int words[1];		/* Multiple integer words for key. The actual
				 * size will be as large as necessary for this
				 * table's keys. */
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
struct Tcl_HashTable {
    Tcl_HashEntry **buckets;	/* Pointer to bucket array. Each element
				 * points to first entry in bucket's hash
				 * chain, or NULL. */
    Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
				/* Bucket array used for small tables (to
				 * avoid mallocs and frees). */
    int numBuckets;		/* Total number of buckets allocated at
				 * **bucketPtr. */
    int numEntries;		/* Total number of entries present in
				 * table. */
    int rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    unsigned int mask;		/* Mask value used in hashing function. */
    int downShift;		/* Shift count used in hashing function.
				 * Designed to use high-order bits of
				 * randomized keys. */
    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
				 * number of ints that is the size of the







|

|

|

|







1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
struct Tcl_HashTable {
    Tcl_HashEntry **buckets;	/* Pointer to bucket array. Each element
				 * points to first entry in bucket's hash
				 * chain, or NULL. */
    Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
				/* Bucket array used for small tables (to
				 * avoid mallocs and frees). */
    size_t numBuckets;		/* Total number of buckets allocated at
				 * **bucketPtr. */
    size_t numEntries;		/* Total number of entries present in
				 * table. */
    size_t rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    size_t mask;		/* Mask value used in hashing function. */
    int downShift;		/* Shift count used in hashing function.
				 * Designed to use high-order bits of
				 * randomized keys. */
    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
				 * number of ints that is the size of the
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
/*
 * Structure definition for information used to keep track of searches through
 * hash tables:
 */

typedef struct Tcl_HashSearch {
    Tcl_HashTable *tablePtr;	/* Table being searched. */
    int nextIndex;		/* Index of next bucket to be enumerated after
				 * present one. */
    Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current
				 * bucket. */
} Tcl_HashSearch;

/*
 * Acceptable key types for hash tables:







|







1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
/*
 * Structure definition for information used to keep track of searches through
 * hash tables:
 */

typedef struct Tcl_HashSearch {
    Tcl_HashTable *tablePtr;	/* Table being searched. */
    size_t nextIndex;		/* Index of next bucket to be enumerated after
				 * present one. */
    Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current
				 * bucket. */
} Tcl_HashSearch;

/*
 * Acceptable key types for hash tables:
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
 * dictionaries. These fields should not be accessed by code outside
 * tclDictObj.c
 */

typedef struct {
    void *next;			/* Search position for underlying hash
				 * table. */
    unsigned int epoch; 	/* Epoch marker for dictionary being searched,
				 * or 0 if search has terminated. */
    Tcl_Dict dictionaryPtr;	/* Reference to dictionary being searched. */
} Tcl_DictSearch;

/*
 *----------------------------------------------------------------------------
 * Flag values to pass to Tcl_DoOneEvent to disable searches for some kinds of







|







1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
 * dictionaries. These fields should not be accessed by code outside
 * tclDictObj.c
 */

typedef struct {
    void *next;			/* Search position for underlying hash
				 * table. */
    size_t epoch;		/* Epoch marker for dictionary being searched,
				 * or 0 if search has terminated. */
    Tcl_Dict dictionaryPtr;	/* Reference to dictionary being searched. */
} Tcl_DictSearch;

/*
 *----------------------------------------------------------------------------
 * Flag values to pass to Tcl_DoOneEvent to disable searches for some kinds of
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr);
typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr);

/*
 * TIP #233 (Virtualized Time)
 */

typedef void (Tcl_GetTimeProc)   (Tcl_Time *timebuf, ClientData clientData);
typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);

/*
 *----------------------------------------------------------------------------
 * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler to
 * indicate what sorts of events are of interest:
 */








|
|







1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr);
typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr);

/*
 * TIP #233 (Virtualized Time)
 */

typedef void (Tcl_GetTimeProc)   (Tcl_Time *timebuf, void *clientData);
typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData);

/*
 *----------------------------------------------------------------------------
 * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler to
 * indicate what sorts of events are of interest:
 */

1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
#define TCL_CHANNEL_THREAD_INSERT (0)
#define TCL_CHANNEL_THREAD_REMOVE (1)

/*
 * Typedefs for the various operations in a channel type:
 */

typedef int	(Tcl_DriverBlockModeProc) (ClientData instanceData, int mode);
typedef int	(Tcl_DriverCloseProc) (ClientData instanceData,
			Tcl_Interp *interp);
typedef int	(Tcl_DriverClose2Proc) (ClientData instanceData,
			Tcl_Interp *interp, int flags);
typedef int	(Tcl_DriverInputProc) (ClientData instanceData, char *buf,
			int toRead, int *errorCodePtr);
typedef int	(Tcl_DriverOutputProc) (ClientData instanceData,
			const char *buf, int toWrite, int *errorCodePtr);
typedef int	(Tcl_DriverSeekProc) (ClientData instanceData, long offset,
			int mode, int *errorCodePtr);
typedef int	(Tcl_DriverSetOptionProc) (ClientData instanceData,
			Tcl_Interp *interp, const char *optionName,
			const char *value);
typedef int	(Tcl_DriverGetOptionProc) (ClientData instanceData,
			Tcl_Interp *interp, const char *optionName,
			Tcl_DString *dsPtr);
typedef void	(Tcl_DriverWatchProc) (ClientData instanceData, int mask);
typedef int	(Tcl_DriverGetHandleProc) (ClientData instanceData,
			int direction, ClientData *handlePtr);
typedef int	(Tcl_DriverFlushProc) (ClientData instanceData);
typedef int	(Tcl_DriverHandlerProc) (ClientData instanceData,
			int interestMask);
typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (ClientData instanceData,
			Tcl_WideInt offset, int mode, int *errorCodePtr);
/*
 * TIP #218, Channel Thread Actions
 */
typedef void	(Tcl_DriverThreadActionProc) (ClientData instanceData,
			int action);
/*
 * TIP #208, File Truncation (etc.)
 */
typedef int	(Tcl_DriverTruncateProc) (ClientData instanceData,
			Tcl_WideInt length);

/*
 * struct Tcl_ChannelType:
 *
 * One such structure exists for each type (kind) of channel. It collects
 * together in one place all the functions that are part of the specific







|
|

|

|

|

|

|


|


|
|
|
|
|

|




|




|







1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
#define TCL_CHANNEL_THREAD_INSERT (0)
#define TCL_CHANNEL_THREAD_REMOVE (1)

/*
 * Typedefs for the various operations in a channel type:
 */

typedef int	(Tcl_DriverBlockModeProc) (void *instanceData, int mode);
typedef int	(Tcl_DriverCloseProc) (void *instanceData,
			Tcl_Interp *interp);
typedef int	(Tcl_DriverClose2Proc) (void *instanceData,
			Tcl_Interp *interp, int flags);
typedef int	(Tcl_DriverInputProc) (void *instanceData, char *buf,
			int toRead, int *errorCodePtr);
typedef int	(Tcl_DriverOutputProc) (void *instanceData,
			const char *buf, int toWrite, int *errorCodePtr);
typedef int	(Tcl_DriverSeekProc) (void *instanceData, long offset,
			int mode, int *errorCodePtr);
typedef int	(Tcl_DriverSetOptionProc) (void *instanceData,
			Tcl_Interp *interp, const char *optionName,
			const char *value);
typedef int	(Tcl_DriverGetOptionProc) (void *instanceData,
			Tcl_Interp *interp, const char *optionName,
			Tcl_DString *dsPtr);
typedef void	(Tcl_DriverWatchProc) (void *instanceData, int mask);
typedef int	(Tcl_DriverGetHandleProc) (void *instanceData,
			int direction, void **handlePtr);
typedef int	(Tcl_DriverFlushProc) (void *instanceData);
typedef int	(Tcl_DriverHandlerProc) (void *instanceData,
			int interestMask);
typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (void *instanceData,
			Tcl_WideInt offset, int mode, int *errorCodePtr);
/*
 * TIP #218, Channel Thread Actions
 */
typedef void	(Tcl_DriverThreadActionProc) (void *instanceData,
			int action);
/*
 * TIP #208, File Truncation (etc.)
 */
typedef int	(Tcl_DriverTruncateProc) (void *instanceData,
			Tcl_WideInt length);

/*
 * struct Tcl_ChannelType:
 *
 * One such structure exists for each type (kind) of channel. It collects
 * together in one place all the functions that are part of the specific
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index,
	Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
typedef Tcl_Obj * (Tcl_FSLinkProc) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
	int linkType);
typedef int (Tcl_FSLoadFileProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr);
typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr,
	ClientData *clientDataPtr);
typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr);
typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr);
typedef void (Tcl_FSFreeInternalRepProc) (ClientData clientData);
typedef ClientData (Tcl_FSDupInternalRepProc) (ClientData clientData);
typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (ClientData clientData);
typedef ClientData (Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr);

typedef struct Tcl_FSVersion_ *Tcl_FSVersion;

/*
 *----------------------------------------------------------------------------
 * Data structures related to hooking into the filesystem
 */







|


|
|
|
|







1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index,
	Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
typedef Tcl_Obj * (Tcl_FSLinkProc) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
	int linkType);
typedef int (Tcl_FSLoadFileProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr);
typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr,
	void **clientDataPtr);
typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr);
typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr);
#define Tcl_FSFreeInternalRepProc Tcl_FreeProc
typedef void *(Tcl_FSDupInternalRepProc) (void *clientData);
typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (void *clientData);
typedef void *(Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr);

typedef struct Tcl_FSVersion_ *Tcl_FSVersion;

/*
 *----------------------------------------------------------------------------
 * Data structures related to hooking into the filesystem
 */
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
 * Not all entries need be non-NULL; any which are NULL are simply ignored.
 * However, a complete filesystem should provide all of these functions. The
 * explanations in the structure show the importance of each function.
 */

typedef struct Tcl_Filesystem {
    const char *typeName;	/* The name of the filesystem. */
    int structureLength;	/* Length of this structure, so future binary
				 * compatibility can be assured. */
    Tcl_FSVersion version;	/* Version of the filesystem type. */
    Tcl_FSPathInFilesystemProc *pathInFilesystemProc;
				/* Function to check whether a path is in this
				 * filesystem. This is the most important
				 * filesystem function. */
    Tcl_FSDupInternalRepProc *dupInternalRepProc;







|







1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
 * Not all entries need be non-NULL; any which are NULL are simply ignored.
 * However, a complete filesystem should provide all of these functions. The
 * explanations in the structure show the importance of each function.
 */

typedef struct Tcl_Filesystem {
    const char *typeName;	/* The name of the filesystem. */
    size_t structureLength;	/* Length of this structure, so future binary
				 * compatibility can be assured. */
    Tcl_FSVersion version;	/* Version of the filesystem type. */
    Tcl_FSPathInFilesystemProc *pathInFilesystemProc;
				/* Function to check whether a path is in this
				 * filesystem. This is the most important
				 * filesystem function. */
    Tcl_FSDupInternalRepProc *dupInternalRepProc;
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
 * token.
 */

typedef struct Tcl_Token {
    int type;			/* Type of token, such as TCL_TOKEN_WORD; see
				 * below for valid types. */
    const char *start;		/* First character in token. */
    int size;			/* Number of bytes in token. */
    int numComponents;		/* If this token is composed of other tokens,
				 * this field tells how many of them there are
				 * (including components of components, etc.).
				 * The component tokens immediately follow
				 * this one. */
} Tcl_Token;

/*







|
|







1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
 * token.
 */

typedef struct Tcl_Token {
    int type;			/* Type of token, such as TCL_TOKEN_WORD; see
				 * below for valid types. */
    const char *start;		/* First character in token. */
    size_t size;			/* Number of bytes in token. */
    size_t numComponents;		/* If this token is composed of other tokens,
				 * this field tells how many of them there are
				 * (including components of components, etc.).
				 * The component tokens immediately follow
				 * this one. */
} Tcl_Token;

/*
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
 */

#define NUM_STATIC_TOKENS 20

typedef struct Tcl_Parse {
    const char *commentStart;	/* Pointer to # that begins the first of one
				 * or more comments preceding the command. */
    int commentSize;		/* Number of bytes in comments (up through
				 * newline character that terminates the last
				 * comment). If there were no comments, this
				 * field is 0. */
    const char *commandStart;	/* First character in first word of
				 * command. */
    int commandSize;		/* Number of bytes in command, including first
				 * character of first word, up through the







|







1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
 */

#define NUM_STATIC_TOKENS 20

typedef struct Tcl_Parse {
    const char *commentStart;	/* Pointer to # that begins the first of one
				 * or more comments preceding the command. */
    size_t commentSize;		/* Number of bytes in comments (up through
				 * newline character that terminates the last
				 * comment). If there were no comments, this
				 * field is 0. */
    const char *commandStart;	/* First character in first word of
				 * command. */
    int commandSize;		/* Number of bytes in command, including first
				 * character of first word, up through the
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
				 * encoding type. */
    Tcl_EncodingConvertProc *toUtfProc;
				/* Function to convert from external encoding
				 * into UTF-8. */
    Tcl_EncodingConvertProc *fromUtfProc;
				/* Function to convert from UTF-8 into
				 * external encoding. */
    Tcl_EncodingFreeProc *freeProc;
				/* If non-NULL, function to call when this
				 * encoding is deleted. */
    ClientData clientData;	/* Arbitrary value associated with encoding
				 * type. Passed to conversion functions. */
    int nullSize;		/* Number of zero bytes that signify
				 * end-of-string in this encoding. This number
				 * is used to determine the source string
				 * length when the srcLen argument is
				 * negative. Must be 1 or 2. */
} Tcl_EncodingType;







|


|







1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
				 * encoding type. */
    Tcl_EncodingConvertProc *toUtfProc;
				/* Function to convert from external encoding
				 * into UTF-8. */
    Tcl_EncodingConvertProc *fromUtfProc;
				/* Function to convert from UTF-8 into
				 * external encoding. */
    Tcl_FreeProc *freeProc;
				/* If non-NULL, function to call when this
				 * encoding is deleted. */
    void *clientData;	/* Arbitrary value associated with encoding
				 * type. Passed to conversion functions. */
    int nullSize;		/* Number of zero bytes that signify
				 * end-of-string in this encoding. This number
				 * is used to determine the source string
				 * length when the srcLen argument is
				 * negative. Must be 1 or 2. */
} Tcl_EncodingType;
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
#define TCL_LIMIT_TIME		0x02

/*
 * Structure containing information about a limit handler to be called when a
 * command- or time-limit is exceeded by an interpreter.
 */

typedef void (Tcl_LimitHandlerProc) (ClientData clientData, Tcl_Interp *interp);
typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData);

/*
 *----------------------------------------------------------------------------
 * Override definitions for libtommath.
 */

typedef struct mp_int mp_int;







|
|







2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
#define TCL_LIMIT_TIME		0x02

/*
 * Structure containing information about a limit handler to be called when a
 * command- or time-limit is exceeded by an interpreter.
 */

typedef void (Tcl_LimitHandlerProc) (void *clientData, Tcl_Interp *interp);
typedef void (Tcl_LimitHandlerDeleteProc) (void *clientData);

/*
 *----------------------------------------------------------------------------
 * Override definitions for libtommath.
 */

typedef struct mp_int mp_int;
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
				 * argv array. */
    void *srcPtr;		/* Value to be used in setting dst; usage
				 * depends on type.*/
    void *dstPtr;		/* Address of value to be modified; usage
				 * depends on type.*/
    const char *helpStr;	/* Documentation message describing this
				 * option. */
    ClientData clientData;	/* Word to pass to function callbacks. */
} Tcl_ArgvInfo;

/*
 * Legal values for the type field of a Tcl_ArgInfo: see the user
 * documentation for details.
 */








|







2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
				 * argv array. */
    void *srcPtr;		/* Value to be used in setting dst; usage
				 * depends on type.*/
    void *dstPtr;		/* Address of value to be modified; usage
				 * depends on type.*/
    const char *helpStr;	/* Documentation message describing this
				 * option. */
    void *clientData;	/* Word to pass to function callbacks. */
} Tcl_ArgvInfo;

/*
 * Legal values for the type field of a Tcl_ArgInfo: see the user
 * documentation for details.
 */

2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
#define TCL_ARGV_END		23

/*
 * Types of callback functions for the TCL_ARGV_FUNC and TCL_ARGV_GENFUNC
 * argument types:
 */

typedef int (Tcl_ArgvFuncProc)(ClientData clientData, Tcl_Obj *objPtr,
	void *dstPtr);
typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *const *objv, void *dstPtr);

/*
 * Shorthand for commonly used argTable entries.
 */

#define TCL_ARGV_AUTO_HELP \







|

|







2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
#define TCL_ARGV_END		23

/*
 * Types of callback functions for the TCL_ARGV_FUNC and TCL_ARGV_GENFUNC
 * argument types:
 */

typedef int (Tcl_ArgvFuncProc)(void *clientData, Tcl_Obj *objPtr,
	void *dstPtr);
typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *const *objv, void *dstPtr);

/*
 * Shorthand for commonly used argTable entries.
 */

#define TCL_ARGV_AUTO_HELP \
2136
2137
2138
2139
2140
2141
2142







2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
/*
 *----------------------------------------------------------------------------
 * Definitions needed for the Tcl_OpenTcpServerEx function. [TIP #456]
 */
#define TCL_TCPSERVER_REUSEADDR (1<<0)
#define TCL_TCPSERVER_REUSEPORT (1<<1)








/*
 *----------------------------------------------------------------------------
 * Single public declaration for NRE.
 */

typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
				int result);

/*
 *----------------------------------------------------------------------------
 * The following constant is used to test for older versions of Tcl in the
 * stubs tables. If TCL_UTF_MAX>4 use a different value.
 */

#define TCL_STUB_MAGIC		((int) 0xFCA3BACF + (TCL_UTF_MAX>4))

/*
 * The following function is required to be defined in all stubs aware
 * extensions. The function is actually implemented in the stub library, not
 * the main Tcl library, although there is a trivial implementation in the
 * main library in case an extension is statically linked into an application.
 */







>
>
>
>
>
>
>





|








|







2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
/*
 *----------------------------------------------------------------------------
 * Definitions needed for the Tcl_OpenTcpServerEx function. [TIP #456]
 */
#define TCL_TCPSERVER_REUSEADDR (1<<0)
#define TCL_TCPSERVER_REUSEPORT (1<<1)

/*
 * Constants for special size_t-typed values, see TIP #494
 */

#define TCL_IO_FAILURE	((size_t)-1)
#define TCL_AUTO_LENGTH	((size_t)-1)

/*
 *----------------------------------------------------------------------------
 * Single public declaration for NRE.
 */

typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,
				int result);

/*
 *----------------------------------------------------------------------------
 * The following constant is used to test for older versions of Tcl in the
 * stubs tables. If TCL_UTF_MAX>4 use a different value.
 */

#define TCL_STUB_MAGIC		((int) 0xFCA3BACB + (int) sizeof(void *) + (TCL_UTF_MAX>4))

/*
 * The following function is required to be defined in all stubs aware
 * extensions. The function is actually implemented in the stub library, not
 * the main Tcl library, although there is a trivial implementation in the
 * main library in case an extension is statically linked into an application.
 */
2211
2212
2213
2214
2215
2216
2217



2218
2219
2220
2221
2222
2223
2224
#if defined(_WIN32) && defined(UNICODE)
TCLAPI void Tcl_MainExW(int argc, wchar_t **argv,
	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
TCLAPI const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
			    const char *version, int exact);
TCLAPI void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);




/*
 *----------------------------------------------------------------------------
 * Include the public function declarations that are accessible via the stubs
 * table.
 */








>
>
>







2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
#if defined(_WIN32) && defined(UNICODE)
TCLAPI void Tcl_MainExW(int argc, wchar_t **argv,
	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
TCLAPI const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
			    const char *version, int exact);
TCLAPI void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
#ifndef _WIN32
TCLAPI int		TclZipfs_AppHook(int *argc, char ***argv);
#endif

/*
 *----------------------------------------------------------------------------
 * Include the public function declarations that are accessible via the stubs
 * table.
 */

2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
#   define TCLAPI MODULE_SCOPE
#endif

#include "tclPlatDecls.h"

/*
 *----------------------------------------------------------------------------
 * The following declarations either map ckalloc and ckfree to malloc and
 * free, or they map them to functions with all sorts of debugging hooks
 * defined in tclCkalloc.c.
 */

#ifdef TCL_MEM_DEBUG

#   define ckalloc(x) \
    ((void *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__))
#   define ckfree(x) \
    Tcl_DbCkfree((char *)(x), __FILE__, __LINE__)
#   define ckrealloc(x,y) \
    ((void *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__))
#   define attemptckalloc(x) \
    ((void *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__))
#   define attemptckrealloc(x,y) \
    ((void *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__))

#else /* !TCL_MEM_DEBUG */

/*
 * If we are not using the debugging allocator, we should call the Tcl_Alloc,
 * et al. routines in order to guarantee that every module is using the same
 * memory allocator both inside and outside of the Tcl library.
 */

#   define ckalloc(x) \
    ((void *) Tcl_Alloc((unsigned)(x)))
#   define ckfree(x) \
    Tcl_Free((char *)(x))
#   define ckrealloc(x,y) \
    ((void *) Tcl_Realloc((char *)(x), (unsigned)(y)))
#   define attemptckalloc(x) \
    ((void *) Tcl_AttemptAlloc((unsigned)(x)))
#   define attemptckrealloc(x,y) \
    ((void *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y)))
#   undef  Tcl_InitMemory
#   define Tcl_InitMemory(x)
#   undef  Tcl_DumpActiveMemory
#   define Tcl_DumpActiveMemory(x)
#   undef  Tcl_ValidateAllMemory
#   define Tcl_ValidateAllMemory(x,y)








|
<
|


<
<
|
<
|
<
|
<
|
<
|
<

|







<
<
<
<
<
<
<
<
<
<







2245
2246
2247
2248
2249
2250
2251
2252

2253
2254
2255


2256

2257

2258

2259

2260

2261
2262
2263
2264
2265
2266
2267
2268
2269










2270
2271
2272
2273
2274
2275
2276
#   define TCLAPI MODULE_SCOPE
#endif

#include "tclPlatDecls.h"

/*
 *----------------------------------------------------------------------------
 * The following declarations map ckalloc and ckfree to Tcl_Alloc and

 * Tcl_Free.
 */



#define ckalloc Tcl_Alloc

#define ckfree Tcl_Free

#define ckrealloc Tcl_Realloc

#define attemptckalloc Tcl_AttemptAlloc

#define attemptckrealloc Tcl_AttemptRealloc


#ifndef TCL_MEM_DEBUG

/*
 * If we are not using the debugging allocator, we should call the Tcl_Alloc,
 * et al. routines in order to guarantee that every module is using the same
 * memory allocator both inside and outside of the Tcl library.
 */











#   undef  Tcl_InitMemory
#   define Tcl_InitMemory(x)
#   undef  Tcl_DumpActiveMemory
#   define Tcl_DumpActiveMemory(x)
#   undef  Tcl_ValidateAllMemory
#   define Tcl_ValidateAllMemory(x,y)

2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358

/*
 *----------------------------------------------------------------------------
 * Macros for clients to use to access fields of hash entries:
 */

#define Tcl_GetHashValue(h) ((h)->clientData)
#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
#define Tcl_GetHashKey(tablePtr, h) \
	((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
		    (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
		   ? (h)->key.oneWordValue \
		   : (h)->key.string))

/*







|







2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350

/*
 *----------------------------------------------------------------------------
 * Macros for clients to use to access fields of hash entries:
 */

#define Tcl_GetHashValue(h) ((h)->clientData)
#define Tcl_SetHashValue(h, value) ((h)->clientData = (void *) (value))
#define Tcl_GetHashKey(tablePtr, h) \
	((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
		    (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
		   ? (h)->key.oneWordValue \
		   : (h)->key.string))

/*
Changes to generic/tclAlloc.c.
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpAlloc(
    unsigned int numBytes)	/* Number of bytes to allocate. */
{
    register union overhead *overPtr;
    register size_t bucket;
    register unsigned amount;
    struct block *bigBlockPtr = NULL;

    if (!allocInit) {







|

|







245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpAlloc(
    size_t numBytes)	/* Number of bytes to allocate. */
{
    register union overhead *overPtr;
    register size_t bucket;
    register unsigned amount;
    struct block *bigBlockPtr = NULL;

    if (!allocInit) {
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284

    /*
     * First the simple case: we simple allocate big blocks directly.
     */

    if (numBytes >= MAXMALLOC - OVERHEAD) {
	if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
	    bigBlockPtr = (struct block *) TclpSysAlloc(
		    sizeof(struct block) + OVERHEAD + numBytes);
	}
	if (bigBlockPtr == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
	bigBlockPtr->nextPtr = bigBlocks.nextPtr;







|







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284

    /*
     * First the simple case: we simple allocate big blocks directly.
     */

    if (numBytes >= MAXMALLOC - OVERHEAD) {
	if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
	    bigBlockPtr = TclpSysAlloc(
		    sizeof(struct block) + OVERHEAD + numBytes);
	}
	if (bigBlockPtr == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
    size = ((size_t)1) << (bucket + 3);
    ASSERT(size > 0);

    amount = MAXMALLOC;
    numBlocks = amount / size;
    ASSERT(numBlocks*size == amount);

    blockPtr = (struct block *) TclpSysAlloc(
	    sizeof(struct block) + amount);
    /* no more room! */
    if (blockPtr == NULL) {
	return;
    }
    blockPtr->nextPtr = blockList;
    blockList = blockPtr;








<
|







401
402
403
404
405
406
407

408
409
410
411
412
413
414
415
    size = ((size_t)1) << (bucket + 3);
    ASSERT(size > 0);

    amount = MAXMALLOC;
    numBlocks = amount / size;
    ASSERT(numBlocks*size == amount);


    blockPtr = TclpSysAlloc(sizeof(struct block) + amount);
    /* no more room! */
    if (blockPtr == NULL) {
	return;
    }
    blockPtr->nextPtr = blockList;
    blockList = blockPtr;

442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclpFree(
    char *oldPtr)		/* Pointer to memory to free. */
{
    register size_t size;
    register union overhead *overPtr;
    struct block *bigBlockPtr;

    if (oldPtr == NULL) {
	return;







|







441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclpFree(
    void *oldPtr)		/* Pointer to memory to free. */
{
    register size_t size;
    register union overhead *overPtr;
    struct block *bigBlockPtr;

    if (oldPtr == NULL) {
	return;
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpRealloc(
    char *oldPtr,		/* Pointer to alloced block. */
    unsigned int numBytes)	/* New size of memory. */
{
    int i;
    union overhead *overPtr;
    struct block *bigBlockPtr;
    int expensive;
    size_t maxSize;








|

|
|







504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloced block. */
    size_t numBytes)	/* New size of memory. */
{
    int i;
    union overhead *overPtr;
    struct block *bigBlockPtr;
    int expensive;
    size_t maxSize;

688
689
690
691
692
693
694

695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717

718
719
720
721
722
723
724
725
726
727
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


char *
TclpAlloc(
    unsigned int numBytes)	/* Number of bytes to allocate. */
{
    return (char *) malloc(numBytes);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFree --
 *
 *	Free memory.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


void
TclpFree(
    char *oldPtr)		/* Pointer to memory to free. */
{
    free(oldPtr);
    return;
}

/*
 *----------------------------------------------------------------------







>
|

|

|


















>


|







687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef TclpAlloc
void *
TclpAlloc(
    size_t numBytes)	/* Number of bytes to allocate. */
{
    return malloc(numBytes);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFree --
 *
 *	Free memory.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef TclpFree
void
TclpFree(
    void *oldPtr)		/* Pointer to memory to free. */
{
    free(oldPtr);
    return;
}

/*
 *----------------------------------------------------------------------
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpRealloc(
    char *oldPtr,		/* Pointer to alloced block. */
    unsigned int numBytes)	/* New size of memory. */
{
    return (char *) realloc(oldPtr, numBytes);
}

#endif /* !USE_TCLALLOC */
#endif /* !TCL_THREADS */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|

|
|

|












736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloced block. */
    size_t numBytes)	/* New size of memory. */
{
    return realloc(oldPtr, numBytes);
}

#endif /* !USE_TCLALLOC */
#endif /* !TCL_THREADS */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclAssembly.c.
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
    CompileEnv compEnv;		/* Compilation environment structure */
    register ByteCode *codePtr = NULL;
				/* Bytecode resulting from the assembly */
    Namespace* namespacePtr;	/* Namespace in which variable and command
				 * names in the bytecode resolve */
    int status;			/* Status return from Tcl_AssembleCode */
    const char* source;		/* String representation of the source code */
    int sourceLen;		/* Length of the source code in bytes */


    /*
     * Get the expression ByteCode from the object. If it exists, make sure it
     * is valid in the current context.
     */








|







839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
    CompileEnv compEnv;		/* Compilation environment structure */
    register ByteCode *codePtr = NULL;
				/* Bytecode resulting from the assembly */
    Namespace* namespacePtr;	/* Namespace in which variable and command
				 * names in the bytecode resolve */
    int status;			/* Status return from Tcl_AssembleCode */
    const char* source;		/* String representation of the source code */
    size_t sourceLen;		/* Length of the source code in bytes */


    /*
     * Get the expression ByteCode from the object. If it exists, make sure it
     * is valid in the current context.
     */

973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
     */

    if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
	    tokenPtr[1].size, TCL_EVAL_DIRECT)) {

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s\" body, line %d)",
		parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
		Tcl_GetErrorLine(interp)));
	envPtr->numCommands = numCommands;
	envPtr->codeNext = envPtr->codeStart + offset;
	envPtr->currStackDepth = depth;
	TclCompileSyntaxError(interp, envPtr);
    }
    return TCL_OK;







|







973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
     */

    if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
	    tokenPtr[1].size, TCL_EVAL_DIRECT)) {

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s\" body, line %d)",
		(int)parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
		Tcl_GetErrorLine(interp)));
	envPtr->numCommands = numCommands;
	envPtr->codeNext = envPtr->codeStart + offset;
	envPtr->currStackDepth = depth;
	TclCompileSyntaxError(interp, envPtr);
    }
    return TCL_OK;
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
     */

    for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) {
	if (thisBB->jumpTarget != NULL) {
	    Tcl_DecrRefCount(thisBB->jumpTarget);
	}
	if (thisBB->foreignExceptions != NULL) {
	    ckfree(thisBB->foreignExceptions);
	}
	nextBB = thisBB->successor1;
	if (thisBB->jtPtr != NULL) {
	    DeleteMirrorJumpTable(thisBB->jtPtr);
	    thisBB->jtPtr = NULL;
	}
	ckfree(thisBB);
    }

    /*
     * Dispose what's left.
     */

    Tcl_DeleteHashTable(&assemEnvPtr->labelHash);







|






|







1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
     */

    for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) {
	if (thisBB->jumpTarget != NULL) {
	    Tcl_DecrRefCount(thisBB->jumpTarget);
	}
	if (thisBB->foreignExceptions != NULL) {
	    Tcl_Free(thisBB->foreignExceptions);
	}
	nextBB = thisBB->successor1;
	if (thisBB->jtPtr != NULL) {
	    DeleteMirrorJumpTable(thisBB->jtPtr);
	    thisBB->jtPtr = NULL;
	}
	Tcl_Free(thisBB);
    }

    /*
     * Dispose what's left.
     */

    Tcl_DeleteHashTable(&assemEnvPtr->labelHash);
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
    Tcl_Obj* instNameObj;	/* Name of the instruction */
    int tblIdx;			/* Index in TalInstructionTable of the
				 * instruction */
    enum TalInstType instType;	/* Type of the instruction */
    Tcl_Obj* operand1Obj = NULL;
				/* First operand to the instruction */
    const char* operand1;	/* String rep of the operand */
    int operand1Len;		/* String length of the operand */
    int opnd;			/* Integer representation of an operand */
    int litIndex;		/* Literal pool index of a constant */
    int localVar;		/* LVT index of a local variable */
    int flags;			/* Flags for a basic block */
    JumptableInfo* jtPtr;	/* Pointer to a jumptable */
    int infoIndex;		/* Index of the jumptable in auxdata */
    int status = TCL_ERROR;	/* Return value from this function */







|







1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
    Tcl_Obj* instNameObj;	/* Name of the instruction */
    int tblIdx;			/* Index in TalInstructionTable of the
				 * instruction */
    enum TalInstType instType;	/* Type of the instruction */
    Tcl_Obj* operand1Obj = NULL;
				/* First operand to the instruction */
    const char* operand1;	/* String rep of the operand */
    size_t operand1Len;		/* String length of the operand */
    int opnd;			/* Integer representation of an operand */
    int litIndex;		/* Literal pool index of a constant */
    int localVar;		/* LVT index of a local variable */
    int flags;			/* Flags for a basic block */
    JumptableInfo* jtPtr;	/* Pointer to a jumptable */
    int infoIndex;		/* Index of the jumptable in auxdata */
    int status = TCL_ERROR;	/* Return value from this function */
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "table");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}

	jtPtr = ckalloc(sizeof(JumptableInfo));

	Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
	assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
	assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
	DEBUG_PRINT("bb %p jumpLine %d jumpOffset %d\n",
		assemEnvPtr->curr_bb, assemEnvPtr->cmdLine,
		envPtr->codeNext - envPtr->codeStart);







|







1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "table");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}

	jtPtr = Tcl_Alloc(sizeof(JumptableInfo));

	Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
	assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
	assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
	DEBUG_PRINT("bb %p jumpLine %d jumpOffset %d\n",
		assemEnvPtr->curr_bb, assemEnvPtr->cmdLine,
		envPtr->codeNext - envPtr->codeStart);
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
     */

    DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n",
	    curr_bb, exceptionCount, savedExceptArrayNext);
    curr_bb->foreignExceptionBase = savedExceptArrayNext;
    curr_bb->foreignExceptionCount = exceptionCount;
    curr_bb->foreignExceptions =
	    ckalloc(exceptionCount * sizeof(ExceptionRange));
    memcpy(curr_bb->foreignExceptions,
	    envPtr->exceptArrayPtr + savedExceptArrayNext,
	    exceptionCount * sizeof(ExceptionRange));
    for (i = 0; i < exceptionCount; ++i) {
	curr_bb->foreignExceptions[i].nestingLevel -= envPtr->exceptDepth;
    }
    envPtr->exceptArrayNext = savedExceptArrayNext;







|







1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
     */

    DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n",
	    curr_bb, exceptionCount, savedExceptArrayNext);
    curr_bb->foreignExceptionBase = savedExceptArrayNext;
    curr_bb->foreignExceptionCount = exceptionCount;
    curr_bb->foreignExceptions =
	    Tcl_Alloc(exceptionCount * sizeof(ExceptionRange));
    memcpy(curr_bb->foreignExceptions,
	    envPtr->exceptArrayPtr + savedExceptArrayNext,
	    exceptionCount * sizeof(ExceptionRange));
    for (i = 0; i < exceptionCount; ++i) {
	curr_bb->foreignExceptions[i].nestingLevel -= envPtr->exceptDepth;
    }
    envPtr->exceptArrayNext = savedExceptArrayNext;
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
	return TCL_ERROR;
    }

    /*
     * Allocate the jumptable.
     */

    jtPtr = ckalloc(sizeof(JumptableInfo));
    jtHashPtr = &jtPtr->hashTable;
    Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS);

    /*
     * Fill the keys and labels into the table.
     */








|







1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
	return TCL_ERROR;
    }

    /*
     * Allocate the jumptable.
     */

    jtPtr = Tcl_Alloc(sizeof(JumptableInfo));
    jtHashPtr = &jtPtr->hashTable;
    Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS);

    /*
     * Fill the keys and labels into the table.
     */

2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
	    entry != NULL;
	    entry = Tcl_NextHashEntry(&search)) {
	label = Tcl_GetHashValue(entry);
	Tcl_DecrRefCount(label);
	Tcl_SetHashValue(entry, NULL);
    }
    Tcl_DeleteHashTable(jtHashPtr);
    ckfree(jtPtr);
}

/*
 *-----------------------------------------------------------------------------
 *
 * GetNextOperand --
 *







|







2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
	    entry != NULL;
	    entry = Tcl_NextHashEntry(&search)) {
	label = Tcl_GetHashValue(entry);
	Tcl_DecrRefCount(label);
	Tcl_SetHashValue(entry, NULL);
    }
    Tcl_DeleteHashTable(jtHashPtr);
    Tcl_Free(jtPtr);
}

/*
 *-----------------------------------------------------------------------------
 *
 * GetNextOperand --
 *
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code. */
    Tcl_Obj* varNameObj;	/* Name of the variable */
    const char* varNameStr;
    int varNameLen;
    int localVar;		/* Index of the variable in the LVT */

    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
	return -1;
    }
    varNameStr = TclGetStringFromObj(varNameObj, &varNameLen);
    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {







|







2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code. */
    Tcl_Obj* varNameObj;	/* Name of the variable */
    const char* varNameStr;
    size_t varNameLen;
    int localVar;		/* Index of the variable in the LVT */

    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
	return -1;
    }
    varNameStr = TclGetStringFromObj(varNameObj, &varNameLen);
    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
 */

static BasicBlock *
AllocBB(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
    BasicBlock *bb = ckalloc(sizeof(BasicBlock));

    bb->originalStartOffset =
	    bb->startOffset = envPtr->codeNext - envPtr->codeStart;
    bb->startLine = assemEnvPtr->cmdLine + 1;
    bb->jumpOffset = -1;
    bb->jumpLine = -1;
    bb->prevPtr = assemEnvPtr->curr_bb;







|







2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
 */

static BasicBlock *
AllocBB(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
    BasicBlock *bb = Tcl_Alloc(sizeof(BasicBlock));

    bb->originalStartOffset =
	    bb->startOffset = envPtr->codeNext - envPtr->codeStart;
    bb->startLine = assemEnvPtr->cmdLine + 1;
    bb->jumpOffset = -1;
    bb->jumpLine = -1;
    bb->prevPtr = assemEnvPtr->curr_bb;
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
	}
    }

    /*
     * Allocate memory for a stack of active catches.
     */

    catches = ckalloc(maxCatchDepth * sizeof(BasicBlock*));
    catchIndices = ckalloc(maxCatchDepth * sizeof(int));
    for (i = 0; i < maxCatchDepth; ++i) {
	catches[i] = NULL;
	catchIndices[i] = -1;
    }

    /*
     * Walk through the basic blocks and manage exception ranges.







|
|







3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
	}
    }

    /*
     * Allocate memory for a stack of active catches.
     */

    catches = Tcl_Alloc(maxCatchDepth * sizeof(BasicBlock*));
    catchIndices = Tcl_Alloc(maxCatchDepth * sizeof(int));
    for (i = 0; i < maxCatchDepth; ++i) {
	catches[i] = NULL;
	catchIndices[i] = -1;
    }

    /*
     * Walk through the basic blocks and manage exception ranges.
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
    if (catchDepth != 0) {
	Tcl_Panic("unclosed catch at end of code in "
		"tclAssembly.c:BuildExceptionRanges, can't happen");
    }

    /* Free temp storage */

    ckfree(catchIndices);
    ckfree(catches);

    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *







|
|







3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
    if (catchDepth != 0) {
	Tcl_Panic("unclosed catch at end of code in "
		"tclAssembly.c:BuildExceptionRanges, can't happen");
    }

    /* Free temp storage */

    Tcl_Free(catchIndices);
    Tcl_Free(catches);

    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
Changes to generic/tclAsync.c.
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
    Tcl_AsyncProc *proc,	/* Procedure to call when handler is
				 * invoked. */
    ClientData clientData)	/* Argument to pass to handler. */
{
    AsyncHandler *asyncPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    asyncPtr = ckalloc(sizeof(AsyncHandler));
    asyncPtr->ready = 0;
    asyncPtr->nextPtr = NULL;
    asyncPtr->proc = proc;
    asyncPtr->clientData = clientData;
    asyncPtr->originTsd = tsdPtr;
    asyncPtr->originThrdId = Tcl_GetCurrentThread();








|







114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
    Tcl_AsyncProc *proc,	/* Procedure to call when handler is
				 * invoked. */
    ClientData clientData)	/* Argument to pass to handler. */
{
    AsyncHandler *asyncPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    asyncPtr = Tcl_Alloc(sizeof(AsyncHandler));
    asyncPtr->ready = 0;
    asyncPtr->nextPtr = NULL;
    asyncPtr->proc = proc;
    asyncPtr->clientData = clientData;
    asyncPtr->originTsd = tsdPtr;
    asyncPtr->originThrdId = Tcl_GetCurrentThread();

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
	    prevPtr->nextPtr = asyncPtr->nextPtr;
	}
	if (asyncPtr == tsdPtr->lastHandler) {
	    tsdPtr->lastHandler = prevPtr;
	}
    }
    Tcl_MutexUnlock(&tsdPtr->asyncMutex);
    ckfree(asyncPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AsyncReady --
 *







|







306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
	    prevPtr->nextPtr = asyncPtr->nextPtr;
	}
	if (asyncPtr == tsdPtr->lastHandler) {
	    tsdPtr->lastHandler = prevPtr;
	}
    }
    Tcl_MutexUnlock(&tsdPtr->asyncMutex);
    Tcl_Free(asyncPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AsyncReady --
 *
Changes to generic/tclBasic.c.
49
50
51
52
53
54
55
56
57
58
59
60
61
62











63
64
65
66
67
68
69

typedef struct {
    Tcl_Interp *interp;		/* Interp this struct belongs to. */
    Tcl_AsyncHandler async;	/* Async handler token for script
				 * cancellation. */
    char *result;		/* The script cancellation result or NULL for
				 * a default result. */
    int length;			/* Length of the above error message. */
    ClientData clientData;	/* Ignored */
    int flags;			/* Additional flags */
} CancelInfo;
static Tcl_HashTable cancelTable;
static int cancelTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(cancelLock)












/*
 * Declarations for managing contexts for non-recursive coroutines. Contexts
 * are used to save the evaluation state between NR calls to each coro.
 */

#define SAVE_CONTEXT(context)				\







|





|
>
>
>
>
>
>
>
>
>
>
>







49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

typedef struct {
    Tcl_Interp *interp;		/* Interp this struct belongs to. */
    Tcl_AsyncHandler async;	/* Async handler token for script
				 * cancellation. */
    char *result;		/* The script cancellation result or NULL for
				 * a default result. */
    size_t length;		/* Length of the above error message. */
    ClientData clientData;	/* Ignored */
    int flags;			/* Additional flags */
} CancelInfo;
static Tcl_HashTable cancelTable;
static int cancelTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(cancelLock);

/*
 * Table used to map command implementation functions to a human-readable type
 * name, for [info type]. The keys in the table are function addresses, and
 * the values in the table are static char* containing strings in Tcl's
 * internal encoding (almost UTF-8).
 */

static Tcl_HashTable commandTypeTable;
static int commandTypeInit = 0;
TCL_DECLARE_MUTEX(commandTypeLock);

/*
 * Declarations for managing contexts for non-recursive coroutines. Contexts
 * are used to save the evaluation state between NR calls to each coro.
 */

#define SAVE_CONTEXT(context)				\
78
79
80
81
82
83
84

85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
    iPtr->cmdFramePtr = (context).cmdFramePtr;		\
    iPtr->lineLABCPtr = (context).lineLABCPtr

/*
 * Static functions in this file:
 */


static char *		CallCommandTraces(Interp *iPtr, Command *cmdPtr,
			    const char *oldName, const char *newName,
			    int flags);
static int		CancelEvalProc(ClientData clientData,
			    Tcl_Interp *interp, int code);
static int		CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void		DeleteCoroutine(ClientData clientData);
static void		DeleteInterpProc(Tcl_Interp *interp);
static void		DeleteOpCmdClientData(ClientData clientData);
#ifdef USE_DTRACE
static Tcl_ObjCmdProc	DTraceObjCmd;
static Tcl_NRPostProc	DTraceCmdReturn;
#else
#   define DTraceCmdReturn	NULL
#endif /* USE_DTRACE */
static Tcl_ObjCmdProc	ExprAbsFunc;
static Tcl_ObjCmdProc	ExprBinaryFunc;
static Tcl_ObjCmdProc	ExprBoolFunc;
static Tcl_ObjCmdProc	ExprCeilFunc;
static Tcl_ObjCmdProc	ExprDoubleFunc;
static Tcl_ObjCmdProc	ExprEntierFunc;
static Tcl_ObjCmdProc	ExprFloorFunc;
static Tcl_ObjCmdProc	ExprIntFunc;
static Tcl_ObjCmdProc	ExprIsqrtFunc;
static Tcl_ObjCmdProc	ExprMaxFunc;
static Tcl_ObjCmdProc	ExprMinFunc;
static Tcl_ObjCmdProc	ExprRandFunc;
static Tcl_ObjCmdProc	ExprRoundFunc;







>




















<







89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
    iPtr->cmdFramePtr = (context).cmdFramePtr;		\
    iPtr->lineLABCPtr = (context).lineLABCPtr

/*
 * Static functions in this file:
 */

static Tcl_ObjCmdProc   BadEnsembleSubcommand;
static char *		CallCommandTraces(Interp *iPtr, Command *cmdPtr,
			    const char *oldName, const char *newName,
			    int flags);
static int		CancelEvalProc(ClientData clientData,
			    Tcl_Interp *interp, int code);
static int		CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void		DeleteCoroutine(ClientData clientData);
static void		DeleteInterpProc(Tcl_Interp *interp);
static void		DeleteOpCmdClientData(ClientData clientData);
#ifdef USE_DTRACE
static Tcl_ObjCmdProc	DTraceObjCmd;
static Tcl_NRPostProc	DTraceCmdReturn;
#else
#   define DTraceCmdReturn	NULL
#endif /* USE_DTRACE */
static Tcl_ObjCmdProc	ExprAbsFunc;
static Tcl_ObjCmdProc	ExprBinaryFunc;
static Tcl_ObjCmdProc	ExprBoolFunc;
static Tcl_ObjCmdProc	ExprCeilFunc;
static Tcl_ObjCmdProc	ExprDoubleFunc;

static Tcl_ObjCmdProc	ExprFloorFunc;
static Tcl_ObjCmdProc	ExprIntFunc;
static Tcl_ObjCmdProc	ExprIsqrtFunc;
static Tcl_ObjCmdProc	ExprMaxFunc;
static Tcl_ObjCmdProc	ExprMinFunc;
static Tcl_ObjCmdProc	ExprRandFunc;
static Tcl_ObjCmdProc	ExprRoundFunc;
175
176
177
178
179
180
181


















182
183
184
185
186
187
188
#define CMD_IS_SAFE         1   /* Whether this command is part of the set of
                                 * commands present by default in a safe
                                 * interpreter. */
/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
 * expansion for itself rather than needing the generic layer to take care of
 * it for it. Defined in tclInt.h. */



















/*
 * The built-in commands, and the functions that implement them:
 */

static const CmdInfo builtInCmds[] = {
    /*
     * Commands in the generic core.







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
#define CMD_IS_SAFE         1   /* Whether this command is part of the set of
                                 * commands present by default in a safe
                                 * interpreter. */
/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
 * expansion for itself rather than needing the generic layer to take care of
 * it for it. Defined in tclInt.h. */

/*
 * The following struct states that the command it talks about (a subcommand
 * of one of Tcl's built-in ensembles) is unsafe and must be hidden when an
 * interpreter is made safe. (TclHideUnsafeCommands accesses an array of these
 * structs.) Alas, we can't sensibly just store the information directly in
 * the commands.
 */

typedef struct {
    const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for
                                 * the end of the list of commands to hide. */
    const char *commandName;    /* The name of the command within the
                                 * ensemble. If this is NULL, we want to also
                                 * make the overall command be hidden, an ugly
                                 * hack because it is expected by security
                                 * policies in the wild. */
} UnsafeEnsembleInfo;

/*
 * The built-in commands, and the functions that implement them:
 */

static const CmdInfo builtInCmds[] = {
    /*
     * Commands in the generic core.
272
273
274
275
276
277
278






























































279
280
281
282
283
284
285
    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {NULL,		NULL,			NULL,			NULL,	0}
};































































/*
 * Math functions. All are safe.
 */

typedef struct {
    const char *name;		/* Name of the function. The full name is
				 * "::tcl::mathfunc::<name>". */







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {NULL,		NULL,			NULL,			NULL,	0}
};

/*
 * Information about which pieces of ensembles to hide when making an
 * interpreter safe:
 */

static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = {
    /* [encoding] has two unsafe commands. Assumed by older security policies
     * to be overall unsafe; it isn't but... */
    {"encoding", NULL},
    {"encoding", "dirs"},
    {"encoding", "system"},
    /* [file] has MANY unsafe commands! Assumed by older security policies to
     * be overall unsafe; it isn't but... */
    {"file", NULL},
    {"file", "atime"},
    {"file", "attributes"},
    {"file", "copy"},
    {"file", "delete"},
    {"file", "dirname"},
    {"file", "executable"},
    {"file", "exists"},
    {"file", "extension"},
    {"file", "isdirectory"},
    {"file", "isfile"},
    {"file", "link"},
    {"file", "lstat"},
    {"file", "mtime"},
    {"file", "mkdir"},
    {"file", "nativename"},
    {"file", "normalize"},
    {"file", "owned"},
    {"file", "readable"},
    {"file", "readlink"},
    {"file", "rename"},
    {"file", "rootname"},
    {"file", "size"},
    {"file", "stat"},
    {"file", "tail"},
    {"file", "tempfile"},
    {"file", "type"},
    {"file", "volumes"},
    {"file", "writable"},
    /* [info] has two unsafe commands */
    {"info", "cmdtype"},
    {"info", "nameofexecutable"},
    /* [tcl::process] has ONLY unsafe commands! */
    {"process", "list"},
    {"process", "status"},
    {"process", "purge"},
    {"process", "autopurge"},
    /* [zipfs] has MANY unsafe commands! */
    {"zipfs", "lmkimg"},
    {"zipfs", "lmkzip"},
    {"zipfs", "mkimg"},
    {"zipfs", "mkkey"},
    {"zipfs", "mkzip"},
    {"zipfs", "mount"},
    {"zipfs", "mount_data"},
    {"zipfs", "unmount"},
    {NULL, NULL}
};

/*
 * Math functions. All are safe.
 */

typedef struct {
    const char *name;		/* Name of the function. The full name is
				 * "::tcl::mathfunc::<name>". */
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
    { "atan",	ExprUnaryFunc,	(ClientData) atan	},
    { "atan2",	ExprBinaryFunc,	(ClientData) atan2	},
    { "bool",	ExprBoolFunc,	NULL			},
    { "ceil",	ExprCeilFunc,	NULL			},
    { "cos",	ExprUnaryFunc,	(ClientData) cos	},
    { "cosh",	ExprUnaryFunc,	(ClientData) cosh	},
    { "double",	ExprDoubleFunc,	NULL			},
    { "entier",	ExprEntierFunc,	NULL			},
    { "exp",	ExprUnaryFunc,	(ClientData) exp	},
    { "floor",	ExprFloorFunc,	NULL			},
    { "fmod",	ExprBinaryFunc,	(ClientData) fmod	},
    { "hypot",	ExprBinaryFunc,	(ClientData) hypot	},
    { "int",	ExprIntFunc,	NULL			},
    { "isqrt",	ExprIsqrtFunc,	NULL			},
    { "log",	ExprUnaryFunc,	(ClientData) log	},







|







384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
    { "atan",	ExprUnaryFunc,	(ClientData) atan	},
    { "atan2",	ExprBinaryFunc,	(ClientData) atan2	},
    { "bool",	ExprBoolFunc,	NULL			},
    { "ceil",	ExprCeilFunc,	NULL			},
    { "cos",	ExprUnaryFunc,	(ClientData) cos	},
    { "cosh",	ExprUnaryFunc,	(ClientData) cosh	},
    { "double",	ExprDoubleFunc,	NULL			},
    { "entier",	ExprIntFunc,	NULL			},
    { "exp",	ExprUnaryFunc,	(ClientData) exp	},
    { "floor",	ExprFloorFunc,	NULL			},
    { "fmod",	ExprBinaryFunc,	(ClientData) fmod	},
    { "hypot",	ExprBinaryFunc,	(ClientData) hypot	},
    { "int",	ExprIntFunc,	NULL			},
    { "isqrt",	ExprIsqrtFunc,	NULL			},
    { "log",	ExprUnaryFunc,	(ClientData) log	},
408
409
410
411
412
413
414







415
416
417
418
419
420
421
{
    Tcl_MutexLock(&cancelLock);
    if (cancelTableInitialized == 1) {
	Tcl_DeleteHashTable(&cancelTable);
	cancelTableInitialized = 0;
    }
    Tcl_MutexUnlock(&cancelLock);







}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp --
 *







>
>
>
>
>
>
>







499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
{
    Tcl_MutexLock(&cancelLock);
    if (cancelTableInitialized == 1) {
	Tcl_DeleteHashTable(&cancelTable);
	cancelTableInitialized = 0;
    }
    Tcl_MutexUnlock(&cancelLock);

    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit) {
        Tcl_DeleteHashTable(&commandTypeTable);
        commandTypeInit = 0;
    }
    Tcl_MutexUnlock(&commandTypeLock);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp --
 *
481
482
483
484
485
486
487

488
489













490
491
492
493
494
495
496
497
498
499
500
501
502
503
504

    if (cancelTableInitialized == 0) {
	Tcl_MutexLock(&cancelLock);
	if (cancelTableInitialized == 0) {
	    Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
	    cancelTableInitialized = 1;
	}

	Tcl_MutexUnlock(&cancelLock);
    }














    /*
     * Initialize support for namespaces and create the global namespace
     * (whose name is ""; an alias is "::"). This also initializes the Tcl
     * object type table and other object management code.
     */

    iPtr = ckalloc(sizeof(Interp));
    interp = (Tcl_Interp *) iPtr;

    iPtr->legacyResult = NULL;
    /* Special invalid value: Any attempt to free the legacy result
     * will cause a crash. */
    iPtr->legacyFreeProc = (void (*) (void))-1;
    iPtr->errorLine = 0;







>


>
>
>
>
>
>
>
>
>
>
>
>
>







|







579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616

    if (cancelTableInitialized == 0) {
	Tcl_MutexLock(&cancelLock);
	if (cancelTableInitialized == 0) {
	    Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
	    cancelTableInitialized = 1;
	}

	Tcl_MutexUnlock(&cancelLock);
    }

    if (commandTypeInit == 0) {
        TclRegisterCommandTypeName(TclObjInterpProc, "proc");
        TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble");
        TclRegisterCommandTypeName(TclAliasObjCmd, "alias");
        TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias");
        TclRegisterCommandTypeName(TclSlaveObjCmd, "slave");
        TclRegisterCommandTypeName(TclInvokeImportedCmd, "import");
        TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object");
        TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject");
        TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass");
        TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine");
    }

    /*
     * Initialize support for namespaces and create the global namespace
     * (whose name is ""; an alias is "::"). This also initializes the Tcl
     * object type table and other object management code.
     */

    iPtr = Tcl_Alloc(sizeof(Interp));
    interp = (Tcl_Interp *) iPtr;

    iPtr->legacyResult = NULL;
    /* Special invalid value: Any attempt to free the legacy result
     * will cause a crash. */
    iPtr->legacyFreeProc = (void (*) (void))-1;
    iPtr->errorLine = 0;
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536

    /*
     * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc
     * structures.
     */

    iPtr->cmdFramePtr = NULL;
    iPtr->linePBodyPtr = ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineBCPtr = ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineLAPtr = ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
    iPtr->scriptCLLocPtr = NULL;

    iPtr->activeVarTracePtr = NULL;







|
|
|
|







631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648

    /*
     * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc
     * structures.
     */

    iPtr->cmdFramePtr = NULL;
    iPtr->linePBodyPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
    iPtr->lineBCPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
    iPtr->lineLAPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
    iPtr->lineLABCPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
    iPtr->scriptCLLocPtr = NULL;

    iPtr->activeVarTracePtr = NULL;
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630

    /*
     * Initialise the rootCallframe. It cannot be allocated on the stack, as
     * it has to be in place before TclCreateExecEnv tries to use a variable.
     */

    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
    framePtr = ckalloc(sizeof(CallFrame));
    (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
	    (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
    framePtr->objc = 0;

    iPtr->framePtr = framePtr;
    iPtr->varFramePtr = framePtr;
    iPtr->rootFramePtr = framePtr;







|







728
729
730
731
732
733
734
735
736
737
738
739
740
741
742

    /*
     * Initialise the rootCallframe. It cannot be allocated on the stack, as
     * it has to be in place before TclCreateExecEnv tries to use a variable.
     */

    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
    framePtr = Tcl_Alloc(sizeof(CallFrame));
    (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
	    (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
    framePtr->objc = 0;

    iPtr->framePtr = framePtr;
    iPtr->varFramePtr = framePtr;
    iPtr->rootFramePtr = framePtr;
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660

    /*
     * TIP #285, Script cancellation support.
     */

    iPtr->asyncCancelMsg = Tcl_NewObj();

    cancelInfo = ckalloc(sizeof(CancelInfo));
    cancelInfo->interp = interp;

    iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
    cancelInfo->async = iPtr->asyncCancel;
    cancelInfo->result = NULL;
    cancelInfo->length = 0;








|







758
759
760
761
762
763
764
765
766
767
768
769
770
771
772

    /*
     * TIP #285, Script cancellation support.
     */

    iPtr->asyncCancelMsg = Tcl_NewObj();

    cancelInfo = Tcl_Alloc(sizeof(CancelInfo));
    cancelInfo->interp = interp;

    iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
    cancelInfo->async = iPtr->asyncCancel;
    cancelInfo->result = NULL;
    cancelInfo->length = 0;

739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
		&& (cmdInfoPtr->nreProc == NULL)) {
	    Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc");
	}

	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
		cmdInfoPtr->name, &isNew);
	if (isNew) {
	    cmdPtr = ckalloc(sizeof(Command));
	    cmdPtr->hPtr = hPtr;
	    cmdPtr->nsPtr = iPtr->globalNsPtr;
	    cmdPtr->refCount = 1;
	    cmdPtr->cmdEpoch = 0;
	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
	    cmdPtr->proc = TclInvokeObjectCommand;
	    cmdPtr->clientData = cmdPtr;







|







851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
		&& (cmdInfoPtr->nreProc == NULL)) {
	    Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc");
	}

	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
		cmdInfoPtr->name, &isNew);
	if (isNew) {
	    cmdPtr = Tcl_Alloc(sizeof(Command));
	    cmdPtr->hPtr = hPtr;
	    cmdPtr->nsPtr = iPtr->globalNsPtr;
	    cmdPtr->refCount = 1;
	    cmdPtr->cmdEpoch = 0;
	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
	    cmdPtr->proc = TclInvokeObjectCommand;
	    cmdPtr->clientData = cmdPtr;
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
    if (mathopNSPtr == NULL) {
	Tcl_Panic("can't create math operator namespace");
    }
    Tcl_Export(interp, mathopNSPtr, "*", 1);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
	TclOpCmdClientData *occdPtr = ckalloc(sizeof(TclOpCmdClientData));

	occdPtr->op = opcmdInfoPtr->name;
	occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
	occdPtr->expected = opcmdInfoPtr->expected;
	strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
	cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName,
		opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData);







|







971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
    if (mathopNSPtr == NULL) {
	Tcl_Panic("can't create math operator namespace");
    }
    Tcl_Export(interp, mathopNSPtr, "*", 1);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
	TclOpCmdClientData *occdPtr = Tcl_Alloc(sizeof(TclOpCmdClientData));

	occdPtr->op = opcmdInfoPtr->name;
	occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
	occdPtr->expected = opcmdInfoPtr->expected;
	strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
	cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName,
		opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData);
954
955
956
957
958
959
960



961
962
963
964
965
966
967
968
969
970
971
972
973

































































974
975
976
977
978
979
980
     * compile and link against.
     */

#ifdef HAVE_ZLIB
    if (TclZlibInit(interp) != TCL_OK) {
	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
    }



#endif

    TOP_CB(iPtr) = NULL;
    return interp;
}

static void
DeleteOpCmdClientData(
    ClientData clientData)
{
    TclOpCmdClientData *occdPtr = clientData;

    ckfree(occdPtr);

































































}

/*
 *----------------------------------------------------------------------
 *
 * TclHideUnsafeCommands --
 *







>
>
>












|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
     * compile and link against.
     */

#ifdef HAVE_ZLIB
    if (TclZlibInit(interp) != TCL_OK) {
	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
    }
    if (TclZipfs_Init(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
    }
#endif

    TOP_CB(iPtr) = NULL;
    return interp;
}

static void
DeleteOpCmdClientData(
    ClientData clientData)
{
    TclOpCmdClientData *occdPtr = clientData;

    Tcl_Free(occdPtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * TclRegisterCommandTypeName, TclGetCommandTypeName --
 *
 *      Command type registration and lookup mechanism. Everything is keyed by
 *      the Tcl_ObjCmdProc for the command, and that is used as the *key* into
 *      the hash table that maps to constant strings that are names. (It is
 *      recommended that those names be ASCII.)
 *
 * ---------------------------------------------------------------------
 */

void
TclRegisterCommandTypeName(
    Tcl_ObjCmdProc *implementationProc,
    const char *nameStr)
{
    Tcl_HashEntry *hPtr;

    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit == 0) {
        Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS);
        commandTypeInit = 1;
    }
    if (nameStr != NULL) {
        int isNew;

        hPtr = Tcl_CreateHashEntry(&commandTypeTable,
                (void *) implementationProc, &isNew);
        Tcl_SetHashValue(hPtr, (void *) nameStr);
    } else {
        hPtr = Tcl_FindHashEntry(&commandTypeTable,
                (void *) implementationProc);
        if (hPtr != NULL) {
            Tcl_DeleteHashEntry(hPtr);
        }
    }
    Tcl_MutexUnlock(&commandTypeLock);
}

const char *
TclGetCommandTypeName(
    Tcl_Command command)
{
    Command *cmdPtr = (Command *) command;
    void *procPtr = cmdPtr->objProc;
    const char *name = "native";

    if (procPtr == NULL) {
        procPtr = cmdPtr->nreProc;
    }
    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit) {
        Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr);

        if (hPtr && Tcl_GetHashValue(hPtr)) {
            name = (const char *) Tcl_GetHashValue(hPtr);
        }
    }
    Tcl_MutexUnlock(&commandTypeLock);

    return name;
}

/*
 *----------------------------------------------------------------------
 *
 * TclHideUnsafeCommands --
 *
990
991
992
993
994
995
996

997
998
999
1000
1001
1002
1003
1004
1005
1006






1007































1008
1009


































1010
1011
1012
1013
1014
1015
1016
 */

int
TclHideUnsafeCommands(
    Tcl_Interp *interp)		/* Hide commands in this interpreter. */
{
    register const CmdInfo *cmdInfoPtr;


    if (interp == NULL) {
	return TCL_ERROR;
    }
    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
	if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) {
	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
	}
    }
    TclMakeEncodingCommandSafe(interp); /* Ugh! */






    TclMakeFileCommandSafe(interp);     /* Ugh! */































    return TCL_OK;
}



































/*
 *--------------------------------------------------------------
 *
 * Tcl_CallWhenDeleted --
 *
 *	Arrange for a function to be called before a given interpreter is







>









|
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
 */

int
TclHideUnsafeCommands(
    Tcl_Interp *interp)		/* Hide commands in this interpreter. */
{
    register const CmdInfo *cmdInfoPtr;
    register const UnsafeEnsembleInfo *unsafePtr;

    if (interp == NULL) {
	return TCL_ERROR;
    }
    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
	if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) {
	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
	}
    }

    for (unsafePtr = unsafeEnsembleCommands;
            unsafePtr->ensembleNsName; unsafePtr++) {
        if (unsafePtr->commandName) {
            /*
             * Hide an ensemble subcommand.
             */

            Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s",
                    unsafePtr->ensembleNsName, unsafePtr->commandName);
            Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s",
                    unsafePtr->ensembleNsName, unsafePtr->commandName);

            if (TclRenameCommand(interp, TclGetString(cmdName),
                        "___tmp") != TCL_OK
                    || Tcl_HideCommand(interp, "___tmp",
                            TclGetString(hideName)) != TCL_OK) {
                Tcl_Panic("problem making '%s %s' safe: %s",
                        unsafePtr->ensembleNsName, unsafePtr->commandName,
                        Tcl_GetString(Tcl_GetObjResult(interp)));
            }
            Tcl_CreateObjCommand(interp, TclGetString(cmdName),
                    BadEnsembleSubcommand, (ClientData) unsafePtr, NULL);
            TclDecrRefCount(cmdName);
            TclDecrRefCount(hideName);
        } else {
            /*
             * Hide an ensemble main command (for compatibility).
             */

            if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName,
                    unsafePtr->ensembleNsName) != TCL_OK) {
                Tcl_Panic("problem making '%s' safe: %s",
                        unsafePtr->ensembleNsName,
                        Tcl_GetString(Tcl_GetObjResult(interp)));
            }
        }
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * BadEnsembleSubcommand --
 *
 *	Command used to act as a backstop implementation when subcommands of
 *	ensembles are unsafe (the real implementations of the subcommands are
 *	hidden). The clientData is description of what was hidden.
 *
 * Results:
 *	A standard Tcl result (always a TCL_ERROR).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
BadEnsembleSubcommand(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const UnsafeEnsembleInfo *infoPtr = clientData;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "not allowed to invoke subcommand %s of %s",
            infoPtr->commandName, infoPtr->ensembleNsName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_CallWhenDeleted --
 *
 *	Arrange for a function to be called before a given interpreter is
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
{
    Interp *iPtr = (Interp *) interp;
    static Tcl_ThreadDataKey assocDataCounterKey;
    int *assocDataCounterPtr =
	    Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
    int isNew;
    char buffer[32 + TCL_INTEGER_SPACE];
    AssocData *dPtr = ckalloc(sizeof(AssocData));
    Tcl_HashEntry *hPtr;

    sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
    (*assocDataCounterPtr)++;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
    dPtr->proc = proc;
    dPtr->clientData = clientData;
    Tcl_SetHashValue(hPtr, dPtr);
}







|






|







1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
{
    Interp *iPtr = (Interp *) interp;
    static Tcl_ThreadDataKey assocDataCounterKey;
    int *assocDataCounterPtr =
	    Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
    int isNew;
    char buffer[32 + TCL_INTEGER_SPACE];
    AssocData *dPtr = Tcl_Alloc(sizeof(AssocData));
    Tcl_HashEntry *hPtr;

    sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
    (*assocDataCounterPtr)++;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
    dPtr->proc = proc;
    dPtr->clientData = clientData;
    Tcl_SetHashValue(hPtr, dPtr);
}
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
    if (hTablePtr == NULL) {
	return;
    }
    for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	dPtr = Tcl_GetHashValue(hPtr);
	if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
	    ckfree(dPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    return;
	}
    }
}

/*







|







1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
    if (hTablePtr == NULL) {
	return;
    }
    for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	dPtr = Tcl_GetHashValue(hPtr);
	if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
	    Tcl_Free(dPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    return;
	}
    }
}

/*
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
{
    Interp *iPtr = (Interp *) interp;
    AssocData *dPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew);
    if (isNew == 0) {
	dPtr = Tcl_GetHashValue(hPtr);
    } else {
	dPtr = ckalloc(sizeof(AssocData));
    }
    dPtr->proc = proc;
    dPtr->clientData = clientData;

    Tcl_SetHashValue(hPtr, dPtr);
}








|






|







1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
{
    Interp *iPtr = (Interp *) interp;
    AssocData *dPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew);
    if (isNew == 0) {
	dPtr = Tcl_GetHashValue(hPtr);
    } else {
	dPtr = Tcl_Alloc(sizeof(AssocData));
    }
    dPtr->proc = proc;
    dPtr->clientData = clientData;

    Tcl_SetHashValue(hPtr, dPtr);
}

1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
    if (hPtr == NULL) {
	return;
    }
    dPtr = Tcl_GetHashValue(hPtr);
    if (dPtr->proc != NULL) {
	dPtr->proc(dPtr->clientData, interp);
    }
    ckfree(dPtr);
    Tcl_DeleteHashEntry(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAssocData --







|







1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
    if (hPtr == NULL) {
	return;
    }
    dPtr = Tcl_GetHashValue(hPtr);
    if (dPtr->proc != NULL) {
	dPtr->proc(dPtr->clientData, interp);
    }
    Tcl_Free(dPtr);
    Tcl_DeleteHashEntry(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAssocData --
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
    Tcl_MutexLock(&cancelLock);
    hPtr = Tcl_FindHashEntry(&cancelTable, (char *) iPtr);
    if (hPtr != NULL) {
	CancelInfo *cancelInfo = Tcl_GetHashValue(hPtr);

	if (cancelInfo != NULL) {
	    if (cancelInfo->result != NULL) {
		ckfree(cancelInfo->result);
	    }
	    ckfree(cancelInfo);
	}

	Tcl_DeleteHashEntry(hPtr);
    }

    if (iPtr->asyncCancel != NULL) {
	Tcl_AsyncDelete(iPtr->asyncCancel);







|

|







1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
    Tcl_MutexLock(&cancelLock);
    hPtr = Tcl_FindHashEntry(&cancelTable, (char *) iPtr);
    if (hPtr != NULL) {
	CancelInfo *cancelInfo = Tcl_GetHashValue(hPtr);

	if (cancelInfo != NULL) {
	    if (cancelInfo->result != NULL) {
		Tcl_Free(cancelInfo->result);
	    }
	    Tcl_Free(cancelInfo);
	}

	Tcl_DeleteHashEntry(hPtr);
    }

    if (iPtr->asyncCancel != NULL) {
	Tcl_AsyncDelete(iPtr->asyncCancel);
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
	 */

	hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
	for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Tcl_DeleteCommandFromToken(interp, Tcl_GetHashValue(hPtr));
	}
	Tcl_DeleteHashTable(hTablePtr);
	ckfree(hTablePtr);
    }

    /*
     * Invoke deletion callbacks; note that a callback can create new
     * callbacks, so we iterate.
     */

    while (iPtr->assocData != NULL) {
	AssocData *dPtr;

	hTablePtr = iPtr->assocData;
	iPtr->assocData = NULL;
	for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
		hPtr != NULL;
		hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
	    dPtr = Tcl_GetHashValue(hPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    if (dPtr->proc != NULL) {
		dPtr->proc(dPtr->clientData, interp);
	    }
	    ckfree(dPtr);
	}
	Tcl_DeleteHashTable(hTablePtr);
	ckfree(hTablePtr);
    }

    /*
     * Pop the root frame pointer and finish deleting the global
     * namespace. The order is important [Bug 1658572].
     */

    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
    }
    Tcl_PopCallFrame(interp);
    ckfree(iPtr->rootFramePtr);
    iPtr->rootFramePtr = NULL;
    Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);

    /*
     * Free up the result *after* deleting variables, since variable deletion
     * could have transferred ownership of the result string to Tcl.
     */







|




















|


|











|







1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
	 */

	hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
	for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Tcl_DeleteCommandFromToken(interp, Tcl_GetHashValue(hPtr));
	}
	Tcl_DeleteHashTable(hTablePtr);
	Tcl_Free(hTablePtr);
    }

    /*
     * Invoke deletion callbacks; note that a callback can create new
     * callbacks, so we iterate.
     */

    while (iPtr->assocData != NULL) {
	AssocData *dPtr;

	hTablePtr = iPtr->assocData;
	iPtr->assocData = NULL;
	for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
		hPtr != NULL;
		hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
	    dPtr = Tcl_GetHashValue(hPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    if (dPtr->proc != NULL) {
		dPtr->proc(dPtr->clientData, interp);
	    }
	    Tcl_Free(dPtr);
	}
	Tcl_DeleteHashTable(hTablePtr);
	Tcl_Free(hTablePtr);
    }

    /*
     * Pop the root frame pointer and finish deleting the global
     * namespace. The order is important [Bug 1658572].
     */

    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
    }
    Tcl_PopCallFrame(interp);
    Tcl_Free(iPtr->rootFramePtr);
    iPtr->rootFramePtr = NULL;
    Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);

    /*
     * Free up the result *after* deleting variables, since variable deletion
     * could have transferred ownership of the result string to Tcl.
     */
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
    }
    Tcl_DecrRefCount(iPtr->emptyObjPtr);
    iPtr->emptyObjPtr = NULL;

    resPtr = iPtr->resolverPtr;
    while (resPtr) {
	nextResPtr = resPtr->nextPtr;
	ckfree(resPtr->name);
	ckfree(resPtr);
	resPtr = nextResPtr;
    }

    /*
     * Free up literal objects created for scripts compiled by the
     * interpreter.
     */







|
|







1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
    }
    Tcl_DecrRefCount(iPtr->emptyObjPtr);
    iPtr->emptyObjPtr = NULL;

    resPtr = iPtr->resolverPtr;
    while (resPtr) {
	nextResPtr = resPtr->nextPtr;
	Tcl_Free(resPtr->name);
	Tcl_Free(resPtr);
	resPtr = nextResPtr;
    }

    /*
     * Free up literal objects created for scripts compiled by the
     * interpreter.
     */
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
	Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);

	procPtr->iPtr = NULL;
	if (cfPtr) {
	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
		Tcl_DecrRefCount(cfPtr->data.eval.path);
	    }
	    ckfree(cfPtr->line);
	    ckfree(cfPtr);
	}
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(iPtr->linePBodyPtr);
    ckfree(iPtr->linePBodyPtr);
    iPtr->linePBodyPtr = NULL;

    /*
     * See also tclCompile.c, TclCleanupByteCode
     */

    for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ExtCmdLoc *eclPtr = Tcl_GetHashValue(hPtr);

	if (eclPtr->type == TCL_LOCATION_SOURCE) {
	    Tcl_DecrRefCount(eclPtr->path);
	}
	for (i=0; i< eclPtr->nuloc; i++) {
	    ckfree(eclPtr->loc[i].line);
	}

	if (eclPtr->loc != NULL) {
	    ckfree(eclPtr->loc);
	}

	ckfree(eclPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(iPtr->lineBCPtr);
    ckfree(iPtr->lineBCPtr);
    iPtr->lineBCPtr = NULL;

    /*
     * Location stack for uplevel/eval/... scripts which were passed through
     * proc arguments. Actually we track all arguments as we do not and cannot
     * know which arguments will be used as scripts and which will not.
     */

    if (iPtr->lineLAPtr->numEntries && !TclInExit()) {
	/*
	 * When the interp goes away we have nothing on the stack, so there
	 * are no arguments, so this table has to be empty.
	 */

	Tcl_Panic("Argument location tracking table not empty");
    }

    Tcl_DeleteHashTable(iPtr->lineLAPtr);
    ckfree(iPtr->lineLAPtr);
    iPtr->lineLAPtr = NULL;

    if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
	/*
	 * When the interp goes away we have nothing on the stack, so there
	 * are no arguments, so this table has to be empty.
	 */

	Tcl_Panic("Argument location tracking table not empty");
    }

    Tcl_DeleteHashTable(iPtr->lineLABCPtr);
    ckfree(iPtr->lineLABCPtr);
    iPtr->lineLABCPtr = NULL;

    /*
     * Squelch the tables of traces on variables and searches over arrays in
     * the in the interpreter.
     */

    Tcl_DeleteHashTable(&iPtr->varTraces);
    Tcl_DeleteHashTable(&iPtr->varSearches);

    ckfree(iPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_HideCommand --
 *







|
|




|















|



|


|



|


















|












|










|







1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
	Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);

	procPtr->iPtr = NULL;
	if (cfPtr) {
	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
		Tcl_DecrRefCount(cfPtr->data.eval.path);
	    }
	    Tcl_Free(cfPtr->line);
	    Tcl_Free(cfPtr);
	}
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(iPtr->linePBodyPtr);
    Tcl_Free(iPtr->linePBodyPtr);
    iPtr->linePBodyPtr = NULL;

    /*
     * See also tclCompile.c, TclCleanupByteCode
     */

    for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ExtCmdLoc *eclPtr = Tcl_GetHashValue(hPtr);

	if (eclPtr->type == TCL_LOCATION_SOURCE) {
	    Tcl_DecrRefCount(eclPtr->path);
	}
	for (i=0; i< eclPtr->nuloc; i++) {
	    Tcl_Free(eclPtr->loc[i].line);
	}

	if (eclPtr->loc != NULL) {
	    Tcl_Free(eclPtr->loc);
	}

	Tcl_Free(eclPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(iPtr->lineBCPtr);
    Tcl_Free(iPtr->lineBCPtr);
    iPtr->lineBCPtr = NULL;

    /*
     * Location stack for uplevel/eval/... scripts which were passed through
     * proc arguments. Actually we track all arguments as we do not and cannot
     * know which arguments will be used as scripts and which will not.
     */

    if (iPtr->lineLAPtr->numEntries && !TclInExit()) {
	/*
	 * When the interp goes away we have nothing on the stack, so there
	 * are no arguments, so this table has to be empty.
	 */

	Tcl_Panic("Argument location tracking table not empty");
    }

    Tcl_DeleteHashTable(iPtr->lineLAPtr);
    Tcl_Free(iPtr->lineLAPtr);
    iPtr->lineLAPtr = NULL;

    if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
	/*
	 * When the interp goes away we have nothing on the stack, so there
	 * are no arguments, so this table has to be empty.
	 */

	Tcl_Panic("Argument location tracking table not empty");
    }

    Tcl_DeleteHashTable(iPtr->lineLABCPtr);
    Tcl_Free(iPtr->lineLABCPtr);
    iPtr->lineLABCPtr = NULL;

    /*
     * Squelch the tables of traces on variables and searches over arrays in
     * the in the interpreter.
     */

    Tcl_DeleteHashTable(&iPtr->varTraces);
    Tcl_DeleteHashTable(&iPtr->varSearches);

    Tcl_Free(iPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_HideCommand --
 *
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745

    /*
     * Initialize the hidden command table if necessary.
     */

    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr == NULL) {
	hiddenCmdTablePtr = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
	iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr;
    }

    /*
     * It is an error to move an exposed command to a hidden command with
     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already







|







1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997

    /*
     * Initialize the hidden command table if necessary.
     */

    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr == NULL) {
	hiddenCmdTablePtr = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
	iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr;
    }

    /*
     * It is an error to move an exposed command to a hidden command with
     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
    if (!isNew) {
	/*
	 * If the deletion callback recreated the command, just throw away
	 * the new command (if we try to delete it again, we could get
	 * stuck in an infinite loop).
	 */

	ckfree(Tcl_GetHashValue(hPtr));
    }

    if (!deleted) {

	/*
	 * Command resolvers (per-interp, per-namespace) might have resolved
	 * to a command for the given namespace scope with this command not







|







2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
    if (!isNew) {
	/*
	 * If the deletion callback recreated the command, just throw away
	 * the new command (if we try to delete it again, we could get
	 * stuck in an infinite loop).
	 */

	Tcl_Free(Tcl_GetHashValue(hPtr));
    }

    if (!deleted) {

	/*
	 * Command resolvers (per-interp, per-namespace) might have resolved
	 * to a command for the given namespace scope with this command not
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
	 * However, we do not need to recompute this just yet; next time we
	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = TclInvokeStringCommand;







|







2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
	 * However, we do not need to recompute this just yet; next time we
	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = Tcl_Alloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = TclInvokeStringCommand;
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
    if (!isNew) {
	/*
	 * If the deletion callback recreated the command, just throw away the
	 * new command (if we try to delete it again, we could get stuck in an
	 * infinite loop).
	 */

	ckfree(Tcl_GetHashValue(hPtr));
    }

    if (!deleted) {
	/*
	 * Command resolvers (per-interp, per-namespace) might have resolved
	 * to a command for the given namespace scope with this command not
	 * being registered with the namespace's command table. During BC







|







2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
    if (!isNew) {
	/*
	 * If the deletion callback recreated the command, just throw away the
	 * new command (if we try to delete it again, we could get stuck in an
	 * infinite loop).
	 */

	Tcl_Free(Tcl_GetHashValue(hPtr));
    }

    if (!deleted) {
	/*
	 * Command resolvers (per-interp, per-namespace) might have resolved
	 * to a command for the given namespace scope with this command not
	 * being registered with the namespace's command table. During BC
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
	 * However, we do not need to recompute this just yet; next time we
	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = proc;







|







2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
	 * However, we do not need to recompute this just yet; next time we
	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = Tcl_Alloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = proc;
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
	 */

	tracePtr = cmdPtr->tracePtr;
	while (tracePtr != NULL) {
	    CommandTrace *nextPtr = tracePtr->nextPtr;

	    if (tracePtr->refCount-- <= 1) {
		ckfree(tracePtr);
	    }
	    tracePtr = nextPtr;
	}
	cmdPtr->tracePtr = NULL;
    }

    /*







|







3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
	 */

	tracePtr = cmdPtr->tracePtr;
	while (tracePtr != NULL) {
	    CommandTrace *nextPtr = tracePtr->nextPtr;

	    if (tracePtr->refCount-- <= 1) {
		Tcl_Free(tracePtr);
	    }
	    tracePtr = nextPtr;
	}
	cmdPtr->tracePtr = NULL;
    }

    /*
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
	 * created when a command was imported into a namespace, this client
	 * data will be a pointer to a ImportedCmdData structure describing
	 * the "real" command that this imported command refers to.
	 *
	 * If you are getting a crash during the call to deleteProc and
	 * cmdPtr->deleteProc is a pointer to the function free(), the most
	 * likely cause is that your extension allocated memory for the
	 * clientData argument to Tcl_CreateObjCommand with the ckalloc()
	 * macro and you are now trying to deallocate this memory with free()
	 * instead of ckfree(). You should pass a pointer to your own method
	 * that calls ckfree().
	 */

	cmdPtr->deleteProc(cmdPtr->deleteData);
    }

    /*
     * If this command was imported into other namespaces, then imported







|

|
|







3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
	 * created when a command was imported into a namespace, this client
	 * data will be a pointer to a ImportedCmdData structure describing
	 * the "real" command that this imported command refers to.
	 *
	 * If you are getting a crash during the call to deleteProc and
	 * cmdPtr->deleteProc is a pointer to the function free(), the most
	 * likely cause is that your extension allocated memory for the
	 * clientData argument to Tcl_CreateObjCommand with the Tcl_Alloc()
	 * macro and you are now trying to deallocate this memory with free()
	 * instead of Tcl_Free(). You should pass a pointer to your own method
	 * that calls Tcl_Free().
	 */

	cmdPtr->deleteProc(cmdPtr->deleteData);
    }

    /*
     * If this command was imported into other namespaces, then imported
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
	if (state == NULL) {
	    state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, TCL_OK);
	}
	tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr,
		oldName, newName, flags);
	cmdPtr->flags &= ~tracePtr->flags;
	if (tracePtr->refCount-- <= 1) {
	    ckfree(tracePtr);
	}
    }

    if (state) {
	Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
    }








|







3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
	if (state == NULL) {
	    state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, TCL_OK);
	}
	tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr,
		oldName, newName, flags);
	cmdPtr->flags &= ~tracePtr->flags;
	if (tracePtr->refCount-- <= 1) {
	    Tcl_Free(tracePtr);
	}
    }

    if (state) {
	Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
    }

3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444

void
TclCleanupCommand(
    register Command *cmdPtr)	/* Points to the Command structure to
				 * be freed. */
{
    if (cmdPtr->refCount-- <= 1) {
	ckfree(cmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclInterpReady --







|







3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696

void
TclCleanupCommand(
    register Command *cmdPtr)	/* Points to the Command structure to
				 * be freed. */
{
    if (cmdPtr->refCount-- <= 1) {
	Tcl_Free(cmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclInterpReady --
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
    /*
     * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
     * interp's result; otherwise, we leave it alone.
     */

    if (flags & TCL_LEAVE_ERR_MSG) {
        const char *id, *message = NULL;
        int length;

        /*
         * Setup errorCode variables so that we can differentiate between
         * being canceled and unwound.
         */

        if (iPtr->asyncCancelMsg != NULL) {







|







3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
    /*
     * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
     * interp's result; otherwise, we leave it alone.
     */

    if (flags & TCL_LEAVE_ERR_MSG) {
        const char *id, *message = NULL;
        size_t length;

        /*
         * Setup errorCode variables so that we can differentiate between
         * being canceled and unwound.
         */

        if (iPtr->asyncCancelMsg != NULL) {
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    if (resultObjPtr != NULL) {
	result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
	cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }
    cancelInfo->clientData = clientData;







|







3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    if (resultObjPtr != NULL) {
	result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
	cancelInfo->result = Tcl_Realloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }
    cancelInfo->clientData = clientData;
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;
    const char *cmdString;
    int cmdLen;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = data[1];

    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)){
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the







|







4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;
    const char *cmdString;
    size_t cmdLen;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = data[1];

    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)){
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
     * to hold both the handler prefix and all words of the command invokation
     * itself.
     */

    Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
	    &handlerObjc, &handlerObjv);
    newObjc = objc + handlerObjc;
    newObjv = TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * newObjc);

    /*
     * Copy command prefix from unknown handler and add on the real command's
     * full argument list. Note that we only use memcpy() once because we have
     * to increment the reference count of all the handler arguments anyway.
     */








|







4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
     * to hold both the handler prefix and all words of the command invokation
     * itself.
     */

    Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
	    &handlerObjc, &handlerObjv);
    newObjc = objc + handlerObjc;
    newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);

    /*
     * Copy command prefix from unknown handler and add on the real command's
     * full argument list. Note that we only use memcpy() once because we have
     * to increment the reference count of all the handler arguments anyway.
     */

4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
    Command **cmdPtrPtr,
    Tcl_Obj *commandPtr,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
    size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int length, traceCode = TCL_OK;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the
     * traces so that the structure doesn't go away underneath our feet.







|
|







4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
    Command **cmdPtrPtr,
    Tcl_Obj *commandPtr,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
    size_t length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int traceCode = TCL_OK;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the
     * traces so that the structure doesn't go away underneath our feet.
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
{
    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = data[1];
    Command *cmdPtr = data[2];
    Tcl_Obj **objv = data[3];
    int length;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}







|







4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
{
    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = data[1];
    Command *cmdPtr = data[2];
    Tcl_Obj **objv = data[3];
    size_t length;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
int
Tcl_EvalTokensStandard(
    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
				 * execute nested commands, and report
				 * errors. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
				 * evaluate and concatenate. */
    int count)			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
{
    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
	    NULL, NULL);
}

/*







|







4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
int
Tcl_EvalTokensStandard(
    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
				 * execute nested commands, and report
				 * errors. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
				 * evaluate and concatenate. */
    size_t count)			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
{
    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
	    NULL, NULL);
}

/*
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
 */

int
Tcl_EvalEx(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * script. Also used for error reporting. */
    const char *script,		/* First character of script to evaluate. */
    int numBytes,		/* Number of bytes in script. If < 0, the
				 * script consists of all bytes up to the
				 * first null character. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
{
    return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
}

int
TclEvalEx(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * script. Also used for error reporting. */
    const char *script,		/* First character of script to evaluate. */
    int numBytes,		/* Number of bytes in script. If < 0, the
				 * script consists of all bytes up to the
				 * first NUL character. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
    int line,			/* The line the script starts on. */
    int *clNextOuter,		/* Information about an outer context for */







|














|







4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
 */

int
Tcl_EvalEx(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * script. Also used for error reporting. */
    const char *script,		/* First character of script to evaluate. */
    size_t numBytes,		/* Number of bytes in script. If -1, the
				 * script consists of all bytes up to the
				 * first null character. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
{
    return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
}

int
TclEvalEx(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * script. Also used for error reporting. */
    const char *script,		/* First character of script to evaluate. */
    size_t numBytes,		/* Number of bytes in script. If -1, the
				 * script consists of all bytes up to the
				 * first NUL character. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
    int line,			/* The line the script starts on. */
    int *clNextOuter,		/* Information about an outer context for */
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
	if (clNextOuter) {
	    clNext = clNextOuter;
	} else {
	    clNext = &iPtr->scriptCLLocPtr->loc[0];
	}
    }

    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);

    savedVarFramePtr = iPtr->varFramePtr;
    if (flags & TCL_EVAL_GLOBAL) {
	iPtr->varFramePtr = iPtr->rootFramePtr;







|







4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
	if (clNextOuter) {
	    clNext = clNextOuter;
	} else {
	    clNext = &iPtr->scriptCLLocPtr->loc[0];
	}
    }

    if (numBytes == TCL_AUTO_LENGTH) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);

    savedVarFramePtr = iPtr->varFramePtr;
    if (flags & TCL_EVAL_GLOBAL) {
	iPtr->varFramePtr = iPtr->rootFramePtr;
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
	    unsigned int numWords = parsePtr->numWords;

	    /*
	     * Generate an array of objects for the words of the command.
	     */

	    if (numWords > minObjs) {
		expand =    ckalloc(numWords * sizeof(int));
		objvSpace = ckalloc(numWords * sizeof(Tcl_Obj *));
		lineSpace = ckalloc(numWords * sizeof(int));
	    }
	    expandRequested = 0;
	    objv = objvSpace;
	    lines = lineSpace;

	    iPtr->cmdFramePtr = eeFramePtr->nextPtr;
	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;







|
|
|







4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
	    unsigned int numWords = parsePtr->numWords;

	    /*
	     * Generate an array of objects for the words of the command.
	     */

	    if (numWords > minObjs) {
		expand =    Tcl_Alloc(numWords * sizeof(int));
		objvSpace = Tcl_Alloc(numWords * sizeof(Tcl_Obj *));
		lineSpace = Tcl_Alloc(numWords * sizeof(int));
	    }
	    expandRequested = 0;
	    objv = objvSpace;
	    lines = lineSpace;

	    iPtr->cmdFramePtr = eeFramePtr->nextPtr;
	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
		Tcl_Obj **copy = objvSpace;
		int *lcopy = lineSpace;
		int wordIdx = numWords;
		int objIdx = objectsNeeded - 1;

		if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
		    objv = objvSpace =
			    ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
		    lines = lineSpace = ckalloc(objectsNeeded * sizeof(int));
		}

		objectsUsed = 0;
		while (wordIdx--) {
		    if (expand[wordIdx]) {
			int numElements;
			Tcl_Obj **elements, *temp = copy[wordIdx];







|
|







5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
		Tcl_Obj **copy = objvSpace;
		int *lcopy = lineSpace;
		int wordIdx = numWords;
		int objIdx = objectsNeeded - 1;

		if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
		    objv = objvSpace =
			    Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *));
		    lines = lineSpace = Tcl_Alloc(objectsNeeded * sizeof(int));
		}

		objectsUsed = 0;
		while (wordIdx--) {
		    if (expand[wordIdx]) {
			int numElements;
			Tcl_Obj **elements, *temp = copy[wordIdx];
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
			objv[objIdx--] = copy[wordIdx];
			objectsUsed++;
		    }
		}
		objv += objIdx+1;

		if (copy != stackObjArray) {
		    ckfree(copy);
		}
		if (lcopy != linesStack) {
		    ckfree(lcopy);
		}
	    }

	    /*
	     * Execute the command and free the objects for its words.
	     *
	     * TIP #280: Remember the command itself for 'info frame'. We







|


|







5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
			objv[objIdx--] = copy[wordIdx];
			objectsUsed++;
		    }
		}
		objv += objIdx+1;

		if (copy != stackObjArray) {
		    Tcl_Free(copy);
		}
		if (lcopy != linesStack) {
		    Tcl_Free(lcopy);
		}
	    }

	    /*
	     * Execute the command and free the objects for its words.
	     *
	     * TIP #280: Remember the command itself for 'info frame'. We
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
		goto error;
	    }
	    for (i = 0; i < objectsUsed; i++) {
		Tcl_DecrRefCount(objv[i]);
	    }
	    objectsUsed = 0;
	    if (objvSpace != stackObjArray) {
		ckfree(objvSpace);
		objvSpace = stackObjArray;
		ckfree(lineSpace);
		lineSpace = linesStack;
	    }

	    /*
	     * Free expand separately since objvSpace could have been
	     * reallocated above.
	     */

	    if (expand != expandStack) {
		ckfree(expand);
		expand = expandStack;
	    }
	}

	/*
	 * Advance to the next command in the script.
	 *







|

|









|







5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
		goto error;
	    }
	    for (i = 0; i < objectsUsed; i++) {
		Tcl_DecrRefCount(objv[i]);
	    }
	    objectsUsed = 0;
	    if (objvSpace != stackObjArray) {
		Tcl_Free(objvSpace);
		objvSpace = stackObjArray;
		Tcl_Free(lineSpace);
		lineSpace = linesStack;
	    }

	    /*
	     * Free expand separately since objvSpace could have been
	     * reallocated above.
	     */

	    if (expand != expandStack) {
		Tcl_Free(expand);
		expand = expandStack;
	    }
	}

	/*
	 * Advance to the next command in the script.
	 *
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
    for (i = 0; i < objectsUsed; i++) {
	Tcl_DecrRefCount(objv[i]);
    }
    if (gotParse) {
	Tcl_FreeParse(parsePtr);
    }
    if (objvSpace != stackObjArray) {
	ckfree(objvSpace);
	ckfree(lineSpace);
    }
    if (expand != expandStack) {
	ckfree(expand);
    }
    iPtr->varFramePtr = savedVarFramePtr;

 cleanup_return:
    /*
     * TIP #280. Release the local CmdFrame, and its contents.
     */







|
|


|







5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
    for (i = 0; i < objectsUsed; i++) {
	Tcl_DecrRefCount(objv[i]);
    }
    if (gotParse) {
	Tcl_FreeParse(parsePtr);
    }
    if (objvSpace != stackObjArray) {
	Tcl_Free(objvSpace);
	Tcl_Free(lineSpace);
    }
    if (expand != expandStack) {
	Tcl_Free(expand);
    }
    iPtr->varFramePtr = savedVarFramePtr;

 cleanup_return:
    /*
     * TIP #280. Release the local CmdFrame, and its contents.
     */
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
	hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &new);
	if (new) {
	    /*
	     * The word is not on the stack yet, remember the current location
	     * and initialize references.
	     */

	    cfwPtr = ckalloc(sizeof(CFWord));
	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->word = i;
	    cfwPtr->refCount = 1;
	    Tcl_SetHashValue(hPtr, cfwPtr);
	} else {
	    /*
	     * The word is already on the stack, its current location is not







|







5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
	hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &new);
	if (new) {
	    /*
	     * The word is not on the stack yet, remember the current location
	     * and initialize references.
	     */

	    cfwPtr = Tcl_Alloc(sizeof(CFWord));
	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->word = i;
	    cfwPtr->refCount = 1;
	    Tcl_SetHashValue(hPtr, cfwPtr);
	} else {
	    /*
	     * The word is already on the stack, its current location is not
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
	}
	cfwPtr = Tcl_GetHashValue(hPtr);

	if (cfwPtr->refCount-- > 1) {
	    continue;
	}

	ckfree(cfwPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *







|







5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
	}
	cfwPtr = Tcl_GetHashValue(hPtr);

	if (cfwPtr->refCount-- > 1) {
	    continue;
	}

	Tcl_Free(cfwPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
TclArgumentBCEnter(
    Tcl_Interp *interp,
    Tcl_Obj *objv[],
    int objc,
    void *codePtr,
    CmdFrame *cfPtr,
    int cmd,
    int pc)
{
    ExtCmdLoc *eclPtr;
    int word;
    ECL *ePtr;
    CFWordBC *lastPtr = NULL;
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hePtr =







|







5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
TclArgumentBCEnter(
    Tcl_Interp *interp,
    Tcl_Obj *objv[],
    int objc,
    void *codePtr,
    CmdFrame *cfPtr,
    int cmd,
    size_t pc)
{
    ExtCmdLoc *eclPtr;
    int word;
    ECL *ePtr;
    CFWordBC *lastPtr = NULL;
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hePtr =
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
     */

    for (word = 1; word < objc; word++) {
	if (ePtr->line[word] >= 0) {
	    int isnew;
	    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr,
		objv[word], &isnew);
	    CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC));

	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->obj = objv[word];
	    cfwPtr->pc = pc;
	    cfwPtr->word = word;
	    cfwPtr->nextPtr = lastPtr;
	    lastPtr = cfwPtr;







|







5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
     */

    for (word = 1; word < objc; word++) {
	if (ePtr->line[word] >= 0) {
	    int isnew;
	    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr,
		objv[word], &isnew);
	    CFWordBC *cfwPtr = Tcl_Alloc(sizeof(CFWordBC));

	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->obj = objv[word];
	    cfwPtr->pc = pc;
	    cfwPtr->word = word;
	    cfwPtr->nextPtr = lastPtr;
	    lastPtr = cfwPtr;
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367

	if (cfwPtr->prevPtr) {
	    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
	} else {
	    Tcl_DeleteHashEntry(hPtr);
	}

	ckfree(cfwPtr);
	cfwPtr = nextPtr;
    }

    cfPtr->litarg = NULL;
}

/*







|







5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619

	if (cfwPtr->prevPtr) {
	    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
	} else {
	    Tcl_DeleteHashEntry(hPtr);
	}

	Tcl_Free(cfwPtr);
	cfwPtr = nextPtr;
    }

    cfPtr->litarg = NULL;
}

/*
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
	/*
	 * We're not supposed to use the compiler or byte-code
	 * interpreter. Let Tcl_EvalEx evaluate the command directly (and
	 * probably more slowly).
	 */

	const char *script;
	int numSrcBytes;

	/*
	 * Now we check if we have data about invisible continuation lines for
	 * the script, and make it available to the direct script parser and
	 * evaluator we are about to call, if so.
	 *
	 * It may be possible that the script Tcl_Obj* can be free'd while the







|







5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
	/*
	 * We're not supposed to use the compiler or byte-code
	 * interpreter. Let Tcl_EvalEx evaluate the command directly (and
	 * probably more slowly).
	 */

	const char *script;
	size_t numSrcBytes;

	/*
	 * Now we check if we have data about invisible continuation lines for
	 * the script, and make it available to the direct script parser and
	 * evaluator we are about to call, if so.
	 *
	 * It may be possible that the script Tcl_Obj* can be free'd while the
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693

    if (iPtr->numLevels == 0) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    const char *script;
	    int numSrcBytes;

	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	    script = TclGetStringFromObj(objPtr, &numSrcBytes);
	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	}








|







5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945

    if (iPtr->numLevels == 0) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    const char *script;
	    size_t numSrcBytes;

	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	    script = TclGetStringFromObj(objPtr, &numSrcBytes);
	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	}

5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
	Tcl_DecrRefCount(resultPtr);
	if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
	    return TCL_ERROR;
	}
	resultPtr = Tcl_NewBignumObj(&big);
	/* FALLTHROUGH */
    }
    case TCL_NUMBER_WIDE:
    case TCL_NUMBER_BIG:
	result = TclGetLongFromObj(interp, resultPtr, ptr);
	break;

    case TCL_NUMBER_NAN:
	Tcl_GetDoubleFromObj(interp, resultPtr, &d);
	result = TCL_ERROR;







|







6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191
6192
	Tcl_DecrRefCount(resultPtr);
	if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
	    return TCL_ERROR;
	}
	resultPtr = Tcl_NewBignumObj(&big);
	/* FALLTHROUGH */
    }
    case TCL_NUMBER_INT:
    case TCL_NUMBER_BIG:
	result = TclGetLongFromObj(interp, resultPtr, ptr);
	break;

    case TCL_NUMBER_NAN:
	Tcl_GetDoubleFromObj(interp, resultPtr, &d);
	result = TCL_ERROR;
6209
6210
6211
6212
6213
6214
6215

6216
6217
6218
6219
6220
6221
6222
6223

void
Tcl_AppendObjToErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{

    const char *message = TclGetString(objPtr);
    register Interp *iPtr = (Interp *) interp;

    Tcl_IncrRefCount(objPtr);

    /*
     * If we are just starting to log an error, errorInfo is initialized from
     * the error message in the interpreter's result.







>
|







6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476

void
Tcl_AppendObjToErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{
    size_t length;
    const char *message = TclGetStringFromObj(objPtr, &length);
    register Interp *iPtr = (Interp *) interp;

    Tcl_IncrRefCount(objPtr);

    /*
     * If we are just starting to log an error, errorInfo is initialized from
     * the error message in the interpreter's result.
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
	}
    }

    /*
     * Now append "message" to the end of errorInfo.
     */

    if (objPtr->length != 0) {
	if (Tcl_IsShared(iPtr->errorInfo)) {
	    Tcl_DecrRefCount(iPtr->errorInfo);
	    iPtr->errorInfo = Tcl_DuplicateObj(iPtr->errorInfo);
	    Tcl_IncrRefCount(iPtr->errorInfo);
	}
	Tcl_AppendToObj(iPtr->errorInfo, message, objPtr->length);
    }
    Tcl_DecrRefCount(objPtr);
}

/*
 *----------------------------------------------------------------------
 *







|





|







6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504
6505
	}
    }

    /*
     * Now append "message" to the end of errorInfo.
     */

    if (length != 0) {
	if (Tcl_IsShared(iPtr->errorInfo)) {
	    Tcl_DecrRefCount(iPtr->errorInfo);
	    iPtr->errorInfo = Tcl_DuplicateObj(iPtr->errorInfo);
	    Tcl_IncrRefCount(iPtr->errorInfo);
	}
	Tcl_AppendToObj(iPtr->errorInfo, message, length);
    }
    Tcl_DecrRefCount(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_WIDE) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > (Tcl_WideInt)0) {
	    goto unChanged;
	} else if (l == (Tcl_WideInt)0) {
	    const char *string = objv[1]->bytes;
	    if (string) {
		while (*string != '0') {
		    if (*string == '-') {
			Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
			return TCL_OK;
		    }
		    string++;
		}
	    }
	    goto unChanged;
	} else if (l == LLONG_MIN) {
	    TclInitBignumFromWideInt(&big, l);
	    goto tooLarge;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l));
	return TCL_OK;
    }








|
















|







6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_INT) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > (Tcl_WideInt)0) {
	    goto unChanged;
	} else if (l == (Tcl_WideInt)0) {
	    const char *string = objv[1]->bytes;
	    if (string) {
		while (*string != '0') {
		    if (*string == '-') {
			Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
			return TCL_OK;
		    }
		    string++;
		}
	    }
	    goto unChanged;
	} else if (l == WIDE_MIN) {
	    TclInitBignumFromWideInt(&big, l);
	    goto tooLarge;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l));
	return TCL_OK;
    }

6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
6854
6855
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
    return TCL_OK;
}

static int
ExprEntierFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    double d;
    int type;
    ClientData ptr;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_DOUBLE) {
	d = *((const double *) ptr);
	if ((d >= (double)LLONG_MAX) || (d <= (double)LLONG_MIN)) {
	    mp_int big;

	    if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
		/* Infinity */
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));







|




















|







7073
7074
7075
7076
7077
7078
7079
7080
7081
7082
7083
7084
7085
7086
7087
7088
7089
7090
7091
7092
7093
7094
7095
7096
7097
7098
7099
7100
7101
7102
7103
7104
7105
7106
7107
7108
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
    return TCL_OK;
}

static int
ExprIntFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    double d;
    int type;
    ClientData ptr;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_DOUBLE) {
	d = *((const double *) ptr);
	if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) {
	    mp_int big;

	    if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
		/* Infinity */
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
6875
6876
6877
6878
6879
6880
6881
6882
6883
6884
6885
6886
6887
6888
6889
6890
6891
6892
6893
6894
6895
6896
6897
6898
6899
6900
6901
6902
6903
6904
6905
6906
6907
6908
6909
6910
6911
6912
6913
6914
6915
6916
6917
6918
6919
6920
6921
6922
6923
6924
6925
6926
6927
6928
6929
6930
6931
6932
6933
6934
6935
6936
6937
6938
6939
6940
6941
6942
6943
6944
6945
6946
6947
6948
6949
     * Get the error message for NaN.
     */

    Tcl_GetDoubleFromObj(interp, objv[1], &d);
    return TCL_ERROR;
}

static int
ExprIntFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    long iResult;
    Tcl_Obj *objPtr;
    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }
    objPtr = Tcl_GetObjResult(interp);
    if (TclGetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) {
	/*
	 * Truncate the bignum; keep only bits in long range.
	 */

	mp_int big;

	Tcl_GetBignumFromObj(NULL, objPtr, &big);
	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
	objPtr = Tcl_NewBignumObj(&big);
	Tcl_IncrRefCount(objPtr);
	TclGetLongFromObj(NULL, objPtr, &iResult);
	Tcl_DecrRefCount(objPtr);
    }
    Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult));
    return TCL_OK;
}

static int
ExprWideFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    Tcl_WideInt wResult;
    Tcl_Obj *objPtr;

    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }
    objPtr = Tcl_GetObjResult(interp);
    if (TclGetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
	/*
	 * Truncate the bignum; keep only bits in wide int range.
	 */

	mp_int big;

	Tcl_GetBignumFromObj(NULL, objPtr, &big);
	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
	objPtr = Tcl_NewBignumObj(&big);
	Tcl_IncrRefCount(objPtr);
	TclGetWideIntFromObj(NULL, objPtr, &wResult);
	Tcl_DecrRefCount(objPtr);
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
    return TCL_OK;
}

/*
 * Common implmentation of max() and min().
 */







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<









<

|


|
<
<
<
<
<
<
<
<
<
<
<
<
<
<







7128
7129
7130
7131
7132
7133
7134
































7135
7136
7137
7138
7139
7140
7141
7142
7143

7144
7145
7146
7147
7148














7149
7150
7151
7152
7153
7154
7155
     * Get the error message for NaN.
     */

    Tcl_GetDoubleFromObj(interp, objv[1], &d);
    return TCL_ERROR;
}

































static int
ExprWideFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    Tcl_WideInt wResult;


    if (ExprIntFunc(NULL, interp, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }
    TclGetWideBitsFromObj(NULL, Tcl_GetObjResult(interp), &wResult);














    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
    return TCL_OK;
}

/*
 * Common implmentation of max() and min().
 */
7038
7039
7040
7041
7042
7043
7044
7045
7046
7047
7048
7049
7050
7051
7052

	iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);

	/*
	 * Make sure 1 <= randSeed <= (2^31) - 2. See below.
	 */

	iPtr->randSeed &= (unsigned long) 0x7fffffff;
	if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
	    iPtr->randSeed ^= 123459876;
	}
    }

    /*
     * Generate the random number using the linear congruential generator







|







7244
7245
7246
7247
7248
7249
7250
7251
7252
7253
7254
7255
7256
7257
7258

	iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);

	/*
	 * Make sure 1 <= randSeed <= (2^31) - 2. See below.
	 */

	iPtr->randSeed &= 0x7fffffff;
	if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
	    iPtr->randSeed ^= 123459876;
	}
    }

    /*
     * Generate the random number using the linear congruential generator
7182
7183
7184
7185
7186
7187
7188
7189
7190
7191
7192
7193
7194
7195
7196
7197
7198
7199
7200
7201
7202
7203
7204
7205
7206
7207
7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
7220
7221
7222
7223
7224
7225
7226
7227
7228
7229
7230
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    Interp *iPtr = (Interp *) interp;
    long i = 0;			/* Initialized to avoid compiler warning. */

    /*
     * Convert argument and use it to reset the seed.
     */

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetLongFromObj(NULL, objv[1], &i) != TCL_OK) {
	Tcl_Obj *objPtr;
	mp_int big;

	if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
	    /* TODO: more ::errorInfo here? or in caller? */
	    return TCL_ERROR;
	}

	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
	objPtr = Tcl_NewBignumObj(&big);
	Tcl_IncrRefCount(objPtr);
	TclGetLongFromObj(NULL, objPtr, &i);
	Tcl_DecrRefCount(objPtr);
    }

    /*
     * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in
     * ExprRandFunc for more details.
     */

    iPtr->flags |= RAND_SEED_INITIALIZED;
    iPtr->randSeed = i;
    iPtr->randSeed &= (unsigned long) 0x7fffffff;
    if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
	iPtr->randSeed ^= 123459876;
    }

    /*
     * To avoid duplicating the random number generation code we simply clean
     * up our state and call the real random number function. That function







|










|
<
<
<
<
<
|
<
<
<
<
<
<
<








|
<







7388
7389
7390
7391
7392
7393
7394
7395
7396
7397
7398
7399
7400
7401
7402
7403
7404
7405
7406





7407







7408
7409
7410
7411
7412
7413
7414
7415
7416

7417
7418
7419
7420
7421
7422
7423
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_WideInt w = 0;			/* Initialized to avoid compiler warning. */

    /*
     * Convert argument and use it to reset the seed.
     */

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetWideBitsFromObj(NULL, objv[1], &w) != TCL_OK) {





	return TCL_ERROR;







    }

    /*
     * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in
     * ExprRandFunc for more details.
     */

    iPtr->flags |= RAND_SEED_INITIALIZED;
    iPtr->randSeed = (long) w & 0x7fffffff;

    if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
	iPtr->randSeed ^= 123459876;
    }

    /*
     * To avoid duplicating the random number generation code we simply clean
     * up our state and call the real random number function. That function
7970
7971
7972
7973
7974
7975
7976
7977
7978
7979
7980
7981
7982
7983
7984
	 * The execEnv was wound down but not deleted for our sake. We finish
	 * the job here. The caller context has already been restored.
	 */

	NRE_ASSERT(iPtr->varFramePtr == corPtr->caller.varFramePtr);
	NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr);
	NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr);
	ckfree(corPtr);
	return result;
    }

    NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);








|







8163
8164
8165
8166
8167
8168
8169
8170
8171
8172
8173
8174
8175
8176
8177
	 * The execEnv was wound down but not deleted for our sake. We finish
	 * the job here. The caller context has already been restored.
	 */

	NRE_ASSERT(iPtr->varFramePtr == corPtr->caller.varFramePtr);
	NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr);
	NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr);
	Tcl_Free(corPtr);
	return result;
    }

    NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);

8029
8030
8031
8032
8033
8034
8035
8036
8037
8038
8039
8040
8041
8042
8043
    /*
     * #280.
     * Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal
     * command arguments in bytecode.
     */

    Tcl_DeleteHashTable(corPtr->lineLABCPtr);
    ckfree(corPtr->lineLABCPtr);
    corPtr->lineLABCPtr = NULL;

    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;
    iPtr->numLevels++;

    return result;







|







8222
8223
8224
8225
8226
8227
8228
8229
8230
8231
8232
8233
8234
8235
8236
    /*
     * #280.
     * Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal
     * command arguments in bytecode.
     */

    Tcl_DeleteHashTable(corPtr->lineLABCPtr);
    Tcl_Free(corPtr->lineLABCPtr);
    corPtr->lineLABCPtr = NULL;

    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;
    iPtr->numLevels++;

    return result;
8321
8322
8323
8324
8325
8326
8327
8328
8329
8330
8331
8332
8333
8334
8335
    }

    /*
     * We ARE creating the coroutine command: allocate the corresponding
     * struct and create the corresponding command.
     */

    corPtr = ckalloc(sizeof(CoroutineData));

    cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName,
	    (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine,
	    corPtr, DeleteCoroutine);

    corPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;







|







8514
8515
8516
8517
8518
8519
8520
8521
8522
8523
8524
8525
8526
8527
8528
    }

    /*
     * We ARE creating the coroutine command: allocate the corresponding
     * struct and create the corresponding command.
     */

    corPtr = Tcl_Alloc(sizeof(CoroutineData));

    cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName,
	    (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine,
	    corPtr, DeleteCoroutine);

    corPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;
8343
8344
8345
8346
8347
8348
8349
8350
8351
8352
8353
8354
8355
8356
8357
     * tree. Like the chain -> tree conversion of the CmdFrame stack.
     */

    {
	Tcl_HashSearch hSearch;
	Tcl_HashEntry *hePtr;

	corPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);

	for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
		hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) {
	    int isNew;
	    Tcl_HashEntry *newPtr =
		    Tcl_CreateHashEntry(corPtr->lineLABCPtr,







|







8536
8537
8538
8539
8540
8541
8542
8543
8544
8545
8546
8547
8548
8549
8550
     * tree. Like the chain -> tree conversion of the CmdFrame stack.
     */

    {
	Tcl_HashSearch hSearch;
	Tcl_HashEntry *hePtr;

	corPtr->lineLABCPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);

	for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
		hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) {
	    int isNew;
	    Tcl_HashEntry *newPtr =
		    Tcl_CreateHashEntry(corPtr->lineLABCPtr,
Changes to generic/tclBinary.c.
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
 * The following structure is the internal rep for a ByteArray object. Keeps
 * track of how much memory has been used and how much has been allocated for
 * the byte array to enable growing and shrinking of the ByteArray object with
 * fewer mallocs.
 */

typedef struct {
    int used;			/* The number of bytes used in the byte
				 * array. */
    int allocated;		/* The amount of space actually allocated
				 * minus 1 byte. */
    unsigned char bytes[1];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_SIZE(len) \
		((unsigned) (TclOffset(ByteArray, bytes) + (len)))
#define GET_BYTEARRAY(objPtr) \
		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_BYTEARRAY(objPtr, baPtr) \
		(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)

int
TclIsPureByteArray(







|

|







|







264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
 * The following structure is the internal rep for a ByteArray object. Keeps
 * track of how much memory has been used and how much has been allocated for
 * the byte array to enable growing and shrinking of the ByteArray object with
 * fewer mallocs.
 */

typedef struct {
    size_t used;		/* The number of bytes used in the byte
				 * array. */
    size_t allocated;		/* The amount of space actually allocated
				 * minus 1 byte. */
    unsigned char bytes[1];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_SIZE(len) \
		((TclOffset(ByteArray, bytes) + (len)))
#define GET_BYTEARRAY(objPtr) \
		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_BYTEARRAY(objPtr, baPtr) \
		(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)

int
TclIsPureByteArray(
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326

#undef Tcl_NewByteArrayObj

Tcl_Obj *
Tcl_NewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    int length)			/* Length of the array of bytes, which must be
				 * >= 0. */
{
#ifdef TCL_MEM_DEBUG
    return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
#else /* if not TCL_MEM_DEBUG */
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);







|
<







311
312
313
314
315
316
317
318

319
320
321
322
323
324
325

#undef Tcl_NewByteArrayObj

Tcl_Obj *
Tcl_NewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    size_t length)		/* Length of the array of bytes */

{
#ifdef TCL_MEM_DEBUG
    return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
#else /* if not TCL_MEM_DEBUG */
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_DbNewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    int length,			/* Length of the array of bytes, which must be
				 * >= 0. */
    const char *file,		/* The name of the source file calling this
				 * procedure; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
#ifdef TCL_MEM_DEBUG
    Tcl_Obj *objPtr;







|
<







353
354
355
356
357
358
359
360

361
362
363
364
365
366
367
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_DbNewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    size_t length,		/* Length of the array of bytes. */

    const char *file,		/* The name of the source file calling this
				 * procedure; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
#ifdef TCL_MEM_DEBUG
    Tcl_Obj *objPtr;
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
 */

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new
				   value. May be NULL even if length > 0. */
    int length)			/* Length of the array of bytes, which must
				   be >= 0. */
{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclFreeIntRep(objPtr);
    TclInvalidateStringRep(objPtr);

    if (length < 0) {
	length = 0;
    }
    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if ((bytes != NULL) && (length > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
    }
    objPtr->typePtr = &properByteArrayType;
    SET_BYTEARRAY(objPtr, byteArrayPtr);
}

/*
 *----------------------------------------------------------------------







|










<
<
<
|




|







393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410



411
412
413
414
415
416
417
418
419
420
421
422
423
 */

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new
				   value. May be NULL even if length > 0. */
    size_t length)			/* Length of the array of bytes, which must
				   be >= 0. */
{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclFreeIntRep(objPtr);
    TclInvalidateStringRep(objPtr);




    byteArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if ((bytes != NULL) && (length > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, length);
    }
    objPtr->typePtr = &properByteArrayType;
    SET_BYTEARRAY(objPtr, byteArrayPtr);
}

/*
 *----------------------------------------------------------------------
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
 *
 *----------------------------------------------------------------------
 */

unsigned char *
Tcl_SetByteArrayLength(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    int length)			/* New length for internal byte array. */
{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
    }
    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }

    byteArrayPtr = GET_BYTEARRAY(objPtr);
    if (length > byteArrayPtr->allocated) {
	byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
	byteArrayPtr->allocated = length;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }
    TclInvalidateStringRep(objPtr);
    byteArrayPtr->used = length;
    return byteArrayPtr->bytes;
}







|













|







478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
 *
 *----------------------------------------------------------------------
 */

unsigned char *
Tcl_SetByteArrayLength(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    size_t length)			/* New length for internal byte array. */
{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
    }
    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }

    byteArrayPtr = GET_BYTEARRAY(objPtr);
    if (length > byteArrayPtr->allocated) {
	byteArrayPtr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(length));
	byteArrayPtr->allocated = length;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }
    TclInvalidateStringRep(objPtr);
    byteArrayPtr->used = length;
    return byteArrayPtr->bytes;
}
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
	return TCL_OK;
    }

    src = TclGetString(objPtr);
    length = objPtr->length;
    srcEnd = src + length;

    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
	src += TclUtfToUniChar(src, &ch);
	improper = improper || (ch > 255);
	*dst++ = UCHAR(ch);
    }

    byteArrayPtr->used = dst - byteArrayPtr->bytes;







|







540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
	return TCL_OK;
    }

    src = TclGetString(objPtr);
    length = objPtr->length;
    srcEnd = src + length;

    byteArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length));
    for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
	src += TclUtfToUniChar(src, &ch);
	improper = improper || (ch > 255);
	*dst++ = UCHAR(ch);
    }

    byteArrayPtr->used = dst - byteArrayPtr->bytes;
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
 *----------------------------------------------------------------------
 */

static void
FreeByteArrayInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    ckfree(GET_BYTEARRAY(objPtr));
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupByteArrayInternalRep --







|







577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
 *----------------------------------------------------------------------
 */

static void
FreeByteArrayInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    Tcl_Free(GET_BYTEARRAY(objPtr));
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupByteArrayInternalRep --
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
 */

static void
DupByteArrayInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    int length;
    ByteArray *srcArrayPtr, *copyArrayPtr;

    srcArrayPtr = GET_BYTEARRAY(srcPtr);
    length = srcArrayPtr->used;

    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
    SET_BYTEARRAY(copyPtr, copyArrayPtr);

    copyPtr->typePtr = srcPtr->typePtr;
}

/*
 *----------------------------------------------------------------------







|





|


|







603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
 */

static void
DupByteArrayInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    size_t length;
    ByteArray *srcArrayPtr, *copyArrayPtr;

    srcArrayPtr = GET_BYTEARRAY(srcPtr);
    length = srcArrayPtr->used;

    copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);
    SET_BYTEARRAY(copyPtr, copyArrayPtr);

    copyPtr->typePtr = srcPtr->typePtr;
}

/*
 *----------------------------------------------------------------------
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
 */

static void
UpdateStringOfByteArray(
    Tcl_Obj *objPtr)		/* ByteArray object whose string rep to
				 * update. */
{
    int i, length, size;
    unsigned char *src;
    char *dst;
    ByteArray *byteArrayPtr;

    byteArrayPtr = GET_BYTEARRAY(objPtr);
    src = byteArrayPtr->bytes;
    length = byteArrayPtr->used;

    /*
     * How much space will string rep need?
     */

    size = length;
    for (i = 0; i < length && size >= 0; i++) {
	if ((src[i] == 0) || (src[i] > 127)) {
	    size++;
	}
    }
    if (size < 0) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    dst = ckalloc(size + 1);
    objPtr->bytes = dst;
    objPtr->length = size;

    if (size == length) {
	memcpy(dst, src, (size_t) size);
	dst[size] = '\0';
    } else {
	for (i = 0; i < length; i++) {
	    dst += Tcl_UniCharToUtf(src[i], dst);
	}
	*dst = '\0';
    }







|













|




|
|


|




|







645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
 */

static void
UpdateStringOfByteArray(
    Tcl_Obj *objPtr)		/* ByteArray object whose string rep to
				 * update. */
{
    size_t i, length, size;
    unsigned char *src;
    char *dst;
    ByteArray *byteArrayPtr;

    byteArrayPtr = GET_BYTEARRAY(objPtr);
    src = byteArrayPtr->bytes;
    length = byteArrayPtr->used;

    /*
     * How much space will string rep need?
     */

    size = length;
    for (i = 0; (i < length) && (size != TCL_AUTO_LENGTH); i++) {
	if ((src[i] == 0) || (src[i] > 127)) {
	    size++;
	}
    }
    if (size == TCL_AUTO_LENGTH) {
	Tcl_Panic("max size for a Tcl value exceeded");
    }

    dst = Tcl_Alloc(size + 1);
    objPtr->bytes = dst;
    objPtr->length = size;

    if (size == length) {
	memcpy(dst, src, size);
	dst[size] = '\0';
    } else {
	for (i = 0; i < length; i++) {
	    dst += Tcl_UniCharToUtf(src[i], dst);
	}
	*dst = '\0';
    }
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
 *----------------------------------------------------------------------
 */

void
TclAppendBytesToByteArray(
    Tcl_Obj *objPtr,
    const unsigned char *bytes,
    int len)
{
    ByteArray *byteArrayPtr;
    int needed;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    if (len < 0) {
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
    }
    if (len == 0) {
	/* Append zero bytes is a no-op. */
	return;
    }
    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    byteArrayPtr = GET_BYTEARRAY(objPtr);

    if (len > INT_MAX - byteArrayPtr->used) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    needed = byteArrayPtr->used + len;
    /*
     * If we need to, resize the allocated space in the byte array.
     */

    if (needed > byteArrayPtr->allocated) {
	ByteArray *ptr = NULL;
	int attempt;

	if (needed <= INT_MAX/2) {
	    /* Try to allocate double the total space that is needed. */
	    attempt = 2 * needed;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /* Try to allocate double the increment that is needed (plus). */
	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = len + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /* Last chance: Try to allocate exactly what is needed. */
	    attempt = needed;
	    ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }

    if (bytes) {







|


|




|













|
|









|




|



|
|
|


|




|







706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
 *----------------------------------------------------------------------
 */

void
TclAppendBytesToByteArray(
    Tcl_Obj *objPtr,
    const unsigned char *bytes,
    size_t len)
{
    ByteArray *byteArrayPtr;
    size_t needed;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    if (len == TCL_AUTO_LENGTH) {
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
    }
    if (len == 0) {
	/* Append zero bytes is a no-op. */
	return;
    }
    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    byteArrayPtr = GET_BYTEARRAY(objPtr);

    if (len + byteArrayPtr->used > UINT_MAX) {
	Tcl_Panic("max size for a Tcl value (%u bytes) exceeded", UINT_MAX);
    }

    needed = byteArrayPtr->used + len;
    /*
     * If we need to, resize the allocated space in the byte array.
     */

    if (needed > byteArrayPtr->allocated) {
	ByteArray *ptr = NULL;
	size_t attempt;

	if (needed <= INT_MAX/2) {
	    /* Try to allocate double the total space that is needed. */
	    attempt = 2 * needed;
	    ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /* Try to allocate double the increment that is needed (plus). */
	    size_t limit = INT_MAX - needed;
	    size_t extra = len + TCL_MIN_GROWTH;
	    size_t growth = (extra > limit) ? limit : extra;

	    attempt = needed + growth;
	    ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /* Last chance: Try to allocate exactly what is needed. */
	    attempt = needed;
	    ptr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }

    if (bytes) {
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
FormatNumber(
    Tcl_Interp *interp,		/* Current interpreter, used to report
				 * errors. */
    int type,			/* Type of number to format. */
    Tcl_Obj *src,		/* Number to format. */
    unsigned char **cursorPtr)	/* Pointer to index into destination buffer. */
{
    long value;
    double dvalue;
    Tcl_WideInt wvalue;
    float fvalue;

    switch (type) {
    case 'd':
    case 'q':







<







1954
1955
1956
1957
1958
1959
1960

1961
1962
1963
1964
1965
1966
1967
FormatNumber(
    Tcl_Interp *interp,		/* Current interpreter, used to report
				 * errors. */
    int type,			/* Type of number to format. */
    Tcl_Obj *src,		/* Number to format. */
    unsigned char **cursorPtr)	/* Pointer to index into destination buffer. */
{

    double dvalue;
    Tcl_WideInt wvalue;
    float fvalue;

    switch (type) {
    case 'd':
    case 'q':
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035

	/*
	 * 64-bit integer values.
	 */
    case 'w':
    case 'W':
    case 'm':
	if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);







|







2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029

	/*
	 * 64-bit integer values.
	 */
    case 'w':
    case 'W':
    case 'm':
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106

	/*
	 * 32-bit integer values.
	 */
    case 'i':
    case 'I':
    case 'n':
	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(value);
	    *(*cursorPtr)++ = UCHAR(value >> 8);
	    *(*cursorPtr)++ = UCHAR(value >> 16);
	    *(*cursorPtr)++ = UCHAR(value >> 24);
	} else {
	    *(*cursorPtr)++ = UCHAR(value >> 24);
	    *(*cursorPtr)++ = UCHAR(value >> 16);
	    *(*cursorPtr)++ = UCHAR(value >> 8);
	    *(*cursorPtr)++ = UCHAR(value);
	}
	return TCL_OK;

	/*
	 * 16-bit integer values.
	 */
    case 's':
    case 'S':
    case 't':
	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(value);
	    *(*cursorPtr)++ = UCHAR(value >> 8);
	} else {
	    *(*cursorPtr)++ = UCHAR(value >> 8);
	    *(*cursorPtr)++ = UCHAR(value);
	}
	return TCL_OK;

	/*
	 * 8-bit integer values.
	 */
    case 'c':
	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	*(*cursorPtr)++ = UCHAR(value);
	return TCL_OK;

    default:
	Tcl_Panic("unexpected fallthrough");
	return TCL_ERROR;
    }
}







|



|
|
|
|

|
|
|
|









|



|
|

|
|







|


|







2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100

	/*
	 * 32-bit integer values.
	 */
    case 'i':
    case 'I':
    case 'n':
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
	} else {
	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue);
	}
	return TCL_OK;

	/*
	 * 16-bit integer values.
	 */
    case 's':
    case 'S':
    case 't':
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	} else {
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue);
	}
	return TCL_OK;

	/*
	 * 8-bit integer values.
	 */
    case 'c':
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	    return TCL_ERROR;
	}
	*(*cursorPtr)++ = UCHAR(wvalue);
	return TCL_OK;

    default:
	Tcl_Panic("unexpected fallthrough");
	return TCL_ERROR;
    }
}
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
	for (i=0 ; i<2 ; i++) {
	    if (data >= dataend) {
		value <<= 4;
		break;
	    }

	    c = *data++;
	    if (!isxdigit((int) c)) {
		if (strict || !isspace(c)) {
		    goto badChar;
		}
		i--;
		continue;
	    }

	    value <<= 4;







|
|







2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
	for (i=0 ; i<2 ; i++) {
	    if (data >= dataend) {
		value <<= 4;
		break;
	    }

	    c = *data++;
	    if (!isxdigit(UCHAR(c))) {
		if (strict || !TclIsSpaceProc(c)) {
		    goto badChar;
		}
		i--;
		continue;
	    }

	    value <<= 4;
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

  badChar:
    TclDecrRefCount(resultObj);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid hexadecimal digit \"%c\" at position %d",
	    c, (int) (data - datastart - 1)));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * BinaryEncode64 --







|
|







2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

  badChar:
    TclDecrRefCount(resultObj);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid hexadecimal digit \"%c\" at position %" TCL_Z_MODIFIER "u",
	    c, data - datastart - 1));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * BinaryEncode64 --
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860

    while (data < dataend) {
	char d[4] = {0, 0, 0, 0};

	if (lineLen < 0) {
	    c = *data++;
	    if (c < 32 || c > 96) {
		if (strict || !isspace(c)) {
		    goto badUu;
		}
		i--;
		continue;
	    }
	    lineLen = (c - 32) & 0x3f;
	}

	/*
	 * Now we read a four-character grouping.
	 */

	for (i=0 ; i<4 ; i++) {
	    if (data < dataend) {
		d[i] = c = *data++;
		if (c < 32 || c > 96) {
		    if (strict) {
			if (!isspace(c)) {
			    goto badUu;
			} else if (c == '\n') {
			    goto shortUu;
			}
		    }
		    i--;
		    continue;







|

















|







2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854

    while (data < dataend) {
	char d[4] = {0, 0, 0, 0};

	if (lineLen < 0) {
	    c = *data++;
	    if (c < 32 || c > 96) {
		if (strict || !TclIsSpaceProc(c)) {
		    goto badUu;
		}
		i--;
		continue;
	    }
	    lineLen = (c - 32) & 0x3f;
	}

	/*
	 * Now we read a four-character grouping.
	 */

	for (i=0 ; i<4 ; i++) {
	    if (data < dataend) {
		d[i] = c = *data++;
		if (c < 32 || c > 96) {
		    if (strict) {
			if (!TclIsSpaceProc(c)) {
			    goto badUu;
			} else if (c == '\n') {
			    goto shortUu;
			}
		    }
		    i--;
		    continue;
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
	    do {
		c = *data++;
		if (c == '\n') {
		    break;
		} else if (c >= 32 && c <= 96) {
		    data--;
		    break;
		} else if (strict || !isspace(c)) {
		    goto badUu;
		}
	    } while (data < dataend);
	}
    }

    /*







|







2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
	    do {
		c = *data++;
		if (c == '\n') {
		    break;
		} else if (c >= 32 && c <= 96) {
		    data--;
		    break;
		} else if (strict || !TclIsSpaceProc(c)) {
		    goto badUu;
		}
	    } while (data < dataend);
	}
    }

    /*
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data"));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;

  badUu:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid uuencode character \"%c\" at position %d",
	    c, (int) (data - datastart - 1)));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------







|
|







2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data"));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;

  badUu:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid uuencode character \"%c\" at position %" TCL_Z_MODIFIER "u",
	    c, data - datastart - 1));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
	     * input whitespace characters.
	     */

	    if (cut) {
		if (c == '=' && i > 1) {
		     value <<= 6;
		     cut++;
		} else if (!strict && isspace(c)) {
		     i--;
		} else {
		    goto bad64;
		}
	    } else if (c >= 'A' && c <= 'Z') {
		value = (value << 6) | ((c - 'A') & 0x3f);
	    } else if (c >= 'a' && c <= 'z') {
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=') {
		value <<= 6;
		cut++;
	    } else if (strict || !isspace(c)) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);
	*cursor++ = UCHAR((value >> 8) & 0xff);
	*cursor++ = UCHAR(value & 0xff);

	/*
	 * Since = is only valid within the final block, if it was encountered
	 * but there are still more input characters, confirm that strict mode
	 * is off and all subsequent characters are whitespace.
	 */

	if (cut && data < dataend) {
	    if (strict) {
		goto bad64;
	    }
	    for (; data < dataend; data++) {
		if (!isspace(*data)) {
		    goto bad64;
		}
	    }
	}
    }
    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

  bad64:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid base64 character \"%c\" at position %d",
	    (char) c, (int) (data - datastart - 1)));
    TclDecrRefCount(resultObj);
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */








|

















|




















|











|
|












3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
	     * input whitespace characters.
	     */

	    if (cut) {
		if (c == '=' && i > 1) {
		     value <<= 6;
		     cut++;
		} else if (!strict && TclIsSpaceProc(c)) {
		     i--;
		} else {
		    goto bad64;
		}
	    } else if (c >= 'A' && c <= 'Z') {
		value = (value << 6) | ((c - 'A') & 0x3f);
	    } else if (c >= 'a' && c <= 'z') {
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=') {
		value <<= 6;
		cut++;
	    } else if (strict || !TclIsSpaceProc(c)) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);
	*cursor++ = UCHAR((value >> 8) & 0xff);
	*cursor++ = UCHAR(value & 0xff);

	/*
	 * Since = is only valid within the final block, if it was encountered
	 * but there are still more input characters, confirm that strict mode
	 * is off and all subsequent characters are whitespace.
	 */

	if (cut && data < dataend) {
	    if (strict) {
		goto bad64;
	    }
	    for (; data < dataend; data++) {
		if (!TclIsSpaceProc(*data)) {
		    goto bad64;
		}
	    }
	}
    }
    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

  bad64:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid base64 character \"%c\" at position %" TCL_Z_MODIFIER "u",
	    (char) c, data - datastart - 1));
    TclDecrRefCount(resultObj);
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclCkalloc.c.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 */

#include "tclInt.h"

#define FALSE	0
#define TRUE	1

#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc
#undef Tcl_AttemptAlloc
#undef Tcl_AttemptRealloc

#ifdef TCL_MEM_DEBUG

/*
 * One of the following structures is allocated each time the







<

<







16
17
18
19
20
21
22

23

24
25
26
27
28
29
30
 */

#include "tclInt.h"

#define FALSE	0
#define TRUE	1


#undef Tcl_Free

#undef Tcl_AttemptAlloc
#undef Tcl_AttemptRealloc

#ifdef TCL_MEM_DEBUG

/*
 * One of the following structures is allocated each time the
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
static char *onExitMemDumpFileName = NULL;
static char dumpFile[100];	/* Records where to dump memory allocation
				 * information. */

/*
 * Mutex to serialize allocations. This is a low-level mutex that must be
 * explicitly initialized. This is necessary because the self initializing
 * mutexes use ckalloc...
 */

static Tcl_Mutex *ckallocMutexPtr;
static int ckallocInit = 0;

/*
 * Prototypes for procedures defined in this file:







|







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
static char *onExitMemDumpFileName = NULL;
static char dumpFile[100];	/* Records where to dump memory allocation
				 * information. */

/*
 * Mutex to serialize allocations. This is a low-level mutex that must be
 * explicitly initialized. This is necessary because the self initializing
 * mutexes use Tcl_Alloc...
 */

static Tcl_Mutex *ckallocMutexPtr;
static int ckallocInit = 0;

/*
 * Prototypes for procedures defined in this file:
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276

    for (idx = 0; idx < LOW_GUARD_SIZE; idx++) {
	byte = *(memHeaderP->low_guard + idx);
	if (byte != GUARD_VALUE) {
	    guard_failed = TRUE;
	    fflush(stdout);
	    byte &= 0xff;
	    fprintf(stderr, "low guard byte %d is 0x%x  \t%c\n", (int)idx, byte,
		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
	}
    }
    if (guard_failed) {
	TclDumpMemoryInfo((ClientData) stderr, 0);
	fprintf(stderr, "low guard failed at %p, %s %d\n",
		memHeaderP->body, file, line);
	fflush(stderr);			/* In case name pointer is bad. */
	fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n", memHeaderP->length,
		memHeaderP->file, memHeaderP->line);
	Tcl_Panic("Memory validation failure");
    }

    hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
    for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) {
	byte = *(hiPtr + idx);
	if (byte != GUARD_VALUE) {
	    guard_failed = TRUE;
	    fflush(stdout);
	    byte &= 0xff;
	    fprintf(stderr, "hi guard byte %d is 0x%x  \t%c\n", (int)idx, byte,
		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
	}
    }

    if (guard_failed) {
	TclDumpMemoryInfo((ClientData) stderr, 0);
	fprintf(stderr, "high guard failed at %p, %s %d\n",







|




















|







239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274

    for (idx = 0; idx < LOW_GUARD_SIZE; idx++) {
	byte = *(memHeaderP->low_guard + idx);
	if (byte != GUARD_VALUE) {
	    guard_failed = TRUE;
	    fflush(stdout);
	    byte &= 0xff;
	    fprintf(stderr, "low guard byte %" TCL_Z_MODIFIER "u is 0x%x  \t%c\n", idx, byte,
		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
	}
    }
    if (guard_failed) {
	TclDumpMemoryInfo((ClientData) stderr, 0);
	fprintf(stderr, "low guard failed at %p, %s %d\n",
		memHeaderP->body, file, line);
	fflush(stderr);			/* In case name pointer is bad. */
	fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n", memHeaderP->length,
		memHeaderP->file, memHeaderP->line);
	Tcl_Panic("Memory validation failure");
    }

    hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
    for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) {
	byte = *(hiPtr + idx);
	if (byte != GUARD_VALUE) {
	    guard_failed = TRUE;
	    fflush(stdout);
	    byte &= 0xff;
	    fprintf(stderr, "hi guard byte %" TCL_Z_MODIFIER "u is 0x%x  \t%c\n", idx, byte,
		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
	}
    }

    if (guard_failed) {
	TclDumpMemoryInfo((ClientData) stderr, 0);
	fprintf(stderr, "high guard failed at %p, %s %d\n",
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbCkalloc - debugging ckalloc
 *
 *	Allocate the requested amount of space plus some extra for guard bands
 *	at both ends of the request, plus a size, panicing if there isn't
 *	enough space, then write in the guard bands and return the address of
 *	the space in the middle that the user asked for.
 *
 *	The second and third arguments are file and line, these contain the
 *	filename and line number corresponding to the caller. These are sent
 *	by the ckalloc macro; it uses the preprocessor autodefines __FILE__
 *	and __LINE__.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_DbCkalloc(
    unsigned int size,
    const char *file,
    int line)
{
    struct mem_header *result = NULL;

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

    /* Don't let size argument to TclpAlloc overflow */
    if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) {
	result = (struct mem_header *) TclpAlloc((unsigned)size +
		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    }
    if (result == NULL) {
	fflush(stdout);
	TclDumpMemoryInfo((ClientData) stderr, 0);
	Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
    }

    /*
     * Fill in guard zones and size. Also initialize the contents of the block
     * with bogus bytes to detect uses of initialized data. Link into
     * allocated list.
     */







|








|





|

|

















|







370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbCkalloc - debugging Tcl_Alloc
 *
 *	Allocate the requested amount of space plus some extra for guard bands
 *	at both ends of the request, plus a size, panicing if there isn't
 *	enough space, then write in the guard bands and return the address of
 *	the space in the middle that the user asked for.
 *
 *	The second and third arguments are file and line, these contain the
 *	filename and line number corresponding to the caller. These are sent
 *	by the Tcl_Alloc macro; it uses the preprocessor autodefines __FILE__
 *	and __LINE__.
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_DbCkalloc(
    size_t size,
    const char *file,
    int line)
{
    struct mem_header *result = NULL;

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

    /* Don't let size argument to TclpAlloc overflow */
    if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) {
	result = (struct mem_header *) TclpAlloc((unsigned)size +
		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    }
    if (result == NULL) {
	fflush(stdout);
	TclDumpMemoryInfo((ClientData) stderr, 0);
	Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d", size, file, line);
    }

    /*
     * Fill in guard zones and size. Also initialize the contents of the block
     * with bogus bytes to detect uses of initialized data. Link into
     * allocated list.
     */
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
		total_mallocs);
	fflush(stderr);
	alloc_tracing = TRUE;
	trace_on_at_malloc = 0;
    }

    if (alloc_tracing) {
	fprintf(stderr,"ckalloc %p %u %s %d\n",
		result->body, size, file, line);
    }

    if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
	break_on_malloc = 0;
	(void) fflush(stdout);
	Tcl_Panic("reached malloc break limit (%u)", total_mallocs);







|







451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
		total_mallocs);
	fflush(stderr);
	alloc_tracing = TRUE;
	trace_on_at_malloc = 0;
    }

    if (alloc_tracing) {
	fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n",
		result->body, size, file, line);
    }

    if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
	break_on_malloc = 0;
	(void) fflush(stdout);
	Tcl_Panic("reached malloc break limit (%u)", total_mallocs);
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
    }

    Tcl_MutexUnlock(ckallocMutexPtr);

    return result->body;
}

char *
Tcl_AttemptDbCkalloc(
    unsigned int size,
    const char *file,
    int line)
{
    struct mem_header *result = NULL;

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);







|

|







475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
    }

    Tcl_MutexUnlock(ckallocMutexPtr);

    return result->body;
}

void *
Tcl_AttemptDbCkalloc(
    size_t size,
    const char *file,
    int line)
{
    struct mem_header *result = NULL;

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
		total_mallocs);
	fflush(stderr);
	alloc_tracing = TRUE;
	trace_on_at_malloc = 0;
    }

    if (alloc_tracing) {
	fprintf(stderr,"ckalloc %p %u %s %d\n",
		result->body, size, file, line);
    }

    if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
	break_on_malloc = 0;
	(void) fflush(stdout);
	Tcl_Panic("reached malloc break limit (%d)", total_mallocs);







|







540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
		total_mallocs);
	fflush(stderr);
	alloc_tracing = TRUE;
	trace_on_at_malloc = 0;
    }

    if (alloc_tracing) {
	fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n",
		result->body, size, file, line);
    }

    if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
	break_on_malloc = 0;
	(void) fflush(stdout);
	Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621

    return result->body;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbCkfree - debugging ckfree
 *
 *	Verify that the low and high guards are intact, and if so then free
 *	the buffer else Tcl_Panic.
 *
 *	The guards are erased after being checked to catch duplicate frees.
 *
 *	The second and third arguments are file and line, these contain the
 *	filename and line number corresponding to the caller. These are sent
 *	by the ckfree macro; it uses the preprocessor autodefines __FILE__ and
 *	__LINE__.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DbCkfree(
    char *ptr,
    const char *file,
    int line)
{
    struct mem_header *memp;

    if (ptr == NULL) {
	return;
    }

    /*
     * The following cast is *very* tricky. Must convert the pointer to an
     * integer before doing arithmetic on it, because otherwise the arithmetic
     * will be done differently (and incorrectly) on word-addressed machines
     * such as Crays (will subtract only bytes, even though BODY_OFFSET is in
     * words on these machines).
     */

    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    if (alloc_tracing) {
	fprintf(stderr, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n",
		memp->body, memp->length, file, line);
    }

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }








|








|







|




















|







567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619

    return result->body;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbCkfree - debugging Tcl_Free
 *
 *	Verify that the low and high guards are intact, and if so then free
 *	the buffer else Tcl_Panic.
 *
 *	The guards are erased after being checked to catch duplicate frees.
 *
 *	The second and third arguments are file and line, these contain the
 *	filename and line number corresponding to the caller. These are sent
 *	by the Tcl_Free macro; it uses the preprocessor autodefines __FILE__ and
 *	__LINE__.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DbCkfree(
    void *ptr,
    const char *file,
    int line)
{
    struct mem_header *memp;

    if (ptr == NULL) {
	return;
    }

    /*
     * The following cast is *very* tricky. Must convert the pointer to an
     * integer before doing arithmetic on it, because otherwise the arithmetic
     * will be done differently (and incorrectly) on word-addressed machines
     * such as Crays (will subtract only bytes, even though BODY_OFFSET is in
     * words on these machines).
     */

    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    if (alloc_tracing) {
	fprintf(stderr, "Tcl_Free %p %" TCL_Z_MODIFIER "u %s %d\n",
		memp->body, memp->length, file, line);
    }

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
    TclpFree((char *) memp);
    Tcl_MutexUnlock(ckallocMutexPtr);
}

/*
 *--------------------------------------------------------------------
 *
 * Tcl_DbCkrealloc - debugging ckrealloc
 *
 *	Reallocate a chunk of memory by allocating a new one of the right
 *	size, copying the old data to the new location, and then freeing the
 *	old memory space, using all the memory checking features of this
 *	package.
 *
 *--------------------------------------------------------------------
 */

char *
Tcl_DbCkrealloc(
    char *ptr,
    unsigned int size,
    const char *file,
    int line)
{
    char *newPtr;
    size_t copySize;
    struct mem_header *memp;








|









|

|
|







649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
    TclpFree((char *) memp);
    Tcl_MutexUnlock(ckallocMutexPtr);
}

/*
 *--------------------------------------------------------------------
 *
 * Tcl_DbCkrealloc - debugging Tcl_Realloc
 *
 *	Reallocate a chunk of memory by allocating a new one of the right
 *	size, copying the old data to the new location, and then freeing the
 *	old memory space, using all the memory checking features of this
 *	package.
 *
 *--------------------------------------------------------------------
 */

void *
Tcl_DbCkrealloc(
    void *ptr,
    size_t size,
    const char *file,
    int line)
{
    char *newPtr;
    size_t copySize;
    struct mem_header *memp;

692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
    }
    newPtr = Tcl_DbCkalloc(size, file, line);
    memcpy(newPtr, ptr, (size_t) copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}

char *
Tcl_AttemptDbCkrealloc(
    char *ptr,
    unsigned int size,
    const char *file,
    int line)
{
    char *newPtr;
    size_t copySize;
    struct mem_header *memp;








|

|
|







690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
    }
    newPtr = Tcl_DbCkalloc(size, file, line);
    memcpy(newPtr, ptr, (size_t) copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}

void *
Tcl_AttemptDbCkrealloc(
    void *ptr,
    size_t size,
    const char *file,
    int line)
{
    char *newPtr;
    size_t copySize;
    struct mem_header *memp;

726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
	return NULL;
    }
    memcpy(newPtr, ptr, (size_t) copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_Alloc, et al. --
 *
 *	These functions are defined in terms of the debugging versions when
 *	TCL_MEM_DEBUG is set.
 *
 * Results:
 *	Same as the debug versions.
 *
 * Side effects:
 *	Same as the debug versions.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_Alloc(
    unsigned int size)
{
    return Tcl_DbCkalloc(size, "unknown", 0);
}

char *
Tcl_AttemptAlloc(
    unsigned int size)
{
    return Tcl_AttemptDbCkalloc(size, "unknown", 0);
}

void
Tcl_Free(
    char *ptr)
{
    Tcl_DbCkfree(ptr, "unknown", 0);
}

char *
Tcl_Realloc(
    char *ptr,
    unsigned int size)
{
    return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
}
char *
Tcl_AttemptRealloc(
    char *ptr,
    unsigned int size)
{
    return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0);
}

/*
 *----------------------------------------------------------------------
 *
 * MemoryCmd --
 *
 *	Implements the Tcl "memory" command, which provides Tcl-level control







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







724
725
726
727
728
729
730





















































731
732
733
734
735
736
737
	return NULL;
    }
    memcpy(newPtr, ptr, (size_t) copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}























































/*
 *----------------------------------------------------------------------
 *
 * MemoryCmd --
 *
 *	Implements the Tcl "memory" command, which provides Tcl-level control
1048
1049
1050
1051
1052
1053
1054

1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091

1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139

1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168

1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219

1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
 *
 *	Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check
 *	that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */


char *
Tcl_Alloc(
    unsigned int size)
{
    char *result;

    result = TclpAlloc(size);

    /*
     * Most systems will not alloc(0), instead bumping it to one so that NULL
     * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning
     * NULL, so we have to check that the NULL we get is not in response to
     * alloc(0).
     *
     * The ANSI spec actually says that systems either return NULL *or* a
     * special pointer on failure, but we only check for NULL
     */

    if ((result == NULL) && size) {
	Tcl_Panic("unable to alloc %u bytes", size);
    }
    return result;
}

char *
Tcl_DbCkalloc(
    unsigned int size,
    const char *file,
    int line)
{
    char *result;

    result = (char *) TclpAlloc(size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);

    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AttemptAlloc --
 *
 *	Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not
 *	check that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_AttemptAlloc(
    unsigned int size)
{
    char *result;

    result = TclpAlloc(size);
    return result;
}

char *
Tcl_AttemptDbCkalloc(
    unsigned int size,
    const char *file,
    int line)
{
    char *result;

    result = (char *) TclpAlloc(size);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Realloc --
 *
 *	Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check
 *	that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */


char *
Tcl_Realloc(
    char *ptr,
    unsigned int size)
{
    char *result;

    result = TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	Tcl_Panic("unable to realloc %u bytes", size);
    }
    return result;
}

char *
Tcl_DbCkrealloc(
    char *ptr,
    unsigned int size,
    const char *file,
    int line)
{
    char *result;

    result = (char *) TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line);

    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AttemptRealloc --
 *
 *	Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does not
 *	check that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_AttemptRealloc(
    char *ptr,
    unsigned int size)
{
    char *result;

    result = TclpRealloc(ptr, size);
    return result;
}

char *
Tcl_AttemptDbCkrealloc(
    char *ptr,
    unsigned int size,
    const char *file,
    int line)
{
    char *result;

    result = (char *) TclpRealloc(ptr, size);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Free --
 *
 *	Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here rather
 *	in the macro to keep some modules from being compiled with
 *	TCL_MEM_DEBUG enabled and some with it disabled.
 *
 *----------------------------------------------------------------------
 */


void
Tcl_Free(
    char *ptr)
{
    TclpFree(ptr);
}

void
Tcl_DbCkfree(
    char *ptr,
    const char *file,
    int line)
{
    TclpFree(ptr);
}

/*







>
|

|

|














|




|

|



|

|



|
>















|

|

|





|

|



|

|














>
|

|
|






|




|

|
|



|

|



|
>















|

|
|

|





|

|
|



|

|















>


|






|







993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
 *
 *	Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check
 *	that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_Alloc
void *
Tcl_Alloc(
    size_t size)
{
    void *result;

    result = TclpAlloc(size);

    /*
     * Most systems will not alloc(0), instead bumping it to one so that NULL
     * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning
     * NULL, so we have to check that the NULL we get is not in response to
     * alloc(0).
     *
     * The ANSI spec actually says that systems either return NULL *or* a
     * special pointer on failure, but we only check for NULL
     */

    if ((result == NULL) && size) {
	Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", size);
    }
    return result;
}

void *
Tcl_DbCkalloc(
    size_t size,
    const char *file,
    int line)
{
    void *result;

    result = TclpAlloc(size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d",
		size, file, line);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AttemptAlloc --
 *
 *	Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not
 *	check that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_AttemptAlloc(
    size_t size)
{
    void *result;

    result = TclpAlloc(size);
    return result;
}

void *
Tcl_AttemptDbCkalloc(
    size_t size,
    const char *file,
    int line)
{
    void *result;

    result = TclpAlloc(size);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Realloc --
 *
 *	Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check
 *	that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_Realloc
void *
Tcl_Realloc(
    void *ptr,
    size_t size)
{
    char *result;

    result = TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes", size);
    }
    return result;
}

void *
Tcl_DbCkrealloc(
    void *ptr,
    size_t size,
    const char *file,
    int line)
{
    void *result;

    result = TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes, %s line %d",
		size, file, line);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AttemptRealloc --
 *
 *	Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does not
 *	check that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_AttemptRealloc(
    void *ptr,
    size_t size)
{
    void *result;

    result = TclpRealloc(ptr, size);
    return result;
}

void *
Tcl_AttemptDbCkrealloc(
    void *ptr,
    size_t size,
    const char *file,
    int line)
{
    void *result;

    result = TclpRealloc(ptr, size);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Free --
 *
 *	Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here rather
 *	in the macro to keep some modules from being compiled with
 *	TCL_MEM_DEBUG enabled and some with it disabled.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_Free
void
Tcl_Free(
    void *ptr)
{
    TclpFree(ptr);
}

void
Tcl_DbCkfree(
    void *ptr,
    const char *file,
    int line)
{
    TclpFree(ptr);
}

/*
Changes to generic/tclClock.c.
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
	return;
    }

    /*
     * Create the client data, which is a refcounted literal pool.
     */

    data = ckalloc(sizeof(ClockClientData));
    data->refCount = 0;
    data->literals = ckalloc(LIT__END * sizeof(Tcl_Obj*));
    for (i = 0; i < LIT__END; ++i) {
	data->literals[i] = Tcl_NewStringObj(literals[i], -1);
	Tcl_IncrRefCount(data->literals[i]);
    }

    /*
     * Install the commands.







|

|







271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
	return;
    }

    /*
     * Create the client data, which is a refcounted literal pool.
     */

    data = Tcl_Alloc(sizeof(ClockClientData));
    data->refCount = 0;
    data->literals = Tcl_Alloc(LIT__END * sizeof(Tcl_Obj*));
    for (i = 0; i < LIT__END; ++i) {
	data->literals[i] = Tcl_NewStringObj(literals[i], -1);
	Tcl_IncrRefCount(data->literals[i]);
    }

    /*
     * Install the commands.
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055

    Tcl_MutexLock(&clockMutex);
    tzIsNow = getenv("TZ");
    if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
	    || strcmp(tzIsNow, tzWas) != 0)) {
	tzset();
	if (tzWas != NULL && tzWas != INT2PTR(-1)) {
	    ckfree(tzWas);
	}
	tzWas = ckalloc(strlen(tzIsNow) + 1);
	strcpy(tzWas, tzIsNow);
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != INT2PTR(-1)) ckfree(tzWas);
	tzWas = NULL;
    }
    Tcl_MutexUnlock(&clockMutex);
}

/*
 *----------------------------------------------------------------------







|

|



|







2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055

    Tcl_MutexLock(&clockMutex);
    tzIsNow = getenv("TZ");
    if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
	    || strcmp(tzIsNow, tzWas) != 0)) {
	tzset();
	if (tzWas != NULL && tzWas != INT2PTR(-1)) {
	    Tcl_Free(tzWas);
	}
	tzWas = Tcl_Alloc(strlen(tzIsNow) + 1);
	strcpy(tzWas, tzIsNow);
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != INT2PTR(-1)) Tcl_Free(tzWas);
	tzWas = NULL;
    }
    Tcl_MutexUnlock(&clockMutex);
}

/*
 *----------------------------------------------------------------------
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
    ClockClientData *data = clientData;
    int i;

    if (data->refCount-- <= 1) {
	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);
	}
	ckfree(data->literals);
	ckfree(data);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|
|










2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
    ClockClientData *data = clientData;
    int i;

    if (data->refCount-- <= 1) {
	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);
	}
	Tcl_Free(data->literals);
	Tcl_Free(data);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclCmdAH.c.
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

/*
 * Prototypes for local procedures defined in this file:
 */

static int		CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    int mode);
static int		BadEncodingSubcommand(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		EncodingConvertfromObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		EncodingConverttoObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		EncodingDirsObjCmd(ClientData dummy,







<
<
<







42
43
44
45
46
47
48



49
50
51
52
53
54
55

/*
 * Prototypes for local procedures defined in this file:
 */

static int		CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    int mode);



static int		EncodingConvertfromObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		EncodingConverttoObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		EncodingDirsObjCmd(ClientData dummy,
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
static Tcl_NRPostProc	ForSetupCallback;
static Tcl_NRPostProc	ForCondCallback;
static Tcl_NRPostProc	ForNextCallback;
static Tcl_NRPostProc	ForPostNextCallback;
static Tcl_NRPostProc	ForeachLoopStep;
static Tcl_NRPostProc	EvalCmdErrMsg;

static Tcl_ObjCmdProc	BadFileSubcommand;
static Tcl_ObjCmdProc FileAttrAccessTimeCmd;
static Tcl_ObjCmdProc FileAttrIsDirectoryCmd;
static Tcl_ObjCmdProc FileAttrIsExecutableCmd;
static Tcl_ObjCmdProc FileAttrIsExistingCmd;
static Tcl_ObjCmdProc FileAttrIsFileCmd;
static Tcl_ObjCmdProc FileAttrIsOwnedCmd;
static Tcl_ObjCmdProc FileAttrIsReadableCmd;







<







77
78
79
80
81
82
83

84
85
86
87
88
89
90
static Tcl_NRPostProc	ForSetupCallback;
static Tcl_NRPostProc	ForCondCallback;
static Tcl_NRPostProc	ForNextCallback;
static Tcl_NRPostProc	ForPostNextCallback;
static Tcl_NRPostProc	ForeachLoopStep;
static Tcl_NRPostProc	EvalCmdErrMsg;


static Tcl_ObjCmdProc FileAttrAccessTimeCmd;
static Tcl_ObjCmdProc FileAttrIsDirectoryCmd;
static Tcl_ObjCmdProc FileAttrIsExecutableCmd;
static Tcl_ObjCmdProc FileAttrIsExistingCmd;
static Tcl_ObjCmdProc FileAttrIsFileCmd;
static Tcl_ObjCmdProc FileAttrIsOwnedCmd;
static Tcl_ObjCmdProc FileAttrIsReadableCmd;
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
Tcl_Command
TclInitEncodingCmd(
    Tcl_Interp* interp)		/* Tcl interpreter */
{
    static const EnsembleImplMap encodingImplMap[] = {
	{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"convertto",   EncodingConverttoObjCmd,   TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"names",       EncodingNamesObjCmd,       TclCompileBasic0ArgCmd,    NULL, NULL, 0},
	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{NULL,          NULL,                      NULL,                      NULL, NULL, 0}
    };

    return TclMakeEnsemble(interp, "encoding", encodingImplMap);
}

/*
 *-----------------------------------------------------------------------------
 *
 * TclMakeEncodingCommandSafe --
 *
 *	This function hides the unsafe 'dirs' and 'system' subcommands of
 *	the "encoding" Tcl command ensemble. It must be called only from
 *	TclHideUnsafeCommands.
 *
 * Results:
 *	A standard Tcl result
 *
 * Side effects:
 *	Adds commands to the table of hidden commands.
 *
 *-----------------------------------------------------------------------------
 */

int
TclMakeEncodingCommandSafe(
    Tcl_Interp* interp)		/* Tcl interpreter */
{
    static const struct {
	const char *cmdName;
	int unsafe;
    } unsafeInfo[] = {
	{"convertfrom", 0},
	{"convertto",   0},
	{"dirs",        1},
	{"names",       0},
	{"system",      0},
	{NULL,          0}
    };

    int i;
    Tcl_DString oldBuf, newBuf;

    Tcl_DStringInit(&oldBuf);
    TclDStringAppendLiteral(&oldBuf, "::tcl::encoding::");
    Tcl_DStringInit(&newBuf);
    TclDStringAppendLiteral(&newBuf, "tcl:encoding:");
    for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
	if (unsafeInfo[i].unsafe) {
	    const char *oldName, *newName;

	    Tcl_DStringSetLength(&oldBuf, 17);
	    oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
	    Tcl_DStringSetLength(&newBuf, 13);
	    newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
	    if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
		    || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
		Tcl_Panic("problem making 'encoding %s' safe: %s",
			unsafeInfo[i].cmdName,
			Tcl_GetString(Tcl_GetObjResult(interp)));
	    }
	    Tcl_CreateObjCommand(interp, oldName, BadEncodingSubcommand,
		    (ClientData) unsafeInfo[i].cmdName, NULL);
	}
    }
    Tcl_DStringFree(&oldBuf);
    Tcl_DStringFree(&newBuf);

    /*
     * Ugh. The [encoding] command is now actually safe, but it is assumed by
     * scripts that it is not, which messes up security policies.
     */

    if (Tcl_HideCommand(interp, "encoding", "encoding") != TCL_OK) {
	Tcl_Panic("problem making 'encoding' safe: %s",
		Tcl_GetString(Tcl_GetObjResult(interp)));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * BadEncodingSubcommand --
 *
 *	Command used to act as a backstop implementation when subcommands of
 *	"encoding" are unsafe (the real implementations of the subcommands are
 *	hidden). The clientData is always the full official subcommand name.
 *
 * Results:
 *	A standard Tcl result (always a TCL_ERROR).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
BadEncodingSubcommand(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const char *subcommandName = (const char *) clientData;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "not allowed to invoke subcommand %s of encoding", subcommandName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * EncodingConvertfromObjCmd --
 *
 *	This command converts a byte array in an external encoding into a







|

|





<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







391
392
393
394
395
396
397
398
399
400
401
402
403
404
405











































































































406
407
408
409
410
411
412
Tcl_Command
TclInitEncodingCmd(
    Tcl_Interp* interp)		/* Tcl interpreter */
{
    static const EnsembleImplMap encodingImplMap[] = {
	{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"convertto",   EncodingConverttoObjCmd,   TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"names",       EncodingNamesObjCmd,       TclCompileBasic0ArgCmd,    NULL, NULL, 0},
	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{NULL,          NULL,                      NULL,                      NULL, NULL, 0}
    };

    return TclMakeEnsemble(interp, "encoding", encodingImplMap);
}












































































































/*
 *----------------------------------------------------------------------
 *
 * EncodingConvertfromObjCmd --
 *
 *	This command converts a byte array in an external encoding into a
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* Byte array to convert */
    Tcl_DString ds;		/* Buffer to hold the string */
    Tcl_Encoding encoding;	/* Encoding to use */
    int length;			/* Length of the byte array being converted */
    const char *bytesPtr;	/* Pointer to the first byte of the array */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
    } else if (objc == 3) {
	if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
	    return TCL_ERROR;
	}
	data = objv[2];
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data");
	return TCL_ERROR;
    }

    /*
     * Convert the string into a byte array in 'ds'
     */
    bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
    Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds);

    /*
     * Note that we cannot use Tcl_DStringResult here because it will
     * truncate the string at the first null byte.
     */








|


















|







424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* Byte array to convert */
    Tcl_DString ds;		/* Buffer to hold the string */
    Tcl_Encoding encoding;	/* Encoding to use */
    size_t length;			/* Length of the byte array being converted */
    const char *bytesPtr;	/* Pointer to the first byte of the array */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
    } else if (objc == 3) {
	if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
	    return TCL_ERROR;
	}
	data = objv[2];
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data");
	return TCL_ERROR;
    }

    /*
     * Convert the string into a byte array in 'ds'
     */
    bytesPtr = (char *) TclGetByteArrayFromObj(data, &length);
    Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds);

    /*
     * Note that we cannot use Tcl_DStringResult here because it will
     * truncate the string at the first null byte.
     */

597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* String to convert */
    Tcl_DString ds;		/* Buffer to hold the byte array */
    Tcl_Encoding encoding;	/* Encoding to use */
    int length;			/* Length of the string being converted */
    const char *stringPtr;	/* Pointer to the first byte of the string */

    /* TODO - ADJUST OBJ INDICES WHEN ENSEMBLIFYING THIS */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];







|







486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* String to convert */
    Tcl_DString ds;		/* Buffer to hold the byte array */
    Tcl_Encoding encoding;	/* Encoding to use */
    size_t length;			/* Length of the string being converted */
    const char *stringPtr;	/* Pointer to the first byte of the string */

    /* TODO - ADJUST OBJ INDICES WHEN ENSEMBLIFYING THIS */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
    /*
     * Note that most subcommands are unsafe because either they manipulate
     * the native filesystem or because they reveal information about the
     * native filesystem.
     */

    static const EnsembleImplMap initMap[] = {
	{"atime",	FileAttrAccessTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"attributes",	TclFileAttrsCmd,	NULL, NULL, NULL, 0},
	{"channels",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"copy",	TclFileCopyCmd,		NULL, NULL, NULL, 0},
	{"delete",	TclFileDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
	{"dirname",	PathDirNameCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"executable",	FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"exists",	FileAttrIsExistingCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"extension",	PathExtensionCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"isdirectory",	FileAttrIsDirectoryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"isfile",	FileAttrIsFileCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"join",	PathJoinCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
	{"link",	TclFileLinkCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"lstat",	FileAttrLinkStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"mtime",	FileAttrModifyTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"mkdir",	TclFileMakeDirsCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
	{"nativename",	PathNativeNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"normalize",	PathNormalizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"owned",	FileAttrIsOwnedCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"pathtype",	PathTypeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"readable",	FileAttrIsReadableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"readlink",	TclFileReadLinkCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"rename",	TclFileRenameCmd,	NULL, NULL, NULL, 0},
	{"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"separator",	FilesystemSeparatorCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"size",	FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"split",	PathSplitCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"stat",	FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"system",	PathFilesystemCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"tail",	PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
	{"type",	FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"volumes",	FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 0},
	{"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    return TclMakeEnsemble(interp, "file", initMap);
}

/*
 *----------------------------------------------------------------------
 *
 * TclMakeFileCommandSafe --
 *
 *	This function hides the unsafe subcommands of the "file" Tcl command
 *	ensemble. It must only be called from TclHideUnsafeCommands.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Adds commands to the table of hidden commands.
 *
 *----------------------------------------------------------------------
 */

int
TclMakeFileCommandSafe(
    Tcl_Interp *interp)
{
    static const struct {
	const char *cmdName;
	int unsafe;
    } unsafeInfo[] = {
	{"atime",	 1},
	{"attributes",	 1},
	{"channels",	 0},
	{"copy",	 1},
	{"delete",	 1},
	{"dirname",	 1},
	{"executable",	 1},
	{"exists",	 1},
	{"extension",	 1},
	{"isdirectory",	 1},
	{"isfile",	 1},
	{"join",	 0},
	{"link",	 1},
	{"lstat",	 1},
	{"mtime",	 1},
	{"mkdir",	 1},
	{"nativename",	 1},
	{"normalize",	 1},
	{"owned",	 1},
	{"pathtype",	 0},
	{"readable",	 1},
	{"readlink",	 1},
	{"rename",	 1},
	{"rootname",	 1},
	{"separator",	 0},
	{"size",	 1},
	{"split",	 0},
	{"stat",	 1},
	{"system",	 0},
	{"tail",	 1},
	{"tempfile",	 1},
	{"type",	 1},
	{"volumes",	 1},
	{"writable",	 1},
	{NULL, 0}
    };
    int i;
    Tcl_DString oldBuf, newBuf;

    Tcl_DStringInit(&oldBuf);
    TclDStringAppendLiteral(&oldBuf, "::tcl::file::");
    Tcl_DStringInit(&newBuf);
    TclDStringAppendLiteral(&newBuf, "tcl:file:");
    for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
	if (unsafeInfo[i].unsafe) {
	    const char *oldName, *newName;

	    Tcl_DStringSetLength(&oldBuf, 13);
	    oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
	    Tcl_DStringSetLength(&newBuf, 9);
	    newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
	    if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
		    || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
		Tcl_Panic("problem making 'file %s' safe: %s",
			unsafeInfo[i].cmdName,
			Tcl_GetString(Tcl_GetObjResult(interp)));
	    }
	    Tcl_CreateObjCommand(interp, oldName, BadFileSubcommand,
		    (ClientData) unsafeInfo[i].cmdName, NULL);
	}
    }
    Tcl_DStringFree(&oldBuf);
    Tcl_DStringFree(&newBuf);

    /*
     * Ugh. The [file] command is now actually safe, but it is assumed by
     * scripts that it is not, which messes up security policies. [Bug
     * 3211758]
     */

    if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) {
	Tcl_Panic("problem making 'file' safe: %s",
		Tcl_GetString(Tcl_GetObjResult(interp)));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * BadFileSubcommand --
 *
 *	Command used to act as a backstop implementation when subcommands of
 *	"file" are unsafe (the real implementations of the subcommands are
 *	hidden). The clientData is always the full official subcommand name.
 *
 * Results:
 *	A standard Tcl result (always a TCL_ERROR).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
BadFileSubcommand(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const char *subcommandName = (const char *) clientData;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "not allowed to invoke subcommand %s of file", subcommandName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrAccessTimeCmd --
 *
 *	This function is invoked to process the "file atime" Tcl command. See







|
|

|
|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|

|

|

|
|
|
|
|




<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966







































































































































967
968
969
970
971
972
973
    /*
     * Note that most subcommands are unsafe because either they manipulate
     * the native filesystem or because they reveal information about the
     * native filesystem.
     */

    static const EnsembleImplMap initMap[] = {
	{"atime",	FileAttrAccessTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
	{"attributes",	TclFileAttrsCmd,	NULL, NULL, NULL, 1},
	{"channels",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"copy",	TclFileCopyCmd,		NULL, NULL, NULL, 1},
	{"delete",	TclFileDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
	{"dirname",	PathDirNameCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"executable",	FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"exists",	FileAttrIsExistingCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"extension",	PathExtensionCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"isdirectory",	FileAttrIsDirectoryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"isfile",	FileAttrIsFileCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"join",	PathJoinCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
	{"link",	TclFileLinkCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 1},
	{"lstat",	FileAttrLinkStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
	{"mtime",	FileAttrModifyTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
	{"mkdir",	TclFileMakeDirsCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
	{"nativename",	PathNativeNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"normalize",	PathNormalizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"owned",	FileAttrIsOwnedCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"pathtype",	PathTypeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"readable",	FileAttrIsReadableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"readlink",	TclFileReadLinkCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"rename",	TclFileRenameCmd,	NULL, NULL, NULL, 1},
	{"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"separator",	FilesystemSeparatorCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"size",	FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"split",	PathSplitCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"stat",	FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
	{"system",	PathFilesystemCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"tail",	PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 1},
	{"type",	FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"volumes",	FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 1},
	{"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    return TclMakeEnsemble(interp, "file", initMap);
}








































































































































/*
 *----------------------------------------------------------------------
 *
 * FileAttrAccessTimeCmd --
 *
 *	This function is invoked to process the "file atime" Tcl command. See
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273

    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	long newTime;

	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = newTime;
	tval.modtime = buf.st_mtime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {







|

|







1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027

    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	Tcl_WideInt newTime;

	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = newTime;
	tval.modtime = buf.st_mtime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
#endif
    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	long newTime;

	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = buf.st_atime;
	tval.modtime = newTime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {







|

|







1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
#endif
    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	Tcl_WideInt newTime;

	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = buf.st_atime;
	tval.modtime = newTime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
Changes to generic/tclCmdIL.c.
133
134
135
136
137
138
139


140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
static int		InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoProcsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,


			    int objc, Tcl_Obj *const objv[]);
static int		InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static SortElement *	MergeLists(SortElement *leftPtr, SortElement *rightPtr,
			    SortInfo *infoPtr);
static int		SortCompare(SortElement *firstPtr, SortElement *second,
			    SortInfo *infoPtr);
static Tcl_Obj *	SelectObjFromSublist(Tcl_Obj *firstPtr,
			    SortInfo *infoPtr);

/*
 * Array of values describing how to implement each standard subcommand of the
 * "info" command.
 */

static const EnsembleImplMap defaultInfoMap[] = {
    {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},

    {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
    {"complete",	   InfoCompleteCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"coroutine",	   TclInfoCoroutineCmd,     TclCompileInfoCoroutineCmd, NULL, NULL, 0},
    {"default",		   InfoDefaultCmd,	    TclCompileBasic3ArgCmd, NULL, NULL, 0},
    {"errorstack",	   InfoErrorStackCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd, NULL, NULL, 0},
    {"frame",		   InfoFrameCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"functions",	   InfoFunctionsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"globals",		   TclInfoGlobalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"hostname",	   InfoHostnameCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"level",		   InfoLevelCmd,	    TclCompileInfoLevelCmd, NULL, NULL, 0},
    {"library",		   InfoLibraryCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"loaded",		   InfoLoadedCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"locals",		   TclInfoLocalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"nameofexecutable",   InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"patchlevel",	   InfoPatchLevelCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"vars",		   TclInfoVarsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}







>
>



















>














|







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
static int		InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoProcsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoCmdTypeCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static SortElement *	MergeLists(SortElement *leftPtr, SortElement *rightPtr,
			    SortInfo *infoPtr);
static int		SortCompare(SortElement *firstPtr, SortElement *second,
			    SortInfo *infoPtr);
static Tcl_Obj *	SelectObjFromSublist(Tcl_Obj *firstPtr,
			    SortInfo *infoPtr);

/*
 * Array of values describing how to implement each standard subcommand of the
 * "info" command.
 */

static const EnsembleImplMap defaultInfoMap[] = {
    {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"cmdtype",		   InfoCmdTypeCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
    {"complete",	   InfoCompleteCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"coroutine",	   TclInfoCoroutineCmd,     TclCompileInfoCoroutineCmd, NULL, NULL, 0},
    {"default",		   InfoDefaultCmd,	    TclCompileBasic3ArgCmd, NULL, NULL, 0},
    {"errorstack",	   InfoErrorStackCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd, NULL, NULL, 0},
    {"frame",		   InfoFrameCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"functions",	   InfoFunctionsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"globals",		   TclInfoGlobalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"hostname",	   InfoHostnameCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"level",		   InfoLevelCmd,	    TclCompileInfoLevelCmd, NULL, NULL, 0},
    {"library",		   InfoLibraryCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"loaded",		   InfoLoadedCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"locals",		   TclInfoLocalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"nameofexecutable",   InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
    {"patchlevel",	   InfoPatchLevelCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"vars",		   TclInfoVarsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
    Tcl_HashSearch search;
    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Command cmd;
    int i;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * commands.
     */

    if (objc == 1) {







|







657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
    Tcl_HashSearch search;
    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Command cmd;
    size_t i;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * commands.
     */

    if (objc == 1) {
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413

	    TclNewObj(procNameObj);
	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
		    procNameObj);
	    ADD_PAIR("proc", procNameObj);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
	    int i;

	    /*
	     * This is a non-standard command. Luckily, it's told us how to
	     * render extra information about its frame.
	     */

	    for (i=0 ; i<efiPtr->length ; i++) {







|







1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416

	    TclNewObj(procNameObj);
	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
		    procNameObj);
	    ADD_PAIR("proc", procNameObj);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
	    size_t i;

	    /*
	     * This is a non-standard command. Luckily, it's told us how to
	     * render extra information about its frame.
	     */

	    for (i=0 ; i<efiPtr->length ; i++) {
2128
2129
2130
2131
2132
2133
2134






















































2135
2136
2137
2138
2139
2140
2141
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *






















































 * Tcl_JoinObjCmd --
 *
 *	This procedure is invoked to process the "join" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoCmdTypeCmd --
 *
 *	Called to implement the "info cmdtype" command that returns the type
 *	of a given command. Handles the following syntax:
 *
 *	    info cmdtype cmdName
 *
 * Results:
 *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
 *
 * Side effects:
 *	Returns a type name. If there is an error, the result is an error
 *	message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoCmdTypeCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Command command;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "commandName");
	return TCL_ERROR;
    }
    command = Tcl_FindCommand(interp, Tcl_GetString(objv[1]), NULL,
	    TCL_LEAVE_ERR_MSG);
    if (command == NULL) {
	return TCL_ERROR;
    }

    /*
     * There's one special case: safe slave interpreters can't see aliases as
     * aliases as they're part of the security mechanisms.
     */

    if (Tcl_IsSafe(interp)
	    && (((Command *) command)->objProc == TclAliasObjCmd)) {
	Tcl_AppendResult(interp, "native", NULL);
    } else {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj(TclGetCommandTypeName(command), -1));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_JoinObjCmd --
 *
 *	This procedure is invoked to process the "join" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
2149
2150
2151
2152
2153
2154
2155

2156
2157
2158
2159
2160
2161
2162
2163
int
Tcl_JoinObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{

    int length, listLen;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }








>
|







2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
int
Tcl_JoinObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    size_t length;
    int listLen;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
	Tcl_SetObjResult(interp, elemPtrs[0]);
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void) Tcl_GetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	int i;

	resObjPtr = Tcl_NewObj();
	for (i = 0;  i < listLen;  i++) {







|







2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
	Tcl_SetObjResult(interp, elemPtrs[0]);
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void) TclGetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	int i;

	resObjPtr = Tcl_NewObj();
	for (i = 0;  i < listLen;  i++) {
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
    if (result != TCL_OK) {
	return result;
    }

    if (first < 0) {
	first = 0;
    }

    /*
     * Complain if the user asked for a start element that is greater than the
     * list length. This won't ever trigger for the "end-*" case as that will
     * be properly constrained by TclGetIntForIndex because we use listLen-1
     * (to allow for replacing the last elem).
     */

    if ((first >= listLen) && (listLen > 0)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"list doesn't contain element %s", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
		NULL);
	return TCL_ERROR;
    }
    if (last >= listLen) {
	last = listLen - 1;
    }
    if (first <= last) {
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;







|
<
<
<
|
<
<
|
<
<
<
<
<
<
|







2784
2785
2786
2787
2788
2789
2790
2791



2792


2793






2794
2795
2796
2797
2798
2799
2800
2801
    if (result != TCL_OK) {
	return result;
    }

    if (first < 0) {
	first = 0;
    }
    if (first > listLen) {



	first = listLen;


    }







    if (last >= listLen) {
	last = listLen - 1;
    }
    if (first <= last) {
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;
2885
2886
2887
2888
2889
2890
2891
2892

2893
2894
2895
2896
2897
2898
2899
Tcl_LsearchObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    const char *bytes, *patternBytes;
    int i, match, index, result=TCL_OK, listc, length, elemLen, bisect;

    int allocatedIndexVector = 0;
    int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset;
    Tcl_WideInt patWide, objWide;
    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
    double patDouble, objDouble;
    SortInfo sortInfo;
    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;







|
>







2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
Tcl_LsearchObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    const char *bytes, *patternBytes;
    int i, match, index, result=TCL_OK, listc, bisect;
    size_t length = 0, elemLen;
    int allocatedIndexVector = 0;
    int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset;
    Tcl_WideInt patWide, objWide;
    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
    double patDouble, objDouble;
    SortInfo sortInfo;
    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
    }

    /*
     * The following loop creates a SortElement for each list element and
     * begins sorting it into the sublists as it appears.
     */

    elementArray = ckalloc(length * sizeof(SortElement));

    for (i=0; i < length; i++){
	idx = groupSize * i + groupOffset;
	if (indexc) {
	    /*
	     * If this is an indexed sort, retrieve the corresponding element
	     */







|







4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
    }

    /*
     * The following loop creates a SortElement for each list element and
     * begins sorting it into the sublists as it appears.
     */

    elementArray = Tcl_Alloc(length * sizeof(SortElement));

    for (i=0; i < length; i++){
	idx = groupSize * i + groupOffset;
	if (indexc) {
	    /*
	     * If this is an indexed sort, retrieve the corresponding element
	     */
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
	TclDecrRefCount(listObj);
	sortInfo.compareCmdPtr = NULL;
    }
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);
    }
    if (elementArray) {
	ckfree(elementArray);
    }
    return sortInfo.resultCode;
}

/*
 *----------------------------------------------------------------------
 *







|







4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
	TclDecrRefCount(listObj);
	sortInfo.compareCmdPtr = NULL;
    }
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);
    }
    if (elementArray) {
	Tcl_Free(elementArray);
    }
    return sortInfo.resultCode;
}

/*
 *----------------------------------------------------------------------
 *
Changes to generic/tclCmdMZ.c.
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
     * regexp to avoid shimmering problems.
     */

    objPtr = objv[1];
    stringLength = Tcl_GetCharLength(objPtr);

    if (startIndex) {
	TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}
    }

    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);







|







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
     * regexp to avoid shimmering problems.
     */

    objPtr = objv[1];
    stringLength = Tcl_GetCharLength(objPtr);

    if (startIndex) {
	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}
    }

    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
482
483
484
485
486
487
488
489

490
491
492
493
494
495
496
int
Tcl_RegsubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int idx, result, cflags, all, wlen, wsublen, numMatches, offset;

    int start, end, subStart, subEnd, match, command, numParts;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;

    static const char *const options[] = {







|
>







482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
int
Tcl_RegsubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int idx, result, cflags, all, numMatches, offset;
    size_t wlen, wsublen = 0;
    int start, end, subStart, subEnd, match, command, numParts;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;

    static const char *const options[] = {
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599

600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617

    objc -= idx;
    objv += idx;

    if (startIndex) {
	int stringLength = Tcl_GetCharLength(objv[1]);

	TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}
    }

    if (all && (offset == 0) && (command == 0)
	    && (strpbrk(TclGetString(objv[2]), "&\\") == NULL)
	    && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
	/*
	 * This is a simple one pair string map situation. We make use of a
	 * slightly modified version of the one pair STR_MAP code.
	 */


	int slen, nocase, wsrclc;
	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
	Tcl_UniChar *p;

	numMatches = 0;
	nocase = (cflags & TCL_REG_NOCASE);
	strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;

	wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen);
	wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen);
	wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen);
	wend = wstring + wlen - (slen ? slen - 1 : 0);
	result = TCL_OK;

	if (slen == 0) {
	    /*
	     * regsub behavior for "" matches between each character. 'string
	     * map' skips the "" case.







|














>
|
|






|
|
|







579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619

    objc -= idx;
    objv += idx;

    if (startIndex) {
	int stringLength = Tcl_GetCharLength(objv[1]);

	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}
    }

    if (all && (offset == 0) && (command == 0)
	    && (strpbrk(TclGetString(objv[2]), "&\\") == NULL)
	    && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
	/*
	 * This is a simple one pair string map situation. We make use of a
	 * slightly modified version of the one pair STR_MAP code.
	 */

	size_t slen;
	int nocase, wsrclc;
	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t);
	Tcl_UniChar *p;

	numMatches = 0;
	nocase = (cflags & TCL_REG_NOCASE);
	strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;

	wsrc = TclGetUnicodeFromObj(objv[0], &slen);
	wstring = TclGetUnicodeFromObj(objv[1], &wlen);
	wsubspec = TclGetUnicodeFromObj(objv[2], &wsublen);
	wend = wstring + wlen - (slen ? slen - 1 : 0);
	result = TCL_OK;

	if (slen == 0) {
	    /*
	     * regsub behavior for "" matches between each character. 'string
	     * map' skips the "" case.
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
	    }
	} else {
	    wsrclc = Tcl_UniCharToLower(*wsrc);
	    for (p = wfirstChar = wstring; wstring < wend; wstring++) {
		if ((*wstring == *wsrc ||
			(nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) &&
			(slen==1 || (strCmpFn(wstring, wsrc,
				(unsigned long) slen) == 0))) {
		    if (numMatches == 0) {
			resultPtr = Tcl_NewUnicodeObj(wstring, 0);
			Tcl_IncrRefCount(resultPtr);
		    }
		    if (p != wstring) {
			Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p);
			p = wstring + slen;







|







631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
	    }
	} else {
	    wsrclc = Tcl_UniCharToLower(*wsrc);
	    for (p = wfirstChar = wstring; wstring < wend; wstring++) {
		if ((*wstring == *wsrc ||
			(nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) &&
			(slen==1 || (strCmpFn(wstring, wsrc,
				(size_t)slen) == 0))) {
		    if (numMatches == 0) {
			resultPtr = Tcl_NewUnicodeObj(wstring, 0);
			Tcl_IncrRefCount(resultPtr);
		    }
		    if (p != wstring) {
			Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p);
			p = wstring + slen;
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
     */

    if (objv[1] == objv[0]) {
	objPtr = Tcl_DuplicateObj(objv[1]);
    } else {
	objPtr = objv[1];
    }
    wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);
    if (objv[2] == objv[0]) {
	subPtr = Tcl_DuplicateObj(objv[2]);
    } else {
	subPtr = objv[2];
    }
    if (!command) {
	wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen);
    }

    result = TCL_OK;

    /*
     * The following loop is to handle multiple matches within the same source
     * string; each iteration handles one match and its corresponding
     * substitution. If "-all" hasn't been specified then the loop body only
     * gets executed once. We must use 'offset <= wlen' in particular for the
     * case where the regexp pattern can match the empty string - this is
     * useful when doing, say, 'regsub -- ^ $str ...' when $str might be
     * empty.
     */

    numMatches = 0;
    for ( ; offset <= wlen; ) {

	/*
	 * The flags argument is set if string is part of a larger string, so
	 * that "^" won't match.
	 */

	match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,







|






|















|







696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
     */

    if (objv[1] == objv[0]) {
	objPtr = Tcl_DuplicateObj(objv[1]);
    } else {
	objPtr = objv[1];
    }
    wstring = TclGetUnicodeFromObj(objPtr, &wlen);
    if (objv[2] == objv[0]) {
	subPtr = Tcl_DuplicateObj(objv[2]);
    } else {
	subPtr = objv[2];
    }
    if (!command) {
	wsubspec = TclGetUnicodeFromObj(subPtr, &wsublen);
    }

    result = TCL_OK;

    /*
     * The following loop is to handle multiple matches within the same source
     * string; each iteration handles one match and its corresponding
     * substitution. If "-all" hasn't been specified then the loop body only
     * gets executed once. We must use 'offset <= wlen' in particular for the
     * case where the regexp pattern can match the empty string - this is
     * useful when doing, say, 'regsub -- ^ $str ...' when $str might be
     * empty.
     */

    numMatches = 0;
    for ( ; (size_t)offset <= wlen; ) {

	/*
	 * The flags argument is set if string is part of a larger string, so
	 * that "^" won't match.
	 */

	match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787

	if (command) {
	    Tcl_Obj **args = NULL, **parts;
	    int numArgs;

	    Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
	    numArgs = numParts + info.nsubs + 1;
	    args = ckalloc(sizeof(Tcl_Obj*) * numArgs);
	    memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);

	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart >= 0) && (subEnd >= 0)) {
		    args[idx + numParts] = Tcl_NewUnicodeObj(







|







775
776
777
778
779
780
781
782
783
784
785
786
787
788
789

	if (command) {
	    Tcl_Obj **args = NULL, **parts;
	    int numArgs;

	    Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
	    numArgs = numParts + info.nsubs + 1;
	    args = Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs);
	    memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);

	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart >= 0) && (subEnd >= 0)) {
		    args[idx + numParts] = Tcl_NewUnicodeObj(
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
	     * afterwards; subPtr is handled in the main exit stanza.
	     */

	    result = Tcl_EvalObjv(interp, numArgs, args, 0);
	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		TclDecrRefCount(args[idx + numParts]);
	    }
	    ckfree(args);
	    if (result != TCL_OK) {
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (%s substitution computation script)",
			    options[REGSUB_COMMAND]));
		}
		goto done;
	    }

	    Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));
	    Tcl_ResetResult(interp);

	    /*
	     * Refetch the unicode, in case the representation was smashed by
	     * the user code.
	     */

	    wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);

	    offset += end;
	    if (end == 0 || start == end) {
		/*
		 * Always consume at least one character of the input string
		 * in order to prevent infinite loops, even when we
		 * technically matched the empty string; we must not match
		 * again at the same spot.
		 */

		if (offset < wlen) {
		    Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
		}
		offset++;
	    }
	    if (all) {
		continue;
	    } else {







|

















|










|







805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
	     * afterwards; subPtr is handled in the main exit stanza.
	     */

	    result = Tcl_EvalObjv(interp, numArgs, args, 0);
	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		TclDecrRefCount(args[idx + numParts]);
	    }
	    Tcl_Free(args);
	    if (result != TCL_OK) {
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (%s substitution computation script)",
			    options[REGSUB_COMMAND]));
		}
		goto done;
	    }

	    Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));
	    Tcl_ResetResult(interp);

	    /*
	     * Refetch the unicode, in case the representation was smashed by
	     * the user code.
	     */

	    wstring = TclGetUnicodeFromObj(objPtr, &wlen);

	    offset += end;
	    if (end == 0 || start == end) {
		/*
		 * Always consume at least one character of the input string
		 * in order to prevent infinite loops, even when we
		 * technically matched the empty string; we must not match
		 * again at the same spot.
		 */

		if ((size_t)offset < wlen) {
		    Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
		}
		offset++;
	    }
	    if (all) {
		continue;
	    } else {
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931

	if (end == 0) {
	    /*
	     * Always consume at least one character of the input string in
	     * order to prevent infinite loops.
	     */

	    if (offset < wlen) {
		Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
	    }
	    offset++;
	} else {
	    offset += end;
	    if (start == end) {
		/*
		 * We matched an empty string, which means we must go forward
		 * one more step so we don't match again at the same spot.
		 */

		if (offset < wlen) {
		    Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
		}
		offset++;
	    }
	}
	if (!all) {
	    break;







|











|







907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933

	if (end == 0) {
	    /*
	     * Always consume at least one character of the input string in
	     * order to prevent infinite loops.
	     */

	    if ((size_t)offset < wlen) {
		Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
	    }
	    offset++;
	} else {
	    offset += end;
	    if (start == end) {
		/*
		 * We matched an empty string, which means we must go forward
		 * one more step so we don't match again at the same spot.
		 */

		if ((size_t)offset < wlen) {
		    Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
		}
		offset++;
	    }
	}
	if (!all) {
	    break;
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
	/*
	 * On zero matches, just ignore the offset, since it shouldn't matter
	 * to us in this case, and the user may have skewed it.
	 */

	resultPtr = objv[1];
	Tcl_IncrRefCount(resultPtr);
    } else if (offset < wlen) {
	Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
    }
    if (objc == 4) {
	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	} else {







|







944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
	/*
	 * On zero matches, just ignore the offset, since it shouldn't matter
	 * to us in this case, and the user may have skewed it.
	 */

	resultPtr = objv[1];
	Tcl_IncrRefCount(resultPtr);
    } else if ((size_t)offset < wlen) {
	Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
    }
    if (objc == 4) {
	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	} else {
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar ch = 0;
    int len;
    const char *splitChars;
    const char *stringPtr;
    const char *end;
    int splitCharLen, stringLen;
    Tcl_Obj *listPtr, *objPtr;

    if (objc == 2) {
	splitChars = " \n\t\r";
	splitCharLen = 4;
    } else if (objc == 3) {
	splitChars = TclGetStringFromObj(objv[2], &splitCharLen);







|







1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar ch = 0;
    int len;
    const char *splitChars;
    const char *stringPtr;
    const char *end;
    size_t splitCharLen, stringLen;
    Tcl_Obj *listPtr, *objPtr;

    if (objc == 2) {
	splitChars = " \n\t\r";
	splitCharLen = 4;
    } else if (objc == 3) {
	splitChars = TclGetStringFromObj(objv[2], &splitCharLen);
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267

	/*
	 * Handle the special case of splitting on a single character. This is
	 * only true for the one-char ASCII case, as one unicode char is > 1
	 * byte in length.
	 */

	while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) {
	    objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;
	}
	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
    } else {







|







1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269

	/*
	 * Handle the special case of splitting on a single character. This is
	 * only true for the one-char ASCII case, as one unicode char is > 1
	 * byte in length.
	 */

	while (*stringPtr && (p=strchr(stringPtr,*splitChars)) != NULL) {
	    objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;
	}
	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
    } else {
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
    if (objc == 4) {
	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFirst(objv[1],
	    objv[2], start)));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
    if (objc == 4) {
	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclStringFirst(objv[1],
	    objv[2], start)));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1480
1481
1482
1483
1484
1485
1486
1487

1488
1489
1490
1491
1492
1493
1494
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *end, *stop;
    Tcl_UniChar ch = 0;
    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
    int i, failat = 0, result = 1, strict = 0, index, length1, length2;

    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;

    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"digit",	"double",	"entier",
	"false",	"graph",	"integer",	"list",







|
>







1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *end, *stop;
    Tcl_UniChar ch = 0;
    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
    int i, failat = 0, result = 1, strict = 0, index, length3;
    size_t length1, length2;
    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;

    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"digit",	"double",	"entier",
	"false",	"graph",	"integer",	"list",
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
	}
	break;
    }
    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INT:
	if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
	    break;
	}
	goto failedIntParse;
    case STR_IS_ENTIER:
	if ((objPtr->typePtr == &tclIntType) ||
		(objPtr->typePtr == &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {







<
<
<
<







1620
1621
1622
1623
1624
1625
1626




1627
1628
1629
1630
1631
1632
1633
	}
	break;
    }
    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INT:




    case STR_IS_ENTIER:
	if ((objPtr->typePtr == &tclIntType) ||
		(objPtr->typePtr == &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
	}
	break;
    case STR_IS_WIDE:
	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

    failedIntParse:
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}







<







1667
1668
1669
1670
1671
1672
1673

1674
1675
1676
1677
1678
1679
1680
	}
	break;
    case STR_IS_WIDE:
	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}


	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741

1742
1743
1744
1745
1746
1747
1748
	break;
    case STR_IS_LIST:
	/*
	 * We ignore the strictness here, since empty strings are always
	 * well-formed lists.
	 */

	if (TCL_OK == TclListObjLength(NULL, objPtr, &length2)) {
	    break;
	}

	if (failVarObj != NULL) {
	    /*
	     * Need to figure out where the list parsing failed, which is
	     * fairly expensive. This is adapted from the core of
	     * SetListFromAny().
	     */

	    const char *elemStart, *nextElem;
	    int lenRemain, elemSize;

	    register const char *p;

	    string1 = TclGetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {







|











|
>







1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
	break;
    case STR_IS_LIST:
	/*
	 * We ignore the strictness here, since empty strings are always
	 * well-formed lists.
	 */

	if (TCL_OK == TclListObjLength(NULL, objPtr, &length3)) {
	    break;
	}

	if (failVarObj != NULL) {
	    /*
	     * Need to figure out where the list parsing failed, which is
	     * fairly expensive. This is adapted from the core of
	     * SetListFromAny().
	     */

	    const char *elemStart, *nextElem;
	    size_t lenRemain;
	    size_t elemSize;
	    register const char *p;

	    string1 = TclGetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
    return (character >= 0) && (character < 0x80);
}

static int
UniCharIsHexDigit(
    int character)
{
    return (character >= 0) && (character < 0x80) && isxdigit(character);
}

/*
 *----------------------------------------------------------------------
 *
 * StringMapCmd --
 *







|







1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
    return (character >= 0) && (character < 0x80);
}

static int
UniCharIsHexDigit(
    int character)
{
    return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
}

/*
 *----------------------------------------------------------------------
 *
 * StringMapCmd --
 *
1871
1872
1873
1874
1875
1876
1877
1878

1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
static int
StringMapCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length1, length2, mapElemc, index;

    int nocase = 0, mapWithDict = 0, copySource = 0;
    Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
    Tcl_UniChar *ustring1, *ustring2, *p, *end;
    int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long);

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
	return TCL_ERROR;
    }

    if (objc == 4) {







|
>



|







1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
static int
StringMapCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    int mapElemc, index;
    int nocase = 0, mapWithDict = 0, copySource = 0;
    Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
    Tcl_UniChar *ustring1, *ustring2, *p, *end;
    int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t);

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
	return TCL_ERROR;
    }

    if (objc == 4) {
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986

    if (objv[objc-2] == objv[objc-1]) {
	sourceObj = Tcl_DuplicateObj(objv[objc-1]);
	copySource = 1;
    } else {
	sourceObj = objv[objc-1];
    }
    ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1);
    if (length1 == 0) {
	/*
	 * Empty input string, just stop now.
	 */

	goto done;
    }







|







1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986

    if (objv[objc-2] == objv[objc-1]) {
	sourceObj = Tcl_DuplicateObj(objv[objc-1]);
	copySource = 1;
    } else {
	sourceObj = objv[objc-1];
    }
    ustring1 = TclGetUnicodeFromObj(sourceObj, &length1);
    if (length1 == 0) {
	/*
	 * Empty input string, just stop now.
	 */

	goto done;
    }
1998
1999
2000
2001
2002
2003
2004
2005

2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038

2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
	/*
	 * Special case for one map pair which avoids the extra for loop and
	 * extra calls to get Unicode data. The algorithm is otherwise
	 * identical to the multi-pair case. This will be >30% faster on
	 * larger strings.
	 */

	int mapLen, u2lc;

	Tcl_UniChar *mapString;

	ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
	p = ustring1;
	if ((length2 > length1) || (length2 == 0)) {
	    /*
	     * Match string is either longer than input or empty.
	     */

	    ustring1 = end;
	} else {
	    mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
	    u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
	    for (; ustring1 < end; ustring1++) {
		if (((*ustring1 == *ustring2) ||
			(nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) &&
			(length2==1 || strCmpFn(ustring1, ustring2,
				(unsigned long) length2) == 0)) {
		    if (p != ustring1) {
			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
		    } else {
			p += length2;
		    }
		    ustring1 = p - 1;

		    Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
		}
	    }
	}
    } else {
	Tcl_UniChar **mapStrings;
	int *mapLens, *u2lc = NULL;


	/*
	 * Precompute pointers to the unicode string and length. This saves us
	 * repeated function calls later, significantly speeding up the
	 * algorithm. We only need the lowercase first char in the nocase
	 * case.
	 */

	mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
	mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
	if (nocase) {
	    u2lc = TclStackAlloc(interp, mapElemc * sizeof(int));
	}
	for (index = 0; index < mapElemc; index++) {
	    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
		    mapLens+index);
	    if (nocase && ((index % 2) == 0)) {
		u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
	    }
	}
	for (p = ustring1; ustring1 < end; ustring1++) {
	    for (index = 0; index < mapElemc; index += 2) {
		/*
		 * Get the key string to match on.
		 */

		ustring2 = mapStrings[index];
		length2 = mapLens[index];
		if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase &&
			(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
			/* Restrict max compare length. */
			(end-ustring1 >= length2) && ((length2 == 1) ||
			!strCmpFn(ustring2, ustring1, (unsigned) length2))) {
		    if (p != ustring1) {
			/*
			 * Put the skipped chars onto the result first.
			 */

			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;







|
>


|








|





|














|
>








|
|




|
















|
|







1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
	/*
	 * Special case for one map pair which avoids the extra for loop and
	 * extra calls to get Unicode data. The algorithm is otherwise
	 * identical to the multi-pair case. This will be >30% faster on
	 * larger strings.
	 */

	size_t mapLen;
	int u2lc;
	Tcl_UniChar *mapString;

	ustring2 = TclGetUnicodeFromObj(mapElemv[0], &length2);
	p = ustring1;
	if ((length2 > length1) || (length2 == 0)) {
	    /*
	     * Match string is either longer than input or empty.
	     */

	    ustring1 = end;
	} else {
	    mapString = TclGetUnicodeFromObj(mapElemv[1], &mapLen);
	    u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
	    for (; ustring1 < end; ustring1++) {
		if (((*ustring1 == *ustring2) ||
			(nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) &&
			(length2==1 || strCmpFn(ustring1, ustring2,
				length2) == 0)) {
		    if (p != ustring1) {
			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
		    } else {
			p += length2;
		    }
		    ustring1 = p - 1;

		    Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
		}
	    }
	}
    } else {
	Tcl_UniChar **mapStrings;
	size_t *mapLens;
	int *u2lc = 0;

	/*
	 * Precompute pointers to the unicode string and length. This saves us
	 * repeated function calls later, significantly speeding up the
	 * algorithm. We only need the lowercase first char in the nocase
	 * case.
	 */

	mapStrings = TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2);
	mapLens = TclStackAlloc(interp, mapElemc * sizeof(size_t) * 2);
	if (nocase) {
	    u2lc = TclStackAlloc(interp, mapElemc * sizeof(int));
	}
	for (index = 0; index < mapElemc; index++) {
	    mapStrings[index] = TclGetUnicodeFromObj(mapElemv[index],
		    mapLens+index);
	    if (nocase && ((index % 2) == 0)) {
		u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
	    }
	}
	for (p = ustring1; ustring1 < end; ustring1++) {
	    for (index = 0; index < mapElemc; index += 2) {
		/*
		 * Get the key string to match on.
		 */

		ustring2 = mapStrings[index];
		length2 = mapLens[index];
		if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase &&
			(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
			/* Restrict max compare length. */
			((size_t)(end-ustring1) >= length2) && ((length2 == 1) ||
			!strCmpFn(ustring2, ustring1, length2))) {
		    if (p != ustring1) {
			/*
			 * Put the skipped chars onto the result first.
			 */

			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	int length;
	const char *string = TclGetStringFromObj(objv[1], &length);

	if ((length > 1) &&
	    strncmp(string, "-nocase", (size_t) length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;







|



|







2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	size_t length;
	const char *string = TclGetStringFromObj(objv[1], &length);

	if ((length > 1) &&
	    strncmp(string, "-nocase", length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
2193
2194
2195
2196
2197
2198
2199

2200
2201
2202
2203
2204
2205
2206
2207
static int
StringRangeCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    int length, first, last;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last");
	return TCL_ERROR;
    }

    /*







>
|







2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
static int
StringRangeCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length;
    int first, last;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last");
	return TCL_ERROR;
    }

    /*
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    if (first < 0) {
	first = 0;
    }
    if (last >= length) {
	last = length;
    }
    if (last >= first) {
	Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
    }
    return TCL_OK;
}







|







2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    if (first < 0) {
	first = 0;
    }
    if (last >= (int)length) {
	last = length;
    }
    if (last >= first) {
	Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
    }
    return TCL_OK;
}
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_GetCharLength(objv[1])));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringLowerCmd --







|







2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetCharLength(objv[1])));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringLowerCmd --
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
StringTrimCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int triml, trimr, length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {







|







3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
StringTrimCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    size_t triml, trimr, length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
	     * own.
	     */
	}

	if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
	    int bline = ctxPtr->line[bidx];

	    ctxPtr->line = ckalloc(objc * sizeof(int));
	    ctxPtr->nline = objc;
	    TclListLines(blist, bline, objc, ctxPtr->line, objv);
	} else {
	    /*
	     * This is either a dynamic code word, when all elements are
	     * relative to themselves, or something else less expected and
	     * where we have no information. The result is the same in both
	     * cases; tell the code to come that it doesn't know where it is,
	     * which triggers reversion to the old behavior.
	     */

	    int k;

	    ctxPtr->line = ckalloc(objc * sizeof(int));
	    ctxPtr->nline = objc;
	    for (k=0; k < objc; k++) {
		ctxPtr->line[k] = -1;
	    }
	}
    }








|













|







3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
	     * own.
	     */
	}

	if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
	    int bline = ctxPtr->line[bidx];

	    ctxPtr->line = Tcl_Alloc(objc * sizeof(int));
	    ctxPtr->nline = objc;
	    TclListLines(blist, bline, objc, ctxPtr->line, objv);
	} else {
	    /*
	     * This is either a dynamic code word, when all elements are
	     * relative to themselves, or something else less expected and
	     * where we have no information. The result is the same in both
	     * cases; tell the code to come that it doesn't know where it is,
	     * which triggers reversion to the old behavior.
	     */

	    int k;

	    ctxPtr->line = Tcl_Alloc(objc * sizeof(int));
	    ctxPtr->nline = objc;
	    for (k=0; k < objc; k++) {
		ctxPtr->line[k] = -1;
	    }
	}
    }

3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
    int patternLength = strlen(pattern);

    /*
     * Clean up TIP 280 context information
     */

    if (splitObjs) {
	ckfree(ctxPtr->line);
	if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
	    /*
	     * Death of SrcInfo reference.
	     */

	    Tcl_DecrRefCount(ctxPtr->data.eval.path);
	}







|







3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
    int patternLength = strlen(pattern);

    /*
     * Clean up TIP 280 context information
     */

    if (splitObjs) {
	Tcl_Free(ctxPtr->line);
	if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
	    /*
	     * Death of SrcInfo reference.
	     */

	    Tcl_DecrRefCount(ctxPtr->data.eval.path);
	}
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
#endif

    if (count <= 1) {
	/*
	 * Use int obj since we know time is not fractional. [Bug 1202178]
	 */

	objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec);
    } else {
	objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
    }

    /*
     * Construct the result as a list because many programs have always parsed
     * as such (extracting the first element, typically).







|







4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
#endif

    if (count <= 1) {
	/*
	 * Use int obj since we know time is not fractional. [Bug 1202178]
	 */

	objs[0] = Tcl_NewLongObj((count <= 0) ? 0 : totalMicroSec);
    } else {
	objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
    }

    /*
     * Construct the result as a list because many programs have always parsed
     * as such (extracting the first element, typically).
Changes to generic/tclCompCmds.c.
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
    /*
     * Prepare for the internal foreach.
     */

    keyVar = AnonymousLocal(envPtr);
    valVar = AnonymousLocal(envPtr);

    infoPtr = ckalloc(sizeof(ForeachInfo));
    infoPtr->numLists = 1;
    infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
    infoPtr->varLists[0]->numVars = 2;
    infoPtr->varLists[0]->varIndexes[0] = keyVar;
    infoPtr->varLists[0]->varIndexes[1] = valVar;
    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);

    /*
     * Start issuing instructions to write to the array.







|

|







399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
    /*
     * Prepare for the internal foreach.
     */

    keyVar = AnonymousLocal(envPtr);
    valVar = AnonymousLocal(envPtr);

    infoPtr = Tcl_Alloc(sizeof(ForeachInfo));
    infoPtr->numLists = 1;
    infoPtr->varLists[0] = Tcl_Alloc(sizeof(ForeachVarList) + sizeof(int));
    infoPtr->varLists[0]->numVars = 2;
    infoPtr->varLists[0]->varIndexes[0] = keyVar;
    infoPtr->varLists[0]->varIndexes[1] = valVar;
    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);

    /*
     * Start issuing instructions to write to the array.
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
    /* Stack at this point is empty */
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);

    /* Stack at this point on both branches: result returnCode */

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }

    /*
     * Push the return options if the caller wants them. This needs to happen
     * before INST_END_CATCH
     */








|
|







697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
    /* Stack at this point is empty */
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);

    /* Stack at this point on both branches: result returnCode */

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileCatchCmd: bad jump distance %" TCL_Z_MODIFIER "d",
		(CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }

    /*
     * Push the return options if the caller wants them. This needs to happen
     * before INST_END_CATCH
     */

1092
1093
1094
1095
1096
1097
1098
1099

1100
1101
1102
1103
1104
1105
1106

    /*
     * Parse the increment amount, if present.
     */

    if (parsePtr->numWords == 4) {
	const char *word;
	int numBytes, code;

	Tcl_Token *incrTokenPtr;
	Tcl_Obj *intObj;

	incrTokenPtr = TokenAfter(keyTokenPtr);
	if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
	}







|
>







1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107

    /*
     * Parse the increment amount, if present.
     */

    if (parsePtr->numWords == 4) {
	const char *word;
	size_t numBytes;
	int code;
	Tcl_Token *incrTokenPtr;
	Tcl_Obj *intObj;

	incrTokenPtr = TokenAfter(keyTokenPtr);
	if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
	}
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
    if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
	    &argv) != TCL_OK) {
	Tcl_DStringFree(&buffer);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }
    Tcl_DStringFree(&buffer);
    if (numVars != 2) {
	ckfree(argv);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    nameChars = strlen(argv[0]);
    keyVarIndex = LocalScalar(argv[0], nameChars, envPtr);
    nameChars = strlen(argv[1]);
    valueVarIndex = LocalScalar(argv[1], nameChars, envPtr);
    ckfree(argv);

    if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Allocate a temporary variable to store the iterator reference. The







|







|







1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
    if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
	    &argv) != TCL_OK) {
	Tcl_DStringFree(&buffer);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }
    Tcl_DStringFree(&buffer);
    if (numVars != 2) {
	Tcl_Free(argv);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    nameChars = strlen(argv[0]);
    keyVarIndex = LocalScalar(argv[0], nameChars, envPtr);
    nameChars = strlen(argv[1]);
    valueVarIndex = LocalScalar(argv[1], nameChars, envPtr);
    Tcl_Free(argv);

    if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Allocate a temporary variable to store the iterator reference. The
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789

    /*
     * Assemble the instruction metadata. This is complex enough that it is
     * represented as auxData; it holds an ordered list of variable indices
     * that are to be used.
     */

    duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
    duiPtr->length = numVars;
    keyTokenPtrs = TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
    tokenPtr = TokenAfter(dictVarTokenPtr);

    for (i=0 ; i<numVars ; i++) {
	/*
	 * Put keys to one side for later compilation to bytecode.







|







1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790

    /*
     * Assemble the instruction metadata. This is complex enough that it is
     * represented as auxData; it holds an ordered list of variable indices
     * that are to be used.
     */

    duiPtr = Tcl_Alloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
    duiPtr->length = numVars;
    keyTokenPtrs = TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
    tokenPtr = TokenAfter(dictVarTokenPtr);

    for (i=0 ; i<numVars ; i++) {
	/*
	 * Put keys to one side for later compilation to bytecode.
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
    TclEmitInstInt4(	INST_REVERSE, 3,			envPtr);

    TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
    TclEmitInt4(		infoIndex,			envPtr);
    TclEmitInvoke(envPtr,INST_RETURN_STK);

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }
    TclStackFree(interp, keyTokenPtrs);
    return TCL_OK;

    /*
     * Clean up after a failure to create the DictUpdateInfo structure.
     */

  failedUpdateInfoAssembly:
    ckfree(duiPtr);
    TclStackFree(interp, keyTokenPtrs);
  issueFallback:
    return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileDictAppendCmd(







|
|









|







1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
    TclEmitInstInt4(	INST_REVERSE, 3,			envPtr);

    TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
    TclEmitInt4(		infoIndex,			envPtr);
    TclEmitInvoke(envPtr,INST_RETURN_STK);

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %" TCL_Z_MODIFIER "d",
		CurrentOffset(envPtr) - jumpFixup.codeOffset);
    }
    TclStackFree(interp, keyTokenPtrs);
    return TCL_OK;

    /*
     * Clean up after a failure to create the DictUpdateInfo structure.
     */

  failedUpdateInfoAssembly:
    Tcl_Free(duiPtr);
    TclStackFree(interp, keyTokenPtrs);
  issueFallback:
    return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileDictAppendCmd(
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
    TclEmitInvoke(envPtr,	INST_RETURN_STK);

    /*
     * Prepare for the start of the next command.
     */

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|
|







2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
    TclEmitInvoke(envPtr,	INST_RETURN_STK);

    /*
     * Prepare for the start of the next command.
     */

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %" TCL_Z_MODIFIER "d",
		CurrentOffset(envPtr) - jumpFixup.codeOffset);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
    ClientData clientData)
{
    DictUpdateInfo *dui1Ptr, *dui2Ptr;
    unsigned len;

    dui1Ptr = clientData;
    len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
    dui2Ptr = ckalloc(len);
    memcpy(dui2Ptr, dui1Ptr, len);
    return dui2Ptr;
}

static void
FreeDictUpdateInfo(
    ClientData clientData)
{
    ckfree(clientData);
}

static void
PrintDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    DictUpdateInfo *duiPtr = clientData;
    int i;

    for (i=0 ; i<duiPtr->length ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	}
	Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
    }
}

static void
DisassembleDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    DictUpdateInfo *duiPtr = clientData;
    int i;
    Tcl_Obj *variables = Tcl_NewObj();

    for (i=0 ; i<duiPtr->length ; i++) {
	Tcl_ListObjAppendElement(NULL, variables,
		Tcl_NewIntObj(duiPtr->varIndices[i]));
    }
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1),







|








|










|

















|







2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
    ClientData clientData)
{
    DictUpdateInfo *dui1Ptr, *dui2Ptr;
    unsigned len;

    dui1Ptr = clientData;
    len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
    dui2Ptr = Tcl_Alloc(len);
    memcpy(dui2Ptr, dui1Ptr, len);
    return dui2Ptr;
}

static void
FreeDictUpdateInfo(
    ClientData clientData)
{
    Tcl_Free(clientData);
}

static void
PrintDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    DictUpdateInfo *duiPtr = clientData;
    size_t i;

    for (i=0 ; i<duiPtr->length ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	}
	Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
    }
}

static void
DisassembleDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    DictUpdateInfo *duiPtr = clientData;
    size_t i;
    Tcl_Obj *variables = Tcl_NewObj();

    for (i=0 ; i<duiPtr->length ; i++) {
	Tcl_ListObjAppendElement(NULL, variables,
		Tcl_NewIntObj(duiPtr->varIndices[i]));
    }
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1),
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
    /*
     * Create and initialize the ForeachInfo and ForeachVarList data
     * structures describing this command. Then create a AuxData record
     * pointing to the ForeachInfo structure.
     */

    numLists = (numWords - 2)/2;
    infoPtr = ckalloc(sizeof(ForeachInfo)
	    + (numLists - 1) * sizeof(ForeachVarList *));
    infoPtr->numLists = 0;	/* Count this up as we go */

    /*
     * Parse each var list into sequence of var names.  Don't
     * compile the foreach inline if any var name needs substitutions or isn't
     * a scalar, or if any var list needs substitutions.







|







2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
    /*
     * Create and initialize the ForeachInfo and ForeachVarList data
     * structures describing this command. Then create a AuxData record
     * pointing to the ForeachInfo structure.
     */

    numLists = (numWords - 2)/2;
    infoPtr = Tcl_Alloc(sizeof(ForeachInfo)
	    + (numLists - 1) * sizeof(ForeachVarList *));
    infoPtr->numLists = 0;	/* Count this up as we go */

    /*
     * Parse each var list into sequence of var names.  Don't
     * compile the foreach inline if any var name needs substitutions or isn't
     * a scalar, or if any var list needs substitutions.
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
		TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
		numVars == 0) {
	    code = TCL_ERROR;
	    goto done;
	}

	varListPtr = ckalloc(sizeof(ForeachVarList)
		+ (numVars - 1) * sizeof(int));
	varListPtr->numVars = numVars;
	infoPtr->varLists[i/2] = varListPtr;
	infoPtr->numLists++;

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    const char *bytes;
	    int numBytes, varIndex;

	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = TclGetStringFromObj(varNameObj, &numBytes);
	    varIndex = LocalScalar(bytes, numBytes, envPtr);
	    if (varIndex < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
	Tcl_SetObjLength(varListObj, 0);







|








|


|
|







2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
		TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
		numVars == 0) {
	    code = TCL_ERROR;
	    goto done;
	}

	varListPtr = Tcl_Alloc(sizeof(ForeachVarList)
		+ (numVars - 1) * sizeof(int));
	varListPtr->numVars = numVars;
	infoPtr->varLists[i/2] = varListPtr;
	infoPtr->numLists++;

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    const char *bytes;
	    int varIndex;

	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = TclGetString(varNameObj);
	    varIndex = LocalScalar(bytes, varNameObj->length, envPtr);
	    if (varIndex < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
	Tcl_SetObjLength(varListObj, 0);
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
				 * data to duplicate. */
{
    register ForeachInfo *srcPtr = clientData;
    ForeachInfo *dupPtr;
    register ForeachVarList *srcListPtr, *dupListPtr;
    int numVars, i, j, numLists = srcPtr->numLists;

    dupPtr = ckalloc(sizeof(ForeachInfo)
	    + numLists * sizeof(ForeachVarList *));
    dupPtr->numLists = numLists;
    dupPtr->firstValueTemp = srcPtr->firstValueTemp;
    dupPtr->loopCtTemp = srcPtr->loopCtTemp;

    for (i = 0;  i < numLists;  i++) {
	srcListPtr = srcPtr->varLists[i];
	numVars = srcListPtr->numVars;
	dupListPtr = ckalloc(sizeof(ForeachVarList)
		+ numVars * sizeof(int));
	dupListPtr->numVars = numVars;
	for (j = 0;  j < numVars;  j++) {
	    dupListPtr->varIndexes[j] =	srcListPtr->varIndexes[j];
	}
	dupPtr->varLists[i] = dupListPtr;
    }







|








|







2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
				 * data to duplicate. */
{
    register ForeachInfo *srcPtr = clientData;
    ForeachInfo *dupPtr;
    register ForeachVarList *srcListPtr, *dupListPtr;
    int numVars, i, j, numLists = srcPtr->numLists;

    dupPtr = Tcl_Alloc(sizeof(ForeachInfo)
	    + numLists * sizeof(ForeachVarList *));
    dupPtr->numLists = numLists;
    dupPtr->firstValueTemp = srcPtr->firstValueTemp;
    dupPtr->loopCtTemp = srcPtr->loopCtTemp;

    for (i = 0;  i < numLists;  i++) {
	srcListPtr = srcPtr->varLists[i];
	numVars = srcListPtr->numVars;
	dupListPtr = Tcl_Alloc(sizeof(ForeachVarList)
		+ numVars * sizeof(int));
	dupListPtr->numVars = numVars;
	for (j = 0;  j < numVars;  j++) {
	    dupListPtr->varIndexes[j] =	srcListPtr->varIndexes[j];
	}
	dupPtr->varLists[i] = dupListPtr;
    }
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
    register ForeachInfo *infoPtr = clientData;
    register ForeachVarList *listPtr;
    int numLists = infoPtr->numLists;
    register int i;

    for (i = 0;  i < numLists;  i++) {
	listPtr = infoPtr->varLists[i];
	ckfree(listPtr);
    }
    ckfree(infoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * PrintForeachInfo, DisassembleForeachInfo --
 *







|

|







2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
    register ForeachInfo *infoPtr = clientData;
    register ForeachVarList *listPtr;
    int numLists = infoPtr->numLists;
    register int i;

    for (i = 0;  i < numLists;  i++) {
	listPtr = infoPtr->varLists[i];
	Tcl_Free(listPtr);
    }
    Tcl_Free(infoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * PrintForeachInfo, DisassembleForeachInfo --
 *
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
    Tcl_IncrRefCount(formatObj);
    tokenPtr = TokenAfter(tokenPtr);
    if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) {
	Tcl_DecrRefCount(formatObj);
	return TCL_ERROR;
    }

    objv = ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *));
    for (i=0 ; i+2 < parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	objv[i] = Tcl_NewObj();
	Tcl_IncrRefCount(objv[i]);
	if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) {
	    goto checkForStringConcatCase;
	}
    }

    /*
     * Everything is a literal, so the result is constant too (or an error if
     * the format is broken). Do the format now.
     */

    tmpObj = Tcl_Format(interp, Tcl_GetString(formatObj),
	    parsePtr->numWords-2, objv);
    for (; --i>=0 ;) {
	Tcl_DecrRefCount(objv[i]);
    }
    ckfree(objv);
    Tcl_DecrRefCount(formatObj);
    if (tmpObj == NULL) {
	TclCompileSyntaxError(interp, envPtr);
	return TCL_OK;
    }

    /*







|



















|







3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
    Tcl_IncrRefCount(formatObj);
    tokenPtr = TokenAfter(tokenPtr);
    if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) {
	Tcl_DecrRefCount(formatObj);
	return TCL_ERROR;
    }

    objv = Tcl_Alloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *));
    for (i=0 ; i+2 < parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	objv[i] = Tcl_NewObj();
	Tcl_IncrRefCount(objv[i]);
	if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) {
	    goto checkForStringConcatCase;
	}
    }

    /*
     * Everything is a literal, so the result is constant too (or an error if
     * the format is broken). Do the format now.
     */

    tmpObj = Tcl_Format(interp, Tcl_GetString(formatObj),
	    parsePtr->numWords-2, objv);
    for (; --i>=0 ;) {
	Tcl_DecrRefCount(objv[i]);
    }
    Tcl_Free(objv);
    Tcl_DecrRefCount(formatObj);
    if (tmpObj == NULL) {
	TclCompileSyntaxError(interp, envPtr);
	return TCL_OK;
    }

    /*
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
     * First, get the state of the system relatively sensible (cleaning up
     * after our attempt to spot a literal).
     */

    for (; i>=0 ; i--) {
	Tcl_DecrRefCount(objv[i]);
    }
    ckfree(objv);
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    tokenPtr = TokenAfter(tokenPtr);
    i = 0;

    /*
     * Now scan through and check for non-%s and non-%% substitutions.
     */







|







3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
     * First, get the state of the system relatively sensible (cleaning up
     * after our attempt to spot a literal).
     */

    for (; i>=0 ; i--) {
	Tcl_DecrRefCount(objv[i]);
    }
    Tcl_Free(objv);
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    tokenPtr = TokenAfter(tokenPtr);
    i = 0;

    /*
     * Now scan through and check for non-%s and non-%% substitutions.
     */
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
    }
    return index;
}

int
TclLocalScalar(
    const char *bytes,
    int numBytes,
    CompileEnv *envPtr)
{
    Tcl_Token token[2] =        {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
                                 {TCL_TOKEN_TEXT, NULL, 0, 0}};

    token[1].start = bytes;
    token[1].size = numBytes;







|







3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
    }
    return index;
}

int
TclLocalScalar(
    const char *bytes,
    size_t numBytes,
    CompileEnv *envPtr)
{
    Tcl_Token token[2] =        {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
                                 {TCL_TOKEN_TEXT, NULL, 0, 0}};

    token[1].start = bytes;
    token[1].size = numBytes;
3405
3406
3407
3408
3409
3410
3411
3412
3413

3414
3415
3416
3417
3418
3419
3420
3421
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int flags,			/* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
    int *localIndexPtr,		/* Must not be NULL. */
    int *isScalarPtr)		/* Must not be NULL. */
{
    register const char *p;
    const char *name, *elName;
    register int i, n;
    Tcl_Token *elemTokenPtr = NULL;

    int nameChars, elNameChars, simpleVarName, localIndex;
    int elemTokenCount = 0, allocedTokens = 0, removedParen = 0;

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace







|

>
|







3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int flags,			/* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
    int *localIndexPtr,		/* Must not be NULL. */
    int *isScalarPtr)		/* Must not be NULL. */
{
    register const char *p;
    const char *name, *elName;
    register size_t i, n;
    Tcl_Token *elemTokenPtr = NULL;
    size_t nameChars, elNameChars;
    int simpleVarName, localIndex;
    int elemTokenCount = 0, allocedTokens = 0, removedParen = 0;

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
		i < varTokenPtr[1].size; i++, p++) {
	    if (*p == '(') {
		simpleVarName = 1;
		break;
	    }
	}
	if (simpleVarName) {
	    int remainingChars;

	    /*
	     * Check the last token: if it is just ')', do not count it.
	     * Otherwise, remove the ')' and flag so that it is restored at
	     * the end.
	     */








|







3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
		i < varTokenPtr[1].size; i++, p++) {
	    if (*p == '(') {
		simpleVarName = 1;
		break;
	    }
	}
	if (simpleVarName) {
	    size_t remainingChars;

	    /*
	     * Check the last token: if it is just ')', do not count it.
	     * Otherwise, remove the ')' and flag so that it is restored at
	     * the end.
	     */

Changes to generic/tclCompCmdsGR.c.
177
178
179
180
181
182
183

184
185
186
187
188
189
190
191
				 * test when its target PC is determined. */
    JumpFixupArray jumpEndFixupArray;
				/* Used to fix the jump after each "then" body
				 * to the end of the "if" when that PC is
				 * determined. */
    Tcl_Token *tokenPtr, *testTokenPtr;
    int jumpIndex = 0;		/* Avoid compiler warning. */

    int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
    const char *word;
    int realCond = 1;		/* Set to 0 for static conditions:
				 * "if 0 {..}" */
    int boolVal;		/* Value of static condition. */
    int compileScripts = 1;
    DefineLineInformation;	/* TIP #280 */








>
|







177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
				 * test when its target PC is determined. */
    JumpFixupArray jumpEndFixupArray;
				/* Used to fix the jump after each "then" body
				 * to the end of the "if" when that PC is
				 * determined. */
    Tcl_Token *tokenPtr, *testTokenPtr;
    int jumpIndex = 0;		/* Avoid compiler warning. */
	size_t numBytes;
    int jumpFalseDist, numWords, wordIdx, j, code;
    const char *word;
    int realCond = 1;		/* Set to 0 for static conditions:
				 * "if 0 {..}" */
    int boolVal;		/* Value of static condition. */
    int compileScripts = 1;
    DefineLineInformation;	/* TIP #280 */

429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
		jumpFalseDist += 3;
		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else if (opCode == INST_JUMP_FALSE4) {
		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else {
		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
	    }
	}
    }

    /*
     * Free the jumpFixupArray array if malloc'ed storage was used.
     */







|







430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
		jumpFalseDist += 3;
		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else if (opCode == INST_JUMP_FALSE4) {
		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else {
		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%u\" updating ifFalse jump", opCode);
	    }
	}
    }

    /*
     * Free the jumpFixupArray array if malloc'ed storage was used.
     */
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509

    haveImmValue = 0;
    immValue = 1;
    if (parsePtr->numWords == 3) {
	incrTokenPtr = TokenAfter(varTokenPtr);
	if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    const char *word = incrTokenPtr[1].start;
	    int numBytes = incrTokenPtr[1].size;
	    int code;
	    Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes);

	    Tcl_IncrRefCount(intObj);
	    code = TclGetIntFromObj(NULL, intObj, &immValue);
	    TclDecrRefCount(intObj);
	    if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) {







|







496
497
498
499
500
501
502
503
504
505
506
507
508
509
510

    haveImmValue = 0;
    immValue = 1;
    if (parsePtr->numWords == 3) {
	incrTokenPtr = TokenAfter(varTokenPtr);
	if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    const char *word = incrTokenPtr[1].start;
	    size_t numBytes = incrTokenPtr[1].size;
	    int code;
	    Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes);

	    Tcl_IncrRefCount(intObj);
	    code = TclGetIntFromObj(NULL, intObj, &immValue);
	    TclDecrRefCount(intObj);
	    if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) {
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524


1525
1526
1527
1528
1529
1530
1531
1532
				 * command. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *tokenPtr, *listTokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int idx1, idx2, i, offset, offset2;
    int emptyPrefix=1, suffixStart = 0;

    if (parsePtr->numWords < 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    tokenPtr = TokenAfter(listTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
	    &idx1) != TCL_OK) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(tokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
	    &idx2) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * idx1, idx2 are the conventional encoded forms of the tokens parsed
     * as all forms of index values.  Values of idx1 that come before the
     * list are treated the same as if they were the start of the list.
     * Values of idx2 that come after the list are treated the same as if
     * they were the end of the list.
     */

    if (idx1 == TCL_INDEX_AFTER) {
	/*
	 * [lreplace] treats idx1 value end+1 differently from end+2, etc.
	 * The operand encoding cannot distinguish them, so we must bail
	 * out to direct evaluation.
	 */
	return TCL_ERROR;
    }

    /*
     * General structure of the [lreplace] result is
     *		prefix replacement suffix
     * In a few cases we can predict various parts will be empty and
     * take advantage.
     *
     * The proper suffix begins with the greater of indices idx1 or
     * idx2 + 1. If we cannot tell at compile time which is greater,
     * we must defer to direct evaluation.
     */



    if (idx2 == TCL_INDEX_BEFORE) {
	suffixStart = idx1;
    } else if (idx2 == TCL_INDEX_END) {
	suffixStart = TCL_INDEX_AFTER;
    } else if (((idx2 < TCL_INDEX_END) && (idx1 <= TCL_INDEX_END))
	    || ((idx2 >= TCL_INDEX_START) && (idx1 >= TCL_INDEX_START))) {
	suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1;
    } else {







|



















<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<











>
>
|







1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497

















1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
				 * command. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *tokenPtr, *listTokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int idx1, idx2, i;
    int emptyPrefix=1, suffixStart = 0;

    if (parsePtr->numWords < 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    tokenPtr = TokenAfter(listTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
	    &idx1) != TCL_OK) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(tokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
	    &idx2) != TCL_OK) {
	return TCL_ERROR;
    }


















    /*
     * General structure of the [lreplace] result is
     *		prefix replacement suffix
     * In a few cases we can predict various parts will be empty and
     * take advantage.
     *
     * The proper suffix begins with the greater of indices idx1 or
     * idx2 + 1. If we cannot tell at compile time which is greater,
     * we must defer to direct evaluation.
     */

    if (idx1 == TCL_INDEX_AFTER) {
	suffixStart = idx1;
    } else if (idx2 == TCL_INDEX_BEFORE) {
	suffixStart = idx1;
    } else if (idx2 == TCL_INDEX_END) {
	suffixStart = TCL_INDEX_AFTER;
    } else if (((idx2 < TCL_INDEX_END) && (idx1 <= TCL_INDEX_END))
	    || ((idx2 >= TCL_INDEX_START) && (idx1 >= TCL_INDEX_START))) {
	suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1;
    } else {
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599

	/* Make a list of them... */
	TclEmitInstInt4(	INST_LIST, i - 4,		envPtr);

	emptyPrefix = 0;
    }

    /*
     * [lreplace] raises an error when idx1 points after the list, but
     * only when the list is not empty. This is maximum stupidity.
     *
     * TODO: TIP this nonsense away!
     */
    if (idx1 >= TCL_INDEX_START) {
	if (emptyPrefix) {
	    TclEmitOpcode(	INST_DUP,			envPtr);
	} else {
	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	}
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	TclEmitOpcode(		INST_DUP,			envPtr);
	offset = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);

	/* List is not empty */
	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewIntObj(idx1),
							NULL),	envPtr);
	TclEmitOpcode(		INST_GT,			envPtr);
	offset2 = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);

	/* Idx1 >= list length ===> raise an error */
	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
		"list doesn't contain element %d", idx1), NULL), envPtr);
	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
		envPtr->codeStart + offset + 1);
	TclEmitOpcode(		INST_POP,			envPtr);
	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
		envPtr->codeStart + offset2 + 1);
    }

    if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
	/*
	 * This is a "no-op". Example: [lreplace {a b c} 2 0]
	 * We still do a list operation to get list-verification
	 * and canonicalization side effects.
	 */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







1536
1537
1538
1539
1540
1541
1542




































1543
1544
1545
1546
1547
1548
1549

	/* Make a list of them... */
	TclEmitInstInt4(	INST_LIST, i - 4,		envPtr);

	emptyPrefix = 0;
    }





































    if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
	/*
	 * This is a "no-op". Example: [lreplace {a b c} 2 0]
	 * We still do a list operation to get list-verification
	 * and canonicalization side effects.
	 */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
2127
2128
2129
2130
2131
2132
2133

2134
2135
2136
2137
2138
2139
2140
2141
				 * command. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
				 * parse of the RE or string. */

    int i, len, nocase, exact, sawLast, simple;
    const char *str;
    DefineLineInformation;	/* TIP #280 */

    /*
     * We are only interested in compiling simple regexp cases. Currently
     * supported compile cases are:
     *   regexp ?-nocase? ?--? staticString $var







>
|







2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
				 * command. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
				 * parse of the RE or string. */
    size_t len;
    int i, nocase, exact, sawLast, simple;
    const char *str;
    DefineLineInformation;	/* TIP #280 */

    /*
     * We are only interested in compiling simple regexp cases. Currently
     * supported compile cases are:
     *   regexp ?-nocase? ?--? staticString $var
2680
2681
2682
2683
2684
2685
2686
2687
2688

2689
2690
2691
2692
2693
2694
2695

void
TclCompileSyntaxError(
    Tcl_Interp *interp,
    CompileEnv *envPtr)
{
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    int numBytes;
    const char *bytes = TclGetStringFromObj(msg, &numBytes);


    TclErrorStackResetIf(interp, bytes, numBytes);
    TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr);
    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
    Tcl_ResetResult(interp);
}







<
|
>







2631
2632
2633
2634
2635
2636
2637

2638
2639
2640
2641
2642
2643
2644
2645
2646

void
TclCompileSyntaxError(
    Tcl_Interp *interp,
    CompileEnv *envPtr)
{
    Tcl_Obj *msg = Tcl_GetObjResult(interp);

    const char *bytes = TclGetString(msg);
    size_t numBytes = msg->length;

    TclErrorStackResetIf(interp, bytes, numBytes);
    TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr);
    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
    Tcl_ResetResult(interp);
}
Changes to generic/tclCompCmdsSZ.c.
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701

702
703
704
705
706
707
708
	} else {
	    OP(		NUM_TYPE);
	    OP(		DUP);
	    JUMP1(	JUMP_FALSE, end);
	}

	switch (t) {
	case STR_IS_INT:
	    PUSH(	"1");
	    OP(		EQ);
	    break;
	case STR_IS_WIDE:
	    PUSH(	"2");
	    OP(		LE);
	    break;

	case STR_IS_ENTIER:
	    PUSH(	"3");
	    OP(		LE);
	    break;
	}
	FIXJUMP1(	end);
	return TCL_OK;







<
<
<
<




>







687
688
689
690
691
692
693




694
695
696
697
698
699
700
701
702
703
704
705
	} else {
	    OP(		NUM_TYPE);
	    OP(		DUP);
	    JUMP1(	JUMP_FALSE, end);
	}

	switch (t) {




	case STR_IS_WIDE:
	    PUSH(	"2");
	    OP(		LE);
	    break;
	case STR_IS_INT:
	case STR_IS_ENTIER:
	    PUSH(	"3");
	    OP(		LE);
	    break;
	}
	FIXJUMP1(	end);
	return TCL_OK;
733
734
735
736
737
738
739

740
741
742
743
744
745
746
747
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    int i, length, exactMatch = 0, nocase = 0;
    const char *str;

    if (parsePtr->numWords < 3 || parsePtr->numWords > 4) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);








>
|







730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
	size_t length;
    int i, exactMatch = 0, nocase = 0;
    const char *str;

    if (parsePtr->numWords < 3 || parsePtr->numWords > 4) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);

1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
    return (character >= 0) && (character < 0x80);
}

static int
UniCharIsHexDigit(
    int character)
{
    return (character >= 0) && (character < 0x80) && isxdigit(character);
}

StringClassDesc const tclStringClassTable[] = {
    {"alnum",	Tcl_UniCharIsAlnum},
    {"alpha",	Tcl_UniCharIsAlpha},
    {"ascii",	UniCharIsAscii},
    {"control", Tcl_UniCharIsControl},







|







1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
    return (character >= 0) && (character < 0x80);
}

static int
UniCharIsHexDigit(
    int character)
{
    return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
}

StringClassDesc const tclStringClassTable[] = {
    {"alnum",	Tcl_UniCharIsAlnum},
    {"alpha",	Tcl_UniCharIsAlpha},
    {"ascii",	UniCharIsAscii},
    {"control", Tcl_UniCharIsControl},
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
    return TCL_OK;
}

void
TclSubstCompile(
    Tcl_Interp *interp,
    const char *bytes,
    int numBytes,
    int flags,
    int line,
    CompileEnv *envPtr)
{
    Tcl_Token *endTokenPtr, *tokenPtr;
    int breakOffset = 0, count = 0, bline = line;
    Tcl_Parse parse;







|







1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
    return TCL_OK;
}

void
TclSubstCompile(
    Tcl_Interp *interp,
    const char *bytes,
    size_t numBytes,
    int flags,
    int line,
    CompileEnv *envPtr)
{
    Tcl_Token *endTokenPtr, *tokenPtr;
    int breakOffset = 0, count = 0, bline = line;
    Tcl_Parse parse;
1522
1523
1524
1525
1526
1527
1528

1529
1530
1531
1532
1533
1534
1535
1536
	     * TCL_OK or TCL_ERROR from the substituted variable read; if so,
	     * there is no need to generate elaborate exception-management
	     * code. Note that the first component of TCL_TOKEN_VARIABLE is
	     * always TCL_TOKEN_TEXT...
	     */

	    if (tokenPtr->numComponents > 1) {

		int i, foundCommand = 0;

		for (i=2 ; i<=tokenPtr->numComponents ; i++) {
		    if (tokenPtr[i].type == TCL_TOKEN_COMMAND) {
			foundCommand = 1;
			break;
		    }
		}







>
|







1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
	     * TCL_OK or TCL_ERROR from the substituted variable read; if so,
	     * there is no need to generate elaborate exception-management
	     * code. Note that the first component of TCL_TOKEN_VARIABLE is
	     * always TCL_TOKEN_TEXT...
	     */

	    if (tokenPtr->numComponents > 1) {
		size_t i;	
		int foundCommand = 0;

		for (i=2 ; i<=tokenPtr->numComponents ; i++) {
		    if (tokenPtr[i].type == TCL_TOKEN_COMMAND) {
			foundCommand = 1;
			break;
		    }
		}
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576

	    /* Jump to the end (all BREAKs land here) */
	    breakOffset = CurrentOffset(envPtr);
	    TclEmitInstInt4(INST_JUMP4, 0, envPtr);

	    /* Start */
	    if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) {
		Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d",
			(int) (CurrentOffset(envPtr) - startFixup.codeOffset));
	    }
	}

	envPtr->line = bline;
	catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
	OP4(	BEGIN_CATCH4, catchRange);
	ExceptionRangeStarts(envPtr, catchRange);







|
|







1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575

	    /* Jump to the end (all BREAKs land here) */
	    breakOffset = CurrentOffset(envPtr);
	    TclEmitInstInt4(INST_JUMP4, 0, envPtr);

	    /* Start */
	    if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) {
		Tcl_Panic("TclCompileSubstCmd: bad start jump distance %" TCL_Z_MODIFIER "d",
			CurrentOffset(envPtr) - startFixup.codeOffset);
	    }
	}

	envPtr->line = bline;
	catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
	OP4(	BEGIN_CATCH4, catchRange);
	ExceptionRangeStarts(envPtr, catchRange);
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688

	/* OTHER */
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup);

	TclAdjustStackDepth(1, envPtr);
	/* BREAK destination */
	if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d",
		    (int) (CurrentOffset(envPtr) - breakFixup.codeOffset));
	}
	OP(	POP);
	OP(	POP);

	breakJump = CurrentOffset(envPtr) - breakOffset;
	if (breakJump > 127) {
	    OP4(JUMP4, -breakJump);
	} else {
	    OP1(JUMP1, -breakJump);
	}

	TclAdjustStackDepth(2, envPtr);
	/* CONTINUE destination */
	if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d",
		    (int) (CurrentOffset(envPtr) - continueFixup.codeOffset));
	}
	OP(	POP);
	OP(	POP);
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup);

	TclAdjustStackDepth(2, envPtr);
	/* RETURN + other destination */
	if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d",
		    (int) (CurrentOffset(envPtr) - returnFixup.codeOffset));
	}
	if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d",
		    (int) (CurrentOffset(envPtr) - otherFixup.codeOffset));
	}

	/*
	 * Pull the result to top of stack, discard options dict.
	 */

	OP4(	REVERSE, 2);
	OP(	POP);

	/* OK destination */
	if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d",
		    (int) (CurrentOffset(envPtr) - okFixup.codeOffset));
	}
	if (count > 1) {
	    OP1(STR_CONCAT1, count);
	    count = 1;
	}

	/* CONTINUE jump to here */
	if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d",
		    (int) (CurrentOffset(envPtr) - endFixup.codeOffset));
	}
	bline = envPtr->line;
    }

    while (count > 255) {
	OP1(	STR_CONCAT1, 255);
	count -= 254;







|
|














|
|








|
|


|
|











|
|








|
|







1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687

	/* OTHER */
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup);

	TclAdjustStackDepth(1, envPtr);
	/* BREAK destination */
	if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad break jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - breakFixup.codeOffset);
	}
	OP(	POP);
	OP(	POP);

	breakJump = CurrentOffset(envPtr) - breakOffset;
	if (breakJump > 127) {
	    OP4(JUMP4, -breakJump);
	} else {
	    OP1(JUMP1, -breakJump);
	}

	TclAdjustStackDepth(2, envPtr);
	/* CONTINUE destination */
	if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - continueFixup.codeOffset);
	}
	OP(	POP);
	OP(	POP);
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup);

	TclAdjustStackDepth(2, envPtr);
	/* RETURN + other destination */
	if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad return jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - returnFixup.codeOffset);
	}
	if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad other jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - otherFixup.codeOffset);
	}

	/*
	 * Pull the result to top of stack, discard options dict.
	 */

	OP4(	REVERSE, 2);
	OP(	POP);

	/* OK destination */
	if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - okFixup.codeOffset);
	}
	if (count > 1) {
	    OP1(STR_CONCAT1, count);
	    count = 1;
	}

	/* CONTINUE jump to here */
	if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad end jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - endFixup.codeOffset);
	}
	bline = envPtr->line;
    }

    while (count > 255) {
	OP1(	STR_CONCAT1, 255);
	count -= 254;
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
     * way to statically avoid the problems you get from strings-to-be-matched
     * that start with a - (the interpreted code falls apart if it encounters
     * them, so we punt if we *might* encounter them as that is the easiest
     * way of emulating the behaviour).
     */

    for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) {
	register unsigned size = tokenPtr[1].size;
	register const char *chrs = tokenPtr[1].start;

	/*
	 * We only process literal options, and we assume that -e, -g and -n
	 * are unique prefixes of -exact, -glob and -nocase respectively (true
	 * at time of writing). Note that -exact and -glob may only be given
	 * at most once or we bail out (error case).







|







1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
     * way to statically avoid the problems you get from strings-to-be-matched
     * that start with a - (the interpreted code falls apart if it encounters
     * them, so we punt if we *might* encounter them as that is the easiest
     * way of emulating the behaviour).
     */

    for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) {
	register size_t size = tokenPtr[1].size;
	register const char *chrs = tokenPtr[1].start;

	/*
	 * We only process literal options, and we assume that -e, -g and -n
	 * are unique prefixes of -exact, -glob and -nocase respectively (true
	 * at time of writing). Note that -exact and -glob may only be given
	 * at most once or we bail out (error case).
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
     * copies of the string from the input token for the generated tokens (it
     * causes a crash during exception handling). When multiple tokens are
     * available at this point, this is pretty easy.
     */

    if (numWords == 1) {
	const char *bytes;
	int maxLen, numBytes;
	int bline;		/* TIP #280: line of the pattern/action list,
				 * and start of list for when tracking the
				 * location. This list comes immediately after
				 * the value we switch on. */

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	bytes = tokenPtr[1].start;
	numBytes = tokenPtr[1].size;

	/* Allocate enough space to work in. */
	maxLen = TclMaxListLength(bytes, numBytes, NULL);
	if (maxLen < 2)  {
	    return TCL_ERROR;
	}
	bodyTokenArray = ckalloc(sizeof(Tcl_Token) * maxLen);
	bodyToken = ckalloc(sizeof(Tcl_Token *) * maxLen);
	bodyLines = ckalloc(sizeof(int) * maxLen);
	bodyContLines = ckalloc(sizeof(int*) * maxLen);

	bline = mapPtr->loc[eclIndex].line[valueIndex+1];
	numWords = 0;

	while (numBytes > 0) {
	    const char *prevBytes = bytes;
	    int literal;







|
















|
|
|
|







1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
     * copies of the string from the input token for the generated tokens (it
     * causes a crash during exception handling). When multiple tokens are
     * available at this point, this is pretty easy.
     */

    if (numWords == 1) {
	const char *bytes;
	size_t maxLen, numBytes;
	int bline;		/* TIP #280: line of the pattern/action list,
				 * and start of list for when tracking the
				 * location. This list comes immediately after
				 * the value we switch on. */

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	bytes = tokenPtr[1].start;
	numBytes = tokenPtr[1].size;

	/* Allocate enough space to work in. */
	maxLen = TclMaxListLength(bytes, numBytes, NULL);
	if (maxLen < 2)  {
	    return TCL_ERROR;
	}
	bodyTokenArray = Tcl_Alloc(sizeof(Tcl_Token) * maxLen);
	bodyToken = Tcl_Alloc(sizeof(Tcl_Token *) * maxLen);
	bodyLines = Tcl_Alloc(sizeof(int) * maxLen);
	bodyContLines = Tcl_Alloc(sizeof(int*) * maxLen);

	bline = mapPtr->loc[eclIndex].line[valueIndex+1];
	numWords = 0;

	while (numBytes > 0) {
	    const char *prevBytes = bytes;
	    int literal;
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
	    TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source);

	    numBytes -= (bytes - prevBytes);
	    numWords++;
	}
	if (numWords % 2) {
	abort:
	    ckfree(bodyToken);
	    ckfree(bodyTokenArray);
	    ckfree(bodyLines);
	    ckfree(bodyContLines);
	    return TCL_ERROR;
	}
    } else if (numWords % 2 || numWords == 0) {
	/*
	 * Odd number of words (>1) available, or no words at all available.
	 * Both are error cases, so punt and let the interpreted-version
	 * generate the error message. Note that the second case probably
	 * should get caught earlier, but it's easy to check here again anyway
	 * because it'd cause a nasty crash otherwise.
	 */

	return TCL_ERROR;
    } else {
	/*
	 * Multi-word definition of patterns & actions.
	 */

	bodyToken = ckalloc(sizeof(Tcl_Token *) * numWords);
	bodyLines = ckalloc(sizeof(int) * numWords);
	bodyContLines = ckalloc(sizeof(int*) * numWords);
	bodyTokenArray = NULL;
	for (i=0 ; i<numWords ; i++) {
	    /*
	     * We only handle the very simplest case. Anything more complex is
	     * a good reason to go to the interpreted case anyway due to
	     * traces, etc.
	     */







|
|
|
|

















|
|
|







1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
	    TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source);

	    numBytes -= (bytes - prevBytes);
	    numWords++;
	}
	if (numWords % 2) {
	abort:
	    Tcl_Free(bodyToken);
	    Tcl_Free(bodyTokenArray);
	    Tcl_Free(bodyLines);
	    Tcl_Free(bodyContLines);
	    return TCL_ERROR;
	}
    } else if (numWords % 2 || numWords == 0) {
	/*
	 * Odd number of words (>1) available, or no words at all available.
	 * Both are error cases, so punt and let the interpreted-version
	 * generate the error message. Note that the second case probably
	 * should get caught earlier, but it's easy to check here again anyway
	 * because it'd cause a nasty crash otherwise.
	 */

	return TCL_ERROR;
    } else {
	/*
	 * Multi-word definition of patterns & actions.
	 */

	bodyToken = Tcl_Alloc(sizeof(Tcl_Token *) * numWords);
	bodyLines = Tcl_Alloc(sizeof(int) * numWords);
	bodyContLines = Tcl_Alloc(sizeof(int*) * numWords);
	bodyTokenArray = NULL;
	for (i=0 ; i<numWords ; i++) {
	    /*
	     * We only handle the very simplest case. Anything more complex is
	     * a good reason to go to the interpreted case anyway due to
	     * traces, etc.
	     */
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
    result = TCL_OK;

    /*
     * Clean up all our temporary space and return.
     */

  freeTemporaries:
    ckfree(bodyToken);
    ckfree(bodyLines);
    ckfree(bodyContLines);
    if (bodyTokenArray != NULL) {
	ckfree(bodyTokenArray);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *







|
|
|

|







2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
    result = TCL_OK;

    /*
     * Clean up all our temporary space and return.
     */

  freeTemporaries:
    Tcl_Free(bodyToken);
    Tcl_Free(bodyLines);
    Tcl_Free(bodyContLines);
    if (bodyTokenArray != NULL) {
	Tcl_Free(bodyTokenArray);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
     * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
     * table itself is independent of any invokation of the bytecode, and as
     * such is stored in an auxData block.
     *
     * Start by allocating the jump table itself, plus some workspace.
     */

    jtPtr = ckalloc(sizeof(JumptableInfo));
    Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
    infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
    finalFixups = TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2));
    foundDefault = 0;
    mustGenerate = 1;

    /*







|







2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
     * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
     * table itself is independent of any invokation of the bytecode, and as
     * such is stored in an auxData block.
     *
     * Start by allocating the jump table itself, plus some workspace.
     */

    jtPtr = Tcl_Alloc(sizeof(JumptableInfo));
    Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
    infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
    finalFixups = TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2));
    foundDefault = 0;
    mustGenerate = 1;

    /*
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
 */

static ClientData
DupJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = clientData;
    JumptableInfo *newJtPtr = ckalloc(sizeof(JumptableInfo));
    Tcl_HashEntry *hPtr, *newHPtr;
    Tcl_HashSearch search;
    int isNew;

    Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS);
    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    while (hPtr != NULL) {







|







2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
 */

static ClientData
DupJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = clientData;
    JumptableInfo *newJtPtr = Tcl_Alloc(sizeof(JumptableInfo));
    Tcl_HashEntry *hPtr, *newHPtr;
    Tcl_HashSearch search;
    int isNew;

    Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS);
    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    while (hPtr != NULL) {
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
static void
FreeJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = clientData;

    Tcl_DeleteHashTable(&jtPtr->hashTable);
    ckfree(jtPtr);
}

static void
PrintJumptableInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,







|







2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
static void
FreeJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = clientData;

    Tcl_DeleteHashTable(&jtPtr->hashTable);
    Tcl_Free(jtPtr);
}

static void
PrintJumptableInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
Changes to generic/tclCompExpr.c.
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
 * Declarations for local functions to this file:
 */

static void		CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj *const **litObjvPtr,
			    Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr,
			    CompileEnv *envPtr, int optimize);
static void		ConvertTreeToTokens(const char *start, int numBytes,
			    OpNode *nodes, Tcl_Token *tokenPtr,
			    Tcl_Parse *parsePtr);
static int		ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj * const **litObjvPtr);
static int		ParseExpr(Tcl_Interp *interp, const char *start,
			    int numBytes, OpNode **opTreePtr,
			    Tcl_Obj *litList, Tcl_Obj *funcList,
			    Tcl_Parse *parsePtr, int parseOnly);
static int		ParseLexeme(const char *start, int numBytes,
			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);

/*
 *----------------------------------------------------------------------
 *
 * ParseExpr --
 *







|





|


|







497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
 * Declarations for local functions to this file:
 */

static void		CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj *const **litObjvPtr,
			    Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr,
			    CompileEnv *envPtr, int optimize);
static void		ConvertTreeToTokens(const char *start, size_t numBytes,
			    OpNode *nodes, Tcl_Token *tokenPtr,
			    Tcl_Parse *parsePtr);
static int		ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj * const **litObjvPtr);
static int		ParseExpr(Tcl_Interp *interp, const char *start,
			    size_t numBytes, OpNode **opTreePtr,
			    Tcl_Obj *litList, Tcl_Obj *funcList,
			    Tcl_Parse *parsePtr, int parseOnly);
static size_t		ParseLexeme(const char *start, size_t numBytes,
			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);

/*
 *----------------------------------------------------------------------
 *
 * ParseExpr --
 *
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
 *	last four arguments. If the string cannot be parsed as a valid Tcl
 *	expression, TCL_ERROR is returned, and if interp is non-NULL, an error
 *	message is written to interp.
 *
 * Side effects:
 *	Memory will be allocated. If TCL_OK is returned, the caller must clean
 *	up the returned data structures. The (OpNode *) value written to
 *	opTreePtr should be passed to ckfree() and the parsePtr argument
 *	should be passed to Tcl_FreeParse(). The elements appended to the
 *	litList and funcList will automatically be freed whenever the refcount
 *	on those lists indicates they can be freed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    int numBytes,		/* Number of bytes in string. */
    OpNode **opTreePtr,		/* Points to space where a pointer to the
				 * allocated OpNode tree should go. */
    Tcl_Obj *litList,		/* List to append literals to. */
    Tcl_Obj *funcList,		/* List to append function names to. */
    Tcl_Parse *parsePtr,	/* Structure to fill with tokens representing
				 * those operands that require run time
				 * substitutions. */







|











|







532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
 *	last four arguments. If the string cannot be parsed as a valid Tcl
 *	expression, TCL_ERROR is returned, and if interp is non-NULL, an error
 *	message is written to interp.
 *
 * Side effects:
 *	Memory will be allocated. If TCL_OK is returned, the caller must clean
 *	up the returned data structures. The (OpNode *) value written to
 *	opTreePtr should be passed to Tcl_Free() and the parsePtr argument
 *	should be passed to Tcl_FreeParse(). The elements appended to the
 *	litList and funcList will automatically be freed whenever the refcount
 *	on those lists indicates they can be freed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    size_t numBytes,		/* Number of bytes in string. */
    OpNode **opTreePtr,		/* Points to space where a pointer to the
				 * allocated OpNode tree should go. */
    Tcl_Obj *litList,		/* List to append literals to. */
    Tcl_Obj *funcList,		/* List to append function names to. */
    Tcl_Parse *parsePtr,	/* Structure to fill with tokens representing
				 * those operands that require run time
				 * substitutions. */
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
    unsigned int nodesAvailable = 64; /* Initial size of the storage array. This
				 * value establishes a minimum tree memory
				 * cost of only about 1 kibyte, and is large
				 * enough for most expressions to parse with
				 * no need for array growth and
				 * reallocation. */
    unsigned int nodesUsed = 0;	/* Number of OpNodes filled. */
    int scanned = 0;		/* Capture number of byte scanned by parsing
				 * routines. */
    int lastParsed;		/* Stores info about what the lexeme parsed
				 * the previous pass through the parsing loop
				 * was. If it was an operator, lastParsed is
				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
				 * an OperandTypes value encoding what we need







|







567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
    unsigned int nodesAvailable = 64; /* Initial size of the storage array. This
				 * value establishes a minimum tree memory
				 * cost of only about 1 kibyte, and is large
				 * enough for most expressions to parse with
				 * no need for array growth and
				 * reallocation. */
    unsigned int nodesUsed = 0;	/* Number of OpNodes filled. */
    size_t scanned = 0;		/* Capture number of byte scanned by parsing
				 * routines. */
    int lastParsed;		/* Stores info about what the lexeme parsed
				 * the previous pass through the parsing loop
				 * was. If it was an operator, lastParsed is
				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
				 * an OperandTypes value encoding what we need
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
				 * message where the error location is
				 * reported, this "mark" substring is inserted
				 * into the string being parsed to aid in
				 * pinpointing the location of the syntax
				 * error in the expression. */
    int insertMark = 0;		/* A boolean controlling whether the "mark"
				 * should be inserted. */
    const int limit = 25;	/* Portions of the error message are
				 * constructed out of substrings of the
				 * original expression. In order to keep the
				 * error message readable, we impose this
				 * limit on the substring size we extract. */

    TclParseInit(interp, start, numBytes, parsePtr);

    nodes = attemptckalloc(nodesAvailable * sizeof(OpNode));
    if (nodes == NULL) {
	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
	errCode = "NOMEM";
	goto error;
    }

    /*







|







|







611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
				 * message where the error location is
				 * reported, this "mark" substring is inserted
				 * into the string being parsed to aid in
				 * pinpointing the location of the syntax
				 * error in the expression. */
    int insertMark = 0;		/* A boolean controlling whether the "mark"
				 * should be inserted. */
    const unsigned limit = 25;	/* Portions of the error message are
				 * constructed out of substrings of the
				 * original expression. In order to keep the
				 * error message readable, we impose this
				 * limit on the substring size we extract. */

    TclParseInit(interp, start, numBytes, parsePtr);

    nodes = Tcl_AttemptAlloc(nodesAvailable * sizeof(OpNode));
    if (nodes == NULL) {
	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
	errCode = "NOMEM";
	goto error;
    }

    /*
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677

	if (nodesUsed >= nodesAvailable) {
	    unsigned int size = nodesUsed * 2;
	    OpNode *newPtr = NULL;

	    do {
	      if (size <= UINT_MAX/sizeof(OpNode)) {
		newPtr = attemptckrealloc(nodes, size * sizeof(OpNode));
	      }
	    } while ((newPtr == NULL)
		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
	    if (newPtr == NULL) {
		TclNewLiteralStringObj(msg,
			"not enough memory to parse expression");
		errCode = "NOMEM";







|







663
664
665
666
667
668
669
670
671
672
673
674
675
676
677

	if (nodesUsed >= nodesAvailable) {
	    unsigned int size = nodesUsed * 2;
	    OpNode *newPtr = NULL;

	    do {
	      if (size <= UINT_MAX/sizeof(OpNode)) {
		newPtr = Tcl_AttemptRealloc(nodes, size * sizeof(OpNode));
	      }
	    } while ((newPtr == NULL)
		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
	    if (newPtr == NULL) {
		TclNewLiteralStringObj(msg,
			"not enough memory to parse expression");
		errCode = "NOMEM";
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717

	if ((NODE_TYPE & lexeme) == 0) {
	    int b;

	    switch (lexeme) {
	    case INVALID:
		msg = Tcl_ObjPrintf("invalid character \"%.*s\"",
			scanned, start);
		errCode = "BADCHAR";
		goto error;
	    case INCOMPLETE:
		msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"",
			scanned, start);
		errCode = "PARTOP";
		goto error;
	    case BAREWORD:

		/*
		 * Most barewords in an expression are a syntax error. The
		 * exceptions are that when a bareword is followed by an open







|




|







698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717

	if ((NODE_TYPE & lexeme) == 0) {
	    int b;

	    switch (lexeme) {
	    case INVALID:
		msg = Tcl_ObjPrintf("invalid character \"%.*s\"",
			(int)scanned, start);
		errCode = "BADCHAR";
		goto error;
	    case INCOMPLETE:
		msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"",
			(int)scanned, start);
		errCode = "PARTOP";
		goto error;
	    case BAREWORD:

		/*
		 * Most barewords in an expression are a syntax error. The
		 * exceptions are that when a bareword is followed by an open
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755

		    Tcl_ListObjAppendElement(NULL, funcList, literal);
		} else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
		    lexeme = BOOLEAN;
		} else {
		    Tcl_DecrRefCount(literal);
		    msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"",
			    (scanned < limit) ? scanned : limit - 3, start,
			    (scanned < limit) ? "" : "...");
		    post = Tcl_ObjPrintf(
			    "should be \"$%.*s%s\" or \"{%.*s%s}\"",
			    (scanned < limit) ? scanned : limit - 3,
			    start, (scanned < limit) ? "" : "...",
			    (scanned < limit) ? scanned : limit - 3,
			    start, (scanned < limit) ? "" : "...");
		    Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...",
			    (scanned < limit) ? scanned : limit - 3,
			    start, (scanned < limit) ? "" : "...");
		    errCode = "BAREWORD";
		    if (start[0] == '0') {
			const char *stop;
			TclParseNumber(NULL, NULL, NULL, start, scanned,
				&stop, TCL_PARSE_NO_WHITESPACE);








|



|

|


|







732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755

		    Tcl_ListObjAppendElement(NULL, funcList, literal);
		} else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
		    lexeme = BOOLEAN;
		} else {
		    Tcl_DecrRefCount(literal);
		    msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"",
			    (scanned < limit) ? (int)scanned : (int)limit - 3, start,
			    (scanned < limit) ? "" : "...");
		    post = Tcl_ObjPrintf(
			    "should be \"$%.*s%s\" or \"{%.*s%s}\"",
			    (scanned < limit) ? (int)scanned : (int)limit - 3,
			    start, (scanned < limit) ? "" : "...",
			    (scanned < limit) ? (int)scanned : (int)limit - 3,
			    start, (scanned < limit) ? "" : "...");
		    Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...",
			    (scanned < limit) ? (int)scanned : (int)limit - 3,
			    start, (scanned < limit) ? "" : "...");
		    errCode = "BAREWORD";
		    if (start[0] == '0') {
			const char *stop;
			TclParseNumber(NULL, NULL, NULL, start, scanned,
				&stop, TCL_PARSE_NO_WHITESPACE);

1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
    }

    /*
     * Free any partial parse tree we've built.
     */

    if (nodes != NULL) {
	ckfree(nodes);
    }

    if (interp == NULL) {
	/*
	 * Nowhere to report an error message, so just free it.
	 */








|







1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
    }

    /*
     * Free any partial parse tree we've built.
     */

    if (nodes != NULL) {
	Tcl_Free(nodes);
    }

    if (interp == NULL) {
	/*
	 * Nowhere to report an error message, so just free it.
	 */

1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
	 * Add a detailed quote from the bad expression, displaying and
	 * sometimes marking the precise location of the syntax error.
	 */

	Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
		((start - limit) < parsePtr->string) ? "" : "...",
		((start - limit) < parsePtr->string)
			? (int) (start - parsePtr->string) : limit - 3,
		((start - limit) < parsePtr->string)
			? parsePtr->string : start - limit + 3,
		(scanned < limit) ? scanned : limit - 3, start,
		(scanned < limit) ? "" : "...", insertMark ? mark : "",
		(start + scanned + limit > parsePtr->end)
			? (int) (parsePtr->end - start) - scanned : limit-3,
		start + scanned,
		(start + scanned + limit > parsePtr->end) ? "" : "...");

	/*
	 * Next, append any postscript message.
	 */








|


|


|







1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
	 * Add a detailed quote from the bad expression, displaying and
	 * sometimes marking the precise location of the syntax error.
	 */

	Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
		((start - limit) < parsePtr->string) ? "" : "...",
		((start - limit) < parsePtr->string)
			? (int) (start - parsePtr->string) : (int)limit - 3,
		((start - limit) < parsePtr->string)
			? parsePtr->string : start - limit + 3,
		(scanned < limit) ? (int)scanned : (int)limit - 3, start,
		(scanned < limit) ? "" : "...", insertMark ? mark : "",
		(start + scanned + limit > parsePtr->end)
			? (int) (parsePtr->end - start) - (int)scanned : (int)limit-3,
		start + scanned,
		(start + scanned + limit > parsePtr->end) ? "" : "...");

	/*
	 * Next, append any postscript message.
	 */

1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
	/*
	 * Finally, place context information in the errorInfo.
	 */

	numBytes = parsePtr->end - parsePtr->string;
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (parsing expression \"%.*s%s\")",
		(numBytes < limit) ? numBytes : limit - 3,
		parsePtr->string, (numBytes < limit) ? "" : "..."));
	if (errCode) {
	    Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode,
		    subErrCode, NULL);
	}
    }








|







1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
	/*
	 * Finally, place context information in the errorInfo.
	 */

	numBytes = parsePtr->end - parsePtr->string;
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (parsing expression \"%.*s%s\")",
		(numBytes < limit) ? (int)numBytes : (int)limit - 3,
		parsePtr->string, (numBytes < limit) ? "" : "..."));
	if (errCode) {
	    Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode,
		    subErrCode, NULL);
	}
    }

1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
 *
 *----------------------------------------------------------------------
 */

static void
ConvertTreeToTokens(
    const char *start,
    int numBytes,
    OpNode *nodes,
    Tcl_Token *tokenPtr,
    Tcl_Parse *parsePtr)
{
    int subExprTokenIdx = 0;
    OpNode *nodePtr = nodes;
    int next = nodePtr->right;







|







1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
 *
 *----------------------------------------------------------------------
 */

static void
ConvertTreeToTokens(
    const char *start,
    size_t numBytes,
    OpNode *nodes,
    Tcl_Token *tokenPtr,
    Tcl_Parse *parsePtr)
{
    int subExprTokenIdx = 0;
    OpNode *nodePtr = nodes;
    int next = nodePtr->right;
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
		 */

		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
		subExprTokenPtr->size = start - subExprTokenPtr->start;

		/*
		 * All the Tcl_Tokens allocated and filled belong to
		 * this subexpresion. The first token is the leading
		 * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
		 * are its components.
		 */

		subExprTokenPtr->numComponents =
			(parsePtr->numTokens - subExprTokenIdx) - 1;








|







1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
		 */

		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
		subExprTokenPtr->size = start - subExprTokenPtr->start;

		/*
		 * All the Tcl_Tokens allocated and filled belong to
		 * this subexpression. The first token is the leading
		 * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
		 * are its components.
		 */

		subExprTokenPtr->numComponents =
			(parsePtr->numTokens - subExprTokenIdx) - 1;

1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
 *----------------------------------------------------------------------
 */

int
Tcl_ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    int numBytes,		/* Number of bytes in string. If < 0, the
				 * string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr)	/* Structure to fill with information about
				 * the parsed expression; any previous
				 * information in the structure is ignored. */
{
    int code;
    OpNode *opTree = NULL;	/* Will point to the tree of operators. */
    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals. */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names. */
    Tcl_Parse *exprParsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions. */

    if (numBytes < 0) {
	numBytes = (start ? strlen(start) : 0);
    }

    code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList,
	    exprParsePtr, 1 /* parseOnly */);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);

    TclParseInit(interp, start, numBytes, parsePtr);
    if (code == TCL_OK) {
	ConvertTreeToTokens(start, numBytes,
		opTree, exprParsePtr->tokenPtr, parsePtr);
    } else {
	parsePtr->term = exprParsePtr->term;
	parsePtr->errorType = exprParsePtr->errorType;
    }

    Tcl_FreeParse(exprParsePtr);
    TclStackFree(interp, exprParsePtr);
    ckfree(opTree);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseLexeme --
 *
 *	Parse a single lexeme from the start of a string, scanning no more
 *	than numBytes bytes.
 *
 * Results:
 *	Returns the number of bytes scanned to produce the lexeme.
 *
 * Side effects:
 *	Code identifying lexeme parsed is writen to *lexemePtr.
 *
 *----------------------------------------------------------------------
 */

static int
ParseLexeme(
    const char *start,		/* Start of lexeme to parse. */
    int numBytes,		/* Number of bytes in string. */
    unsigned char *lexemePtr,	/* Write code of parsed lexeme to this
				 * storage. */
    Tcl_Obj **literalPtr)	/* Write corresponding literal value to this
				   storage, if non-NULL. */
{
    const char *end;
    int scanned;
    Tcl_UniChar ch = 0;
    Tcl_Obj *literal = NULL;
    unsigned char byte;

    if (numBytes == 0) {
	*lexemePtr = END;
	return 0;







|













|



















|




















|


|






<







1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886

1887
1888
1889
1890
1891
1892
1893
 *----------------------------------------------------------------------
 */

int
Tcl_ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    size_t numBytes,		/* Number of bytes in string. If -1, the
				 * string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr)	/* Structure to fill with information about
				 * the parsed expression; any previous
				 * information in the structure is ignored. */
{
    int code;
    OpNode *opTree = NULL;	/* Will point to the tree of operators. */
    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals. */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names. */
    Tcl_Parse *exprParsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions. */

    if (numBytes == TCL_AUTO_LENGTH) {
	numBytes = (start ? strlen(start) : 0);
    }

    code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList,
	    exprParsePtr, 1 /* parseOnly */);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);

    TclParseInit(interp, start, numBytes, parsePtr);
    if (code == TCL_OK) {
	ConvertTreeToTokens(start, numBytes,
		opTree, exprParsePtr->tokenPtr, parsePtr);
    } else {
	parsePtr->term = exprParsePtr->term;
	parsePtr->errorType = exprParsePtr->errorType;
    }

    Tcl_FreeParse(exprParsePtr);
    TclStackFree(interp, exprParsePtr);
    Tcl_Free(opTree);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseLexeme --
 *
 *	Parse a single lexeme from the start of a string, scanning no more
 *	than numBytes bytes.
 *
 * Results:
 *	Returns the number of bytes scanned to produce the lexeme.
 *
 * Side effects:
 *	Code identifying lexeme parsed is writen to *lexemePtr.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseLexeme(
    const char *start,		/* Start of lexeme to parse. */
    size_t numBytes,		/* Number of bytes in string. */
    unsigned char *lexemePtr,	/* Write code of parsed lexeme to this
				 * storage. */
    Tcl_Obj **literalPtr)	/* Write corresponding literal value to this
				   storage, if non-NULL. */
{
    const char *end;

    Tcl_UniChar ch = 0;
    Tcl_Obj *literal = NULL;
    unsigned char byte;

    if (numBytes == 0) {
	*lexemePtr = END;
	return 0;
2059
2060
2061
2062
2063
2064
2065

2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
    /*
     * We reject leading underscores in bareword.  No sensible reason why.
     * Might be inspired by reserved identifier rules in C, which of course
     * have no direct relevance here.
     */

    if (!TclIsBareword(*start) || *start == '_') {

	if (Tcl_UtfCharComplete(start, numBytes)) {
	    scanned = TclUtfToUniChar(start, &ch);
	} else {
	    char utfBytes[TCL_UTF_MAX];

	    memcpy(utfBytes, start, (size_t) numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = TclUtfToUniChar(utfBytes, &ch);
	}
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }







>





|







2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
    /*
     * We reject leading underscores in bareword.  No sensible reason why.
     * Might be inspired by reserved identifier rules in C, which of course
     * have no direct relevance here.
     */

    if (!TclIsBareword(*start) || *start == '_') {
	size_t scanned;
	if (Tcl_UtfCharComplete(start, numBytes)) {
	    scanned = TclUtfToUniChar(start, &ch);
	} else {
	    char utfBytes[TCL_UTF_MAX];

	    memcpy(utfBytes, start, numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = TclUtfToUniChar(utfBytes, &ch);
	}
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
 *----------------------------------------------------------------------
 */

void
TclCompileExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *script,		/* The source script to compile. */
    int numBytes,		/* Number of bytes in script. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int optimize)		/* 0 for one-off expressions. */
{
    OpNode *opTree = NULL;	/* Will point to the tree of operators */
    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));







|







2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
 *----------------------------------------------------------------------
 */

void
TclCompileExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *script,		/* The source script to compile. */
    size_t numBytes,		/* Number of bytes in script. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int optimize)		/* 0 for one-off expressions. */
{
    OpNode *opTree = NULL;	/* Will point to the tree of operators */
    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
	TclCompileSyntaxError(interp, envPtr);
    }

    Tcl_FreeParse(parsePtr);
    TclStackFree(interp, parsePtr);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);
    ckfree(opTree);
}

/*
 *----------------------------------------------------------------------
 *
 * ExecConstantExprTree --
 *	Compiles and executes bytecode for the subexpression tree at index







|







2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
	TclCompileSyntaxError(interp, envPtr);
    }

    Tcl_FreeParse(parsePtr);
    TclStackFree(interp, parsePtr);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);
    Tcl_Free(opTree);
}

/*
 *----------------------------------------------------------------------
 *
 * ExecConstantExprTree --
 *	Compiles and executes bytecode for the subexpression tree at index
Changes to generic/tclCompile.c.
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
    }

    if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) {
	TclFreeLocalCache(interp, codePtr->localCachePtr);
    }

    TclHandleRelease(codePtr->interpHandle);
    ckfree(codePtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * IsCompactibleCompileEnv --
 *







|







1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
    }

    if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) {
	TclFreeLocalCache(interp, codePtr->localCachePtr);
    }

    TclHandleRelease(codePtr->interpHandle);
    Tcl_Free(codePtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * IsCompactibleCompileEnv --
 *
1298
1299
1300
1301
1302
1303
1304
1305
1306

1307
1308
1309
1310
1311
1312
1313
		|| (codePtr->localCachePtr !=
		iPtr->varFramePtr->localCachePtr)) {
	    TclFreeIntRep(objPtr);
	}
    }
    if (objPtr->typePtr != &substCodeType) {
	CompileEnv compEnv;
	int numBytes;
	const char *bytes = TclGetStringFromObj(objPtr, &numBytes);


	/* TODO: Check for more TIP 280 */
	TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);

	TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);

	TclEmitOpcode(INST_DONE, &compEnv);







<
|
>







1298
1299
1300
1301
1302
1303
1304

1305
1306
1307
1308
1309
1310
1311
1312
1313
		|| (codePtr->localCachePtr !=
		iPtr->varFramePtr->localCachePtr)) {
	    TclFreeIntRep(objPtr);
	}
    }
    if (objPtr->typePtr != &substCodeType) {
	CompileEnv compEnv;

	const char *bytes = TclGetString(objPtr);
	size_t numBytes = objPtr->length;

	/* TODO: Check for more TIP 280 */
	TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);

	TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);

	TclEmitOpcode(INST_DONE, &compEnv);
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
{
    int i;

    if (eclPtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eclPtr->path);
    }
    for (i=0 ; i<eclPtr->nuloc ; i++) {
	ckfree(eclPtr->loc[i].line);
    }

    if (eclPtr->loc != NULL) {
	ckfree(eclPtr->loc);
    }

    ckfree(eclPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitCompileEnv --
 *







|



|


|







1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
{
    int i;

    if (eclPtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eclPtr->path);
    }
    for (i=0 ; i<eclPtr->nuloc ; i++) {
	Tcl_Free(eclPtr->loc[i].line);
    }

    if (eclPtr->loc != NULL) {
	Tcl_Free(eclPtr->loc);
    }

    Tcl_Free(eclPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitCompileEnv --
 *
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
void
TclInitCompileEnv(
    Tcl_Interp *interp,		/* The interpreter for which a CompileEnv
				 * structure is initialized. */
    register CompileEnv *envPtr,/* Points to the CompileEnv structure to
				 * initialize. */
    const char *stringPtr,	/* The source string to be compiled. */
    int numBytes,		/* Number of bytes in source string. */
    const CmdFrame *invoker,	/* Location context invoking the bcc */
    int word)			/* Index of the word in that context getting
				 * compiled */
{
    Interp *iPtr = (Interp *) interp;

    assert(tclInstructionTable[LAST_INST_OPCODE].name == NULL);







|







1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
void
TclInitCompileEnv(
    Tcl_Interp *interp,		/* The interpreter for which a CompileEnv
				 * structure is initialized. */
    register CompileEnv *envPtr,/* Points to the CompileEnv structure to
				 * initialize. */
    const char *stringPtr,	/* The source string to be compiled. */
    size_t numBytes,		/* Number of bytes in source string. */
    const CmdFrame *invoker,	/* Location context invoking the bcc */
    int word)			/* Index of the word in that context getting
				 * compiled */
{
    Interp *iPtr = (Interp *) interp;

    assert(tclInstructionTable[LAST_INST_OPCODE].name == NULL);
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
     * the context invoking the byte code compiler. This structure is used to
     * keep the per-word line information for all compiled commands.
     *
     * See also tclBasic.c, TclEvalObjEx, for the equivalent code in the
     * non-compiling evaluator
     */

    envPtr->extCmdMapPtr = ckalloc(sizeof(ExtCmdLoc));
    envPtr->extCmdMapPtr->loc = NULL;
    envPtr->extCmdMapPtr->nloc = 0;
    envPtr->extCmdMapPtr->nuloc = 0;
    envPtr->extCmdMapPtr->path = NULL;

    if (invoker == NULL) {
	/*







|







1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
     * the context invoking the byte code compiler. This structure is used to
     * keep the per-word line information for all compiled commands.
     *
     * See also tclBasic.c, TclEvalObjEx, for the equivalent code in the
     * non-compiling evaluator
     */

    envPtr->extCmdMapPtr = Tcl_Alloc(sizeof(ExtCmdLoc));
    envPtr->extCmdMapPtr->loc = NULL;
    envPtr->extCmdMapPtr->nloc = 0;
    envPtr->extCmdMapPtr->nuloc = 0;
    envPtr->extCmdMapPtr->path = NULL;

    if (invoker == NULL) {
	/*
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
 */

void
TclFreeCompileEnv(
    register CompileEnv *envPtr)/* Points to the CompileEnv structure. */
{
    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){
	ckfree(envPtr->localLitTable.buckets);
	envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
    }
    if (envPtr->iPtr) {
	/*
	 * We never converted to Bytecode, so free the things we would
	 * have transferred to it.
	 */







|







1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
 */

void
TclFreeCompileEnv(
    register CompileEnv *envPtr)/* Points to the CompileEnv structure. */
{
    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){
	Tcl_Free(envPtr->localLitTable.buckets);
	envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
    }
    if (envPtr->iPtr) {
	/*
	 * We never converted to Bytecode, so free the things we would
	 * have transferred to it.
	 */
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
	    if (auxDataPtr->type->freeProc != NULL) {
		auxDataPtr->type->freeProc(auxDataPtr->clientData);
	    }
	    auxDataPtr++;
	}
    }
    if (envPtr->mallocedCodeArray) {
	ckfree(envPtr->codeStart);
    }
    if (envPtr->mallocedLiteralArray) {
	ckfree(envPtr->literalArrayPtr);
    }
    if (envPtr->mallocedExceptArray) {
	ckfree(envPtr->exceptArrayPtr);
	ckfree(envPtr->exceptAuxArrayPtr);
    }
    if (envPtr->mallocedCmdMap) {
	ckfree(envPtr->cmdMapPtr);
    }
    if (envPtr->mallocedAuxDataArray) {
	ckfree(envPtr->auxDataArrayPtr);
    }
    if (envPtr->extCmdMapPtr) {
	ReleaseCmdWordData(envPtr->extCmdMapPtr);
	envPtr->extCmdMapPtr = NULL;
    }
}








|


|


|
|


|


|







1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
	    if (auxDataPtr->type->freeProc != NULL) {
		auxDataPtr->type->freeProc(auxDataPtr->clientData);
	    }
	    auxDataPtr++;
	}
    }
    if (envPtr->mallocedCodeArray) {
	Tcl_Free(envPtr->codeStart);
    }
    if (envPtr->mallocedLiteralArray) {
	Tcl_Free(envPtr->literalArrayPtr);
    }
    if (envPtr->mallocedExceptArray) {
	Tcl_Free(envPtr->exceptArrayPtr);
	Tcl_Free(envPtr->exceptAuxArrayPtr);
    }
    if (envPtr->mallocedCmdMap) {
	Tcl_Free(envPtr->cmdMapPtr);
    }
    if (envPtr->mallocedAuxDataArray) {
	Tcl_Free(envPtr->auxDataArrayPtr);
    }
    if (envPtr->extCmdMapPtr) {
	ReleaseCmdWordData(envPtr->extCmdMapPtr);
	envPtr->extCmdMapPtr = NULL;
    }
}

1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801

static void
CompileCmdLiteral(
    Tcl_Interp *interp,
    Tcl_Obj *cmdObj,
    CompileEnv *envPtr)
{
    int numBytes;
    const char *bytes;
    Command *cmdPtr;
    int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }

    bytes = TclGetStringFromObj(cmdObj, &numBytes);
    cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags);

    if (cmdPtr) {
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
    }
    TclEmitPush(cmdLitIdx, envPtr);
}








<









|
|







1776
1777
1778
1779
1780
1781
1782

1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800

static void
CompileCmdLiteral(
    Tcl_Interp *interp,
    Tcl_Obj *cmdObj,
    CompileEnv *envPtr)
{

    const char *bytes;
    Command *cmdPtr;
    int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }

    bytes = TclGetString(cmdObj);
    cmdLitIdx = TclRegisterLiteral(envPtr, bytes, cmdObj->length, extraLiteralFlags);

    if (cmdPtr) {
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
    }
    TclEmitPush(cmdLitIdx, envPtr);
}

1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982

    /*
     * Throw out any line information generated by the failed compile attempt.
     */

    while (mapPtr->nuloc - 1 > eclIndex) {
	mapPtr->nuloc--;
	ckfree(mapPtr->loc[mapPtr->nuloc].line);
	mapPtr->loc[mapPtr->nuloc].line = NULL;
    }

    /*
     * Reset the index of next command.  Toss out any from failed nested
     * partial compiles.
     */







|







1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981

    /*
     * Throw out any line information generated by the failed compile attempt.
     */

    while (mapPtr->nuloc - 1 > eclIndex) {
	mapPtr->nuloc--;
	Tcl_Free(mapPtr->loc[mapPtr->nuloc].line);
	mapPtr->loc[mapPtr->nuloc].line = NULL;
    }

    /*
     * Reset the index of next command.  Toss out any from failed nested
     * partial compiles.
     */
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
    /*
     * TIP #280: Free full form of per-word line data and insert the reduced
     * form now
     */

    envPtr->line = cmdLine;
    envPtr->clNext = clNext;
    ckfree(eclPtr->loc[wlineat].line);
    ckfree(eclPtr->loc[wlineat].next);
    eclPtr->loc[wlineat].line = wlines;
    eclPtr->loc[wlineat].next = NULL;

    TclCheckStackDepth(depth, envPtr);
    return cmdIdx;
}

void
TclCompileScript(
    Tcl_Interp *interp,		/* Used for error and status reporting. Also
				 * serves as context for finding and compiling
				 * commands. May not be NULL. */
    const char *script,		/* The source script to compile. */
    int numBytes,		/* Number of bytes in script. If < 0, the
				 * script consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
				 * command this routine compiles into bytecode.
				 * Initial value of -1 indicates this routine
				 * has not yet generated any bytecode. */
    const char *p = script;	/* Where we are in our compile. */
    int depth = TclGetStackDepth(envPtr);

    if (envPtr->iPtr == NULL) {
	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
    }

    /* Each iteration compiles one command from the script. */

    while (numBytes > 0) {
	Tcl_Parse parse;
	const char *next;

	if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) {
	    /*
	     * Compile bytecodes to report the parse error at runtime.
	     */







|
|













|

















|







2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
    /*
     * TIP #280: Free full form of per-word line data and insert the reduced
     * form now
     */

    envPtr->line = cmdLine;
    envPtr->clNext = clNext;
    Tcl_Free(eclPtr->loc[wlineat].line);
    Tcl_Free(eclPtr->loc[wlineat].next);
    eclPtr->loc[wlineat].line = wlines;
    eclPtr->loc[wlineat].next = NULL;

    TclCheckStackDepth(depth, envPtr);
    return cmdIdx;
}

void
TclCompileScript(
    Tcl_Interp *interp,		/* Used for error and status reporting. Also
				 * serves as context for finding and compiling
				 * commands. May not be NULL. */
    const char *script,		/* The source script to compile. */
    size_t numBytes,		/* Number of bytes in script. If -1, the
				 * script consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
				 * command this routine compiles into bytecode.
				 * Initial value of -1 indicates this routine
				 * has not yet generated any bytecode. */
    const char *p = script;	/* Where we are in our compile. */
    int depth = TclGetStackDepth(envPtr);

    if (envPtr->iPtr == NULL) {
	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
    }

    /* Each iteration compiles one command from the script. */

    while (numBytes + 1 > 1) {
	Tcl_Parse parse;
	const char *next;

	if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) {
	    /*
	     * Compile bytecodes to report the parse error at runtime.
	     */
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
void
TclCompileVarSubst(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    CompileEnv *envPtr)
{
    const char *p, *name = tokenPtr[1].start;
    int nameBytes = tokenPtr[1].size;
    int i, localVar, localVarName = 1;

    /*
     * Determine how the variable name should be handled: if it contains any
     * namespace qualifiers it is not a local variable (localVarName=-1); if
     * it looks like an array element and the token has a single component, it
     * should not be created here [Bug 569438] (localVarName=0); otherwise,
     * the local variable can safely be created (localVarName=1).







|
|







2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
void
TclCompileVarSubst(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    CompileEnv *envPtr)
{
    const char *p, *name = tokenPtr[1].start;
    size_t i, nameBytes = tokenPtr[1].size;
    int localVar, localVarName = 1;

    /*
     * Determine how the variable name should be handled: if it contains any
     * namespace qualifiers it is not a local variable (localVarName=-1); if
     * it looks like an array element and the token has a single component, it
     * should not be created here [Bug 569438] (localVarName=0); otherwise,
     * the local variable can safely be created (localVarName=1).
2329
2330
2331
2332
2333
2334
2335
2336

2337
2338
2339
2340
2341
2342
2343
    int count,			/* 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[TCL_UTF_MAX];
    int i, numObjsToConcat, length, adjust;

    unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL;
    int *clPosition = NULL;
    int depth = TclGetStackDepth(envPtr);

    /*







|
>







2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
    int count,			/* 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[TCL_UTF_MAX];
    int i, numObjsToConcat, adjust;
    size_t length;
    unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL;
    int *clPosition = NULL;
    int depth = TclGetStackDepth(envPtr);

    /*
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	clPosition = ckalloc(maxNumCL * sizeof(int));
    }

    adjust = 0;
    Tcl_DStringInit(&textBuffer);
    numObjsToConcat = 0;
    for ( ;  count > 0;  count--, tokenPtr++) {
	switch (tokenPtr->type) {







|







2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	clPosition = Tcl_Alloc(maxNumCL * sizeof(int));
    }

    adjust = 0;
    Tcl_DStringInit(&textBuffer);
    numObjsToConcat = 0;
    for ( ;  count > 0;  count--, tokenPtr++) {
	switch (tokenPtr->type) {
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
	    if ((length == 1) && (buffer[0] == ' ') &&
		(tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    int clPos = Tcl_DStringLength(&textBuffer);

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = ckrealloc(clPosition,
                                maxNumCL * sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL ++;
		}
		adjust++;
	    }







|







2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
	    if ((length == 1) && (buffer[0] == ' ') &&
		(tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    int clPos = Tcl_DStringLength(&textBuffer);

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = Tcl_Realloc(clPosition,
                                maxNumCL * sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL ++;
		}
		adjust++;
	    }
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
	    numObjsToConcat++;
	    count -= tokenPtr->numComponents;
	    tokenPtr += tokenPtr->numComponents;
	    break;

	default:
	    Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s",
		    tokenPtr->type, tokenPtr->size, tokenPtr->start);
	}
    }

    /*
     * Push any accumulated characters appearing at the end.
     */








|







2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
	    numObjsToConcat++;
	    count -= tokenPtr->numComponents;
	    tokenPtr += tokenPtr->numComponents;
	    break;

	default:
	    Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s",
		    tokenPtr->type, (int)tokenPtr->size, tokenPtr->start);
	}
    }

    /*
     * Push any accumulated characters appearing at the end.
     */

2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524

    /*
     * Release the temp table we used to collect the locations of continuation
     * lines, if any.
     */

    if (maxNumCL) {
	ckfree(clPosition);
    }
    TclCheckStackDepth(depth+1, envPtr);
}

/*
 *----------------------------------------------------------------------
 *







|







2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524

    /*
     * Release the temp table we used to collect the locations of continuation
     * lines, if any.
     */

    if (maxNumCL) {
	Tcl_Free(clPosition);
    }
    TclCheckStackDepth(depth+1, envPtr);
}

/*
 *----------------------------------------------------------------------
 *
2721
2722
2723
2724
2725
2726
2727
2728
2729

2730
2731
2732
2733
2734
2735
2736
	     * reach zero, and memory may leak.  Bugs 467523, 3357771
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	     * on the string value, and do not call Tcl_DuplicateObj() so we
             * can be sure we do not have any lingering cycles hiding in
	     * the intrep.
	     */
	    int numBytes;
	    const char *bytes = TclGetStringFromObj(objPtr, &numBytes);

	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);

	    Tcl_IncrRefCount(copyPtr);
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);

	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
	}







<
|
>







2721
2722
2723
2724
2725
2726
2727

2728
2729
2730
2731
2732
2733
2734
2735
2736
	     * reach zero, and memory may leak.  Bugs 467523, 3357771
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	     * on the string value, and do not call Tcl_DuplicateObj() so we
             * can be sure we do not have any lingering cycles hiding in
	     * the intrep.
	     */

	    const char *bytes = TclGetString(objPtr);
	    size_t numBytes = objPtr->length;
	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);

	    Tcl_IncrRefCount(copyPtr);
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);

	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
	}
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793

    if (envPtr->iPtr->varFramePtr != NULL) {
	namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
    } else {
	namespacePtr = envPtr->iPtr->globalNsPtr;
    }

    p = ckalloc(structureSize);
    codePtr = (ByteCode *) p;
    codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
    codePtr->compileEpoch = iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;
    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 0;
    TclPreserveByteCode(codePtr);







|







2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793

    if (envPtr->iPtr->varFramePtr != NULL) {
	namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
    } else {
	namespacePtr = envPtr->iPtr->globalNsPtr;
    }

    p = Tcl_Alloc(structureSize);
    codePtr = (ByteCode *) p;
    codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
    codePtr->compileEpoch = iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;
    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 0;
    TclPreserveByteCode(codePtr);
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
 */

int
TclFindCompiledLocal(
    register const char *name,	/* Points to first character of the name of a
				 * scalar or array variable. If NULL, a
				 * temporary var should be created. */
    int nameBytes,		/* Number of bytes in the name. */
    int create,			/* If 1, allocate a local frame entry for the
				 * variable if it is new. */
    CompileEnv *envPtr)		/* Points to the current compile environment*/
{
    register CompiledLocal *localPtr;
    int localVar = -1;
    register int i;







|







2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
 */

int
TclFindCompiledLocal(
    register const char *name,	/* Points to first character of the name of a
				 * scalar or array variable. If NULL, a
				 * temporary var should be created. */
    size_t nameBytes,		/* Number of bytes in the name. */
    int create,			/* If 1, allocate a local frame entry for the
				 * variable if it is new. */
    CompileEnv *envPtr)		/* Points to the current compile environment*/
{
    register CompiledLocal *localPtr;
    int localVar = -1;
    register int i;
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
	 * Compiling a non-body script: give it read access to the LVT in the
	 * current localCache
	 */

	LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr;
	const char *localName;
	Tcl_Obj **varNamePtr;
	int len;

	if (!cachePtr || !name) {
	    return -1;
	}

	varNamePtr = &cachePtr->varName0;
	for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {







|







2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
	 * Compiling a non-body script: give it read access to the LVT in the
	 * current localCache
	 */

	LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr;
	const char *localName;
	Tcl_Obj **varNamePtr;
	size_t len;

	if (!cachePtr || !name) {
	    return -1;
	}

	varNamePtr = &cachePtr->varName0;
	for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
	int localCt = procPtr->numCompiledLocals;

	localPtr = procPtr->firstLocalPtr;
	for (i = 0;  i < localCt;  i++) {
	    if (!TclIsVarTemporary(localPtr)) {
		char *localName = localPtr->name;

		if ((nameBytes == localPtr->nameLength) &&
			(strncmp(name,localName,(unsigned)nameBytes) == 0)) {
		    return i;
		}
	    }
	    localPtr = localPtr->nextPtr;
	}
    }

    /*
     * Create a new variable if appropriate.
     */

    if (create || (name == NULL)) {
	localVar = procPtr->numCompiledLocals;
	localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameBytes + 1);
	if (procPtr->firstLocalPtr == NULL) {
	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	localPtr->nextPtr = NULL;







|
|













|







2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
	int localCt = procPtr->numCompiledLocals;

	localPtr = procPtr->firstLocalPtr;
	for (i = 0;  i < localCt;  i++) {
	    if (!TclIsVarTemporary(localPtr)) {
		char *localName = localPtr->name;

		if ((nameBytes == (size_t)localPtr->nameLength) &&
			(strncmp(name,localName,nameBytes) == 0)) {
		    return i;
		}
	    }
	    localPtr = localPtr->nextPtr;
	}
    }

    /*
     * Create a new variable if appropriate.
     */

    if (create || (name == NULL)) {
	localVar = procPtr->numCompiledLocals;
	localPtr = Tcl_Alloc(TclOffset(CompiledLocal, name) + nameBytes + 1);
	if (procPtr->firstLocalPtr == NULL) {
	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	localPtr->nextPtr = NULL;
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
     * [inclusive].
     */

    size_t currBytes = envPtr->codeNext - envPtr->codeStart;
    size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);

    if (envPtr->mallocedCodeArray) {
	envPtr->codeStart = ckrealloc(envPtr->codeStart, newBytes);
    } else {
	/*
	 * envPtr->codeStart isn't a ckalloc'd pointer, so we must code a
	 * ckrealloc equivalent for ourselves.
	 */

	unsigned char *newPtr = ckalloc(newBytes);

	memcpy(newPtr, envPtr->codeStart, currBytes);
	envPtr->codeStart = newPtr;
	envPtr->mallocedCodeArray = 1;
    }

    envPtr->codeNext = envPtr->codeStart + currBytes;







|


|
|


|







3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
     * [inclusive].
     */

    size_t currBytes = envPtr->codeNext - envPtr->codeStart;
    size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);

    if (envPtr->mallocedCodeArray) {
	envPtr->codeStart = Tcl_Realloc(envPtr->codeStart, newBytes);
    } else {
	/*
	 * envPtr->codeStart isn't a Tcl_Alloc'd pointer, so we must code a
	 * Tcl_Realloc equivalent for ourselves.
	 */

	unsigned char *newPtr = Tcl_Alloc(newBytes);

	memcpy(newPtr, envPtr->codeStart, currBytes);
	envPtr->codeStart = newPtr;
	envPtr->mallocedCodeArray = 1;
    }

    envPtr->codeNext = envPtr->codeStart + currBytes;
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146

	size_t currElems = envPtr->cmdMapEnd;
	size_t newElems = 2 * currElems;
	size_t currBytes = currElems * sizeof(CmdLocation);
	size_t newBytes = newElems * sizeof(CmdLocation);

	if (envPtr->mallocedCmdMap) {
	    envPtr->cmdMapPtr = ckrealloc(envPtr->cmdMapPtr, newBytes);
	} else {
	    /*
	     * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a
	     * ckrealloc equivalent for ourselves.
	     */

	    CmdLocation *newPtr = ckalloc(newBytes);

	    memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
	    envPtr->cmdMapPtr = newPtr;
	    envPtr->mallocedCmdMap = 1;
	}
	envPtr->cmdMapEnd = newElems;
    }







|


|
|


|







3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146

	size_t currElems = envPtr->cmdMapEnd;
	size_t newElems = 2 * currElems;
	size_t currBytes = currElems * sizeof(CmdLocation);
	size_t newBytes = newElems * sizeof(CmdLocation);

	if (envPtr->mallocedCmdMap) {
	    envPtr->cmdMapPtr = Tcl_Realloc(envPtr->cmdMapPtr, newBytes);
	} else {
	    /*
	     * envPtr->cmdMapPtr isn't a Tcl_Alloc'd pointer, so we must code a
	     * Tcl_Realloc equivalent for ourselves.
	     */

	    CmdLocation *newPtr = Tcl_Alloc(newBytes);

	    memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
	    envPtr->cmdMapPtr = newPtr;
	    envPtr->mallocedCmdMap = 1;
	}
	envPtr->cmdMapEnd = newElems;
    }
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
	 * to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
	 */

	size_t currElems = eclPtr->nloc;
	size_t newElems = (currElems ? 2*currElems : 1);
	size_t newBytes = newElems * sizeof(ECL);

	eclPtr->loc = ckrealloc(eclPtr->loc, newBytes);
	eclPtr->nloc = newElems;
    }

    ePtr = &eclPtr->loc[eclPtr->nuloc];
    ePtr->srcOffset = srcOffset;
    ePtr->line = ckalloc(numWords * sizeof(int));
    ePtr->next = ckalloc(numWords * sizeof(int *));
    ePtr->nline = numWords;
    wwlines = ckalloc(numWords * sizeof(int));

    last = cmd;
    wordLine = line;
    wordNext = clNext;
    for (wordIdx=0 ; wordIdx<numWords;
	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
	TclAdvanceLines(&wordLine, last, tokenPtr->start);







|





|
|

|







3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
	 * to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
	 */

	size_t currElems = eclPtr->nloc;
	size_t newElems = (currElems ? 2*currElems : 1);
	size_t newBytes = newElems * sizeof(ECL);

	eclPtr->loc = Tcl_Realloc(eclPtr->loc, newBytes);
	eclPtr->nloc = newElems;
    }

    ePtr = &eclPtr->loc[eclPtr->nuloc];
    ePtr->srcOffset = srcOffset;
    ePtr->line = Tcl_Alloc(numWords * sizeof(int));
    ePtr->next = Tcl_Alloc(numWords * sizeof(int *));
    ePtr->nline = numWords;
    wwlines = Tcl_Alloc(numWords * sizeof(int));

    last = cmd;
    wordLine = line;
    wordNext = clNext;
    for (wordIdx=0 ; wordIdx<numWords;
	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
	TclAdvanceLines(&wordLine, last, tokenPtr->start);
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
	size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux);
	int newElems = 2*envPtr->exceptArrayEnd;
	size_t newBytes = newElems * sizeof(ExceptionRange);
	size_t newBytes2 = newElems * sizeof(ExceptionAux);

	if (envPtr->mallocedExceptArray) {
	    envPtr->exceptArrayPtr =
		    ckrealloc(envPtr->exceptArrayPtr, newBytes);
	    envPtr->exceptAuxArrayPtr =
		    ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2);
	} else {
	    /*
	     * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must
	     * code a ckrealloc equivalent for ourselves.
	     */

	    ExceptionRange *newPtr = ckalloc(newBytes);
	    ExceptionAux *newPtr2 = ckalloc(newBytes2);

	    memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
	    memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2);
	    envPtr->exceptArrayPtr = newPtr;
	    envPtr->exceptAuxArrayPtr = newPtr2;
	    envPtr->mallocedExceptArray = 1;
	}







|

|


|
|


|
|







3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
	size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux);
	int newElems = 2*envPtr->exceptArrayEnd;
	size_t newBytes = newElems * sizeof(ExceptionRange);
	size_t newBytes2 = newElems * sizeof(ExceptionAux);

	if (envPtr->mallocedExceptArray) {
	    envPtr->exceptArrayPtr =
		    Tcl_Realloc(envPtr->exceptArrayPtr, newBytes);
	    envPtr->exceptAuxArrayPtr =
		    Tcl_Realloc(envPtr->exceptAuxArrayPtr, newBytes2);
	} else {
	    /*
	     * envPtr->exceptArrayPtr isn't a Tcl_Alloc'd pointer, so we must
	     * code a Tcl_Realloc equivalent for ourselves.
	     */

	    ExceptionRange *newPtr = Tcl_Alloc(newBytes);
	    ExceptionAux *newPtr2 = Tcl_Alloc(newBytes2);

	    memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
	    memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2);
	    envPtr->exceptArrayPtr = newPtr;
	    envPtr->exceptAuxArrayPtr = newPtr2;
	    envPtr->mallocedExceptArray = 1;
	}
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
	Tcl_Panic("trying to add 'break' fixup to full exception range");
    }

    if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) {
	auxPtr->allocBreakTargets *= 2;
	auxPtr->allocBreakTargets += 2;
	if (auxPtr->breakTargets) {
	    auxPtr->breakTargets = ckrealloc(auxPtr->breakTargets,
		    sizeof(int) * auxPtr->allocBreakTargets);
	} else {
	    auxPtr->breakTargets =
		    ckalloc(sizeof(int) * auxPtr->allocBreakTargets);
	}
    }
    auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}

void







|



|







3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
	Tcl_Panic("trying to add 'break' fixup to full exception range");
    }

    if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) {
	auxPtr->allocBreakTargets *= 2;
	auxPtr->allocBreakTargets += 2;
	if (auxPtr->breakTargets) {
	    auxPtr->breakTargets = Tcl_Realloc(auxPtr->breakTargets,
		    sizeof(int) * auxPtr->allocBreakTargets);
	} else {
	    auxPtr->breakTargets =
		    Tcl_Alloc(sizeof(int) * auxPtr->allocBreakTargets);
	}
    }
    auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}

void
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
	Tcl_Panic("trying to add 'continue' fixup to full exception range");
    }

    if (++auxPtr->numContinueTargets > auxPtr->allocContinueTargets) {
	auxPtr->allocContinueTargets *= 2;
	auxPtr->allocContinueTargets += 2;
	if (auxPtr->continueTargets) {
	    auxPtr->continueTargets = ckrealloc(auxPtr->continueTargets,
		    sizeof(int) * auxPtr->allocContinueTargets);
	} else {
	    auxPtr->continueTargets =
		    ckalloc(sizeof(int) * auxPtr->allocContinueTargets);
	}
    }
    auxPtr->continueTargets[auxPtr->numContinueTargets - 1] =
	    CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}








|



|







3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
	Tcl_Panic("trying to add 'continue' fixup to full exception range");
    }

    if (++auxPtr->numContinueTargets > auxPtr->allocContinueTargets) {
	auxPtr->allocContinueTargets *= 2;
	auxPtr->allocContinueTargets += 2;
	if (auxPtr->continueTargets) {
	    auxPtr->continueTargets = Tcl_Realloc(auxPtr->continueTargets,
		    sizeof(int) * auxPtr->allocContinueTargets);
	} else {
	    auxPtr->continueTargets =
		    Tcl_Alloc(sizeof(int) * auxPtr->allocContinueTargets);
	}
    }
    auxPtr->continueTargets[auxPtr->numContinueTargets - 1] =
	    CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}

3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
    }

    /*
     * Drop the arrays we were holding the only reference to.
     */

    if (auxPtr->breakTargets) {
	ckfree(auxPtr->breakTargets);
	auxPtr->breakTargets = NULL;
	auxPtr->numBreakTargets = 0;
    }
    if (auxPtr->continueTargets) {
	ckfree(auxPtr->continueTargets);
	auxPtr->continueTargets = NULL;
	auxPtr->numContinueTargets = 0;
    }
}

/*
 *----------------------------------------------------------------------







|




|







3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
    }

    /*
     * Drop the arrays we were holding the only reference to.
     */

    if (auxPtr->breakTargets) {
	Tcl_Free(auxPtr->breakTargets);
	auxPtr->breakTargets = NULL;
	auxPtr->numBreakTargets = 0;
    }
    if (auxPtr->continueTargets) {
	Tcl_Free(auxPtr->continueTargets);
	auxPtr->continueTargets = NULL;
	auxPtr->numContinueTargets = 0;
    }
}

/*
 *----------------------------------------------------------------------
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716

	size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
	int newElems = 2*envPtr->auxDataArrayEnd;
	size_t newBytes = newElems * sizeof(AuxData);

	if (envPtr->mallocedAuxDataArray) {
	    envPtr->auxDataArrayPtr =
		    ckrealloc(envPtr->auxDataArrayPtr, newBytes);
	} else {
	    /*
	     * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must
	     * code a ckrealloc equivalent for ourselves.
	     */

	    AuxData *newPtr = ckalloc(newBytes);

	    memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
	    envPtr->auxDataArrayPtr = newPtr;
	    envPtr->mallocedAuxDataArray = 1;
	}
	envPtr->auxDataArrayEnd = newElems;
    }







|


|
|


|







3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716

	size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
	int newElems = 2*envPtr->auxDataArrayEnd;
	size_t newBytes = newElems * sizeof(AuxData);

	if (envPtr->mallocedAuxDataArray) {
	    envPtr->auxDataArrayPtr =
		    Tcl_Realloc(envPtr->auxDataArrayPtr, newBytes);
	} else {
	    /*
	     * envPtr->auxDataArrayPtr isn't a Tcl_Alloc'd pointer, so we must
	     * code a Tcl_Realloc equivalent for ourselves.
	     */

	    AuxData *newPtr = Tcl_Alloc(newBytes);

	    memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
	    envPtr->auxDataArrayPtr = newPtr;
	    envPtr->mallocedAuxDataArray = 1;
	}
	envPtr->auxDataArrayEnd = newElems;
    }
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
     */

    size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
    int newElems = 2*(fixupArrayPtr->end + 1);
    size_t newBytes = newElems * sizeof(JumpFixup);

    if (fixupArrayPtr->mallocedArray) {
	fixupArrayPtr->fixup = ckrealloc(fixupArrayPtr->fixup, newBytes);
    } else {
	/*
	 * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a
	 * ckrealloc equivalent for ourselves.
	 */

	JumpFixup *newPtr = ckalloc(newBytes);

	memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
	fixupArrayPtr->fixup = newPtr;
	fixupArrayPtr->mallocedArray = 1;
    }
    fixupArrayPtr->end = newElems;
}







|


|
|


|







3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
     */

    size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
    int newElems = 2*(fixupArrayPtr->end + 1);
    size_t newBytes = newElems * sizeof(JumpFixup);

    if (fixupArrayPtr->mallocedArray) {
	fixupArrayPtr->fixup = Tcl_Realloc(fixupArrayPtr->fixup, newBytes);
    } else {
	/*
	 * fixupArrayPtr->fixup isn't a Tcl_Alloc'd pointer, so we must code a
	 * Tcl_Realloc equivalent for ourselves.
	 */

	JumpFixup *newPtr = Tcl_Alloc(newBytes);

	memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
	fixupArrayPtr->fixup = newPtr;
	fixupArrayPtr->mallocedArray = 1;
    }
    fixupArrayPtr->end = newElems;
}
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
void
TclFreeJumpFixupArray(
    register JumpFixupArray *fixupArrayPtr)
				/* Points to the JumpFixupArray structure to
				 * free. */
{
    if (fixupArrayPtr->mallocedArray) {
	ckfree(fixupArrayPtr->fixup);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclEmitForwardJump --







|







3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
void
TclFreeJumpFixupArray(
    register JumpFixupArray *fixupArrayPtr)
				/* Points to the JumpFixupArray structure to
				 * free. */
{
    if (fixupArrayPtr->mallocedArray) {
	Tcl_Free(fixupArrayPtr->fixup);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclEmitForwardJump --
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
				 * describes the forward jump. */
    int jumpDist,		/* Jump distance to set in jump instr. */
    int distThreshold)		/* Maximum distance before the two byte jump
				 * is grown to five bytes. */
{
    unsigned char *jumpPc, *p;
    int firstCmd, lastCmd, firstRange, lastRange, k;
    unsigned numBytes;

    if (jumpDist <= distThreshold) {
	jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
	switch (jumpFixupPtr->jumpType) {
	case TCL_UNCONDITIONAL_JUMP:
	    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
	    break;







|







3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
				 * describes the forward jump. */
    int jumpDist,		/* Jump distance to set in jump instr. */
    int distThreshold)		/* Maximum distance before the two byte jump
				 * is grown to five bytes. */
{
    unsigned char *jumpPc, *p;
    int firstCmd, lastCmd, firstRange, lastRange, k;
    size_t numBytes;

    if (jumpDist <= distThreshold) {
	jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
	switch (jumpFixupPtr->jumpType) {
	case TCL_UNCONDITIONAL_JUMP:
	    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
	    break;
Changes to generic/tclCompile.h.
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
 * in the byte code. The association with a ByteCode structure BC is done
 * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
 * Also recorded is information coming from the context, i.e. type of the
 * frame and associated information, like the path of a sourced file.
 */

typedef struct {
    int srcOffset;		/* Command location to find the entry. */
    int nline;			/* Number of words in the command */
    int *line;			/* Line information for all words in the
				 * command. */
    int **next;			/* Transient information used by the compiler
				 * for tracking of hidden continuation
				 * lines. */
} ECL;







|







177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
 * in the byte code. The association with a ByteCode structure BC is done
 * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
 * Also recorded is information coming from the context, i.e. type of the
 * frame and associated information, like the path of a sourced file.
 */

typedef struct {
    size_t srcOffset;		/* Command location to find the entry. */
    int nline;			/* Number of words in the command */
    int *line;			/* Line information for all words in the
				 * command. */
    int **next;			/* Transient information used by the compiler
				 * for tracking of hidden continuation
				 * lines. */
} ECL;
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
 *
 * The following definitions declare the types of procedures that are called
 * to duplicate or free this auxiliary data when the containing ByteCode
 * objects are duplicated and freed. Pointers to these procedures are kept in
 * the AuxData structure.
 */

typedef ClientData (AuxDataDupProc)  (ClientData clientData);
typedef void	   (AuxDataFreeProc) (ClientData clientData);
typedef void	   (AuxDataPrintProc)(ClientData clientData,
			    Tcl_Obj *appendObj, struct ByteCode *codePtr,
			    unsigned int pcOffset);

/*
 * We define a separate AuxDataType struct to hold type-related information
 * for the AuxData structure. This separation makes it possible for clients
 * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for







|
|
|







213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
 *
 * The following definitions declare the types of procedures that are called
 * to duplicate or free this auxiliary data when the containing ByteCode
 * objects are duplicated and freed. Pointers to these procedures are kept in
 * the AuxData structure.
 */

typedef void *(AuxDataDupProc)  (void *clientData);
typedef void	   (AuxDataFreeProc) (void *clientData);
typedef void	   (AuxDataPrintProc)(void *clientData,
			    Tcl_Obj *appendObj, struct ByteCode *codePtr,
			    unsigned int pcOffset);

/*
 * We define a separate AuxDataType struct to hold type-related information
 * for the AuxData structure. This separation makes it possible for clients
 * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
 * during compilation by CompileProcs and used by instructions during
 * execution.
 */

typedef struct AuxData {
    const AuxDataType *type;	/* Pointer to the AuxData type associated with
				 * this ClientData. */
    ClientData clientData;	/* The compilation data itself. */
} AuxData;

/*
 * Structure defining the compilation environment. After compilation, fields
 * describing bytecode instructions are copied out into the more compact
 * ByteCode structure defined below.
 */







|







262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
 * during compilation by CompileProcs and used by instructions during
 * execution.
 */

typedef struct AuxData {
    const AuxDataType *type;	/* Pointer to the AuxData type associated with
				 * this ClientData. */
    void *clientData;	/* The compilation data itself. */
} AuxData;

/*
 * Structure defining the compilation environment. After compilation, fields
 * describing bytecode instructions are copied out into the more compact
 * ByteCode structure defined below.
 */
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
    OPERAND_LIT4,		/* Four byte unsigned index into table of
				 * literals. */
    OPERAND_SCLS1		/* Index into tclStringClassTable. */
} InstOperandType;

typedef struct InstructionDesc {
    const char *name;		/* Name of instruction. */
    int numBytes;		/* Total number of bytes for instruction. */
    int stackEffect;		/* The worst-case balance stack effect of the
				 * instruction, used for stack requirements
				 * computations. The value INT_MIN signals
				 * that the instruction's worst case effect is
				 * (1-opnd1). */
    int numOperands;		/* Number of operands. */
    InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];







|







838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
    OPERAND_LIT4,		/* Four byte unsigned index into table of
				 * literals. */
    OPERAND_SCLS1		/* Index into tclStringClassTable. */
} InstOperandType;

typedef struct InstructionDesc {
    const char *name;		/* Name of instruction. */
    size_t numBytes;		/* Total number of bytes for instruction. */
    int stackEffect;		/* The worst-case balance stack effect of the
				 * instruction, used for stack requirements
				 * computations. The value INT_MIN signals
				 * that the instruction's worst case effect is
				 * (1-opnd1). */
    int numOperands;		/* Number of operands. */
    InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
/*
 * Structure used to hold information about a [dict update] command that is
 * needed during program execution. These structures are stored in CompileEnv
 * and ByteCode structures as auxiliary data.
 */

typedef struct {
    int length;			/* Size of array */
    int varIndices[1];		/* Array of variable indices to manage when
				 * processing the start and end of a [dict
				 * update]. There is really more than one
				 * entry, and the structure is allocated to
				 * take account of this. MUST BE LAST FIELD IN
				 * STRUCTURE. */
} DictUpdateInfo;







|







996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
/*
 * Structure used to hold information about a [dict update] command that is
 * needed during program execution. These structures are stored in CompileEnv
 * and ByteCode structures as auxiliary data.
 */

typedef struct {
    size_t length;		/* Size of array */
    int varIndices[1];		/* Array of variable indices to manage when
				 * processing the start and end of a [dict
				 * update]. There is really more than one
				 * entry, and the structure is allocated to
				 * take account of this. MUST BE LAST FIELD IN
				 * STRUCTURE. */
} DictUpdateInfo;
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, const char *script,
			    int numBytes, CompileEnv *envPtr, int optimize);
MODULE_SCOPE void	TclCompileExprWords(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileInvocation(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
			    const char *script, int numBytes,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileSyntaxError(Tcl_Interp *interp,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileTokens(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, int size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, const char *bytes,
			    int length, unsigned int hash, int *newPtr,
			    Namespace *nsPtr, int flags,
			    LiteralEntry **globalPtrPtr);
MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
			    LiteralTable *tablePtr);
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE void	TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclGetIndexFromToken(Tcl_Token *tokenPtr,
			    int before, int after, int *indexPtr);
MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    int numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);
MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
			    int returnCode, ExceptionAux **auxPtrPtr);
MODULE_SCOPE void	TclAddLoopBreakFixup(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclAddLoopContinueFixup(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
			    int range);
#ifdef TCL_COMPILE_STATS
MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int	TclLog2(int value);
#endif
MODULE_SCOPE int	TclLocalScalar(const char *bytes, int numBytes,
			    CompileEnv *envPtr);
MODULE_SCOPE int	TclLocalScalarFromToken(Tcl_Token *tokenPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
			    const unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, int maxChars);
MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *isScalarPtr);
MODULE_SCOPE void	TclPreserveByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp,
			    const char *name, Namespace *nsPtr);
MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclSortingOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclVariadicOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNoIdentOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void	TclVerifyGlobalLiteralTable(Interp *iPtr);
MODULE_SCOPE void	TclVerifyLocalLiteralTable(CompileEnv *envPtr);
#endif
MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
			    Tcl_Obj *valuePtr);
MODULE_SCOPE void	TclLogCommandInfo(Tcl_Interp *interp,
			    const char *script, const char *command,
			    int length, const unsigned char *pc,
			    Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclGetInnerContext(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
			    register Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int isLambda);


/*
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution
 * modules inside the Tcl core but not used outside.
 *----------------------------------------------------------------
 */

/*
 * Simplified form to access AuxData.
 *
 * ClientData TclFetchAuxData(CompileEng *envPtr, int index);
 */

#define TclFetchAuxData(envPtr, index) \
    (envPtr)->auxDataArrayPtr[(index)].clientData

#define LITERAL_ON_HEAP		0x01
#define LITERAL_CMD_NAME	0x02







|







|








|



|

|













|
|













|














|











|

|









|


|


|


|










|




|














|







1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, const char *script,
			    size_t numBytes, CompileEnv *envPtr, int optimize);
MODULE_SCOPE void	TclCompileExprWords(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileInvocation(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
			    const char *script, size_t numBytes,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileSyntaxError(Tcl_Interp *interp,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileTokens(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateAuxData(void *clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, size_t size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, const char *bytes,
			    size_t length, size_t hash, int *newPtr,
			    Namespace *nsPtr, int flags,
			    LiteralEntry **globalPtrPtr);
MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
			    LiteralTable *tablePtr);
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE void	TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, size_t index);
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, size_t nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclGetIndexFromToken(Tcl_Token *tokenPtr,
			    int before, int after, int *indexPtr);
MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    size_t numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);
MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
			    int returnCode, ExceptionAux **auxPtrPtr);
MODULE_SCOPE void	TclAddLoopBreakFixup(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclAddLoopContinueFixup(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
			    int range);
#ifdef TCL_COMPILE_STATS
MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int	TclLog2(int value);
#endif
MODULE_SCOPE int	TclLocalScalar(const char *bytes, size_t numBytes,
			    CompileEnv *envPtr);
MODULE_SCOPE int	TclLocalScalarFromToken(Tcl_Token *tokenPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
			    const unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, size_t maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, size_t maxChars);
MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *isScalarPtr);
MODULE_SCOPE void	TclPreserveByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp,
			    const char *name, Namespace *nsPtr);
MODULE_SCOPE int	TclSingleOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclSortingOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclVariadicOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNoIdentOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void	TclVerifyGlobalLiteralTable(Interp *iPtr);
MODULE_SCOPE void	TclVerifyLocalLiteralTable(CompileEnv *envPtr);
#endif
MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
			    Tcl_Obj *valuePtr);
MODULE_SCOPE void	TclLogCommandInfo(Tcl_Interp *interp,
			    const char *script, const char *command,
			    size_t length, const unsigned char *pc,
			    Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclGetInnerContext(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
MODULE_SCOPE int	TclPushProcCallFrame(void *clientData,
			    register Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int isLambda);


/*
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution
 * modules inside the Tcl core but not used outside.
 *----------------------------------------------------------------
 */

/*
 * Simplified form to access AuxData.
 *
 * void *TclFetchAuxData(CompileEng *envPtr, int index);
 */

#define TclFetchAuxData(envPtr, index) \
    (envPtr)->auxDataArrayPtr[(index)].clientData

#define LITERAL_ON_HEAP		0x01
#define LITERAL_CMD_NAME	0x02
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
#   define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
#else
#   define TclGetInt1AtPtr(p) \
    (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0))
#endif

#define TclGetInt4AtPtr(p) \
    (((int) TclGetInt1AtPtr(p) << 24) |				\
		     (*((p)+1) << 16) |				\
		     (*((p)+2) <<  8) |				\
		     (*((p)+3)))

#define TclGetUInt1AtPtr(p) \
    ((unsigned int) *(p))
#define TclGetUInt4AtPtr(p) \







|







1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
#   define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
#else
#   define TclGetInt1AtPtr(p) \
    (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0))
#endif

#define TclGetInt4AtPtr(p) \
    (((int) (TclGetUInt1AtPtr(p) << 24)) |				\
		     (*((p)+1) << 16) |				\
		     (*((p)+2) <<  8) |				\
		     (*((p)+3)))

#define TclGetUInt1AtPtr(p) \
    ((unsigned int) *(p))
#define TclGetUInt4AtPtr(p) \
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
    TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
	    (envPtr));
/*
 * Convenience macros for use when pushing literals. The ANSI C "prototype" for
 * these macros are:
 *
 * static void		PushLiteral(CompileEnv *envPtr,
 *			    const char *string, int length);
 * static void		PushStringLiteral(CompileEnv *envPtr,
 *			    const char *string);
 */

#define PushLiteral(envPtr, string, length) \
    TclEmitPush(TclRegisterLiteral(envPtr, string, length, 0), (envPtr))
#define PushStringLiteral(envPtr, string) \
    PushLiteral(envPtr, string, (int) (sizeof(string "") - 1))

/*
 * Macro to advance to the next token; it is more mnemonic than the address
 * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
 *
 * static Tcl_Token *	TokenAfter(Tcl_Token *tokenPtr);
 */

#define TokenAfter(tokenPtr) \
    ((tokenPtr) + ((tokenPtr)->numComponents + 1))

/*
 * Macro to get the offset to the next instruction to be issued. The ANSI C
 * "prototype" for this macro is:
 *
 * static int	CurrentOffset(CompileEnv *envPtr);
 */

#define CurrentOffset(envPtr) \
    ((envPtr)->codeNext - (envPtr)->codeStart)

/*
 * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the







|







|















|







1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
    TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
	    (envPtr));
/*
 * Convenience macros for use when pushing literals. The ANSI C "prototype" for
 * these macros are:
 *
 * static void		PushLiteral(CompileEnv *envPtr,
 *			    const char *string, size_t length);
 * static void		PushStringLiteral(CompileEnv *envPtr,
 *			    const char *string);
 */

#define PushLiteral(envPtr, string, length) \
    TclEmitPush(TclRegisterLiteral(envPtr, string, length, 0), (envPtr))
#define PushStringLiteral(envPtr, string) \
    PushLiteral(envPtr, string, sizeof(string "") - 1)

/*
 * Macro to advance to the next token; it is more mnemonic than the address
 * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
 *
 * static Tcl_Token *	TokenAfter(Tcl_Token *tokenPtr);
 */

#define TokenAfter(tokenPtr) \
    ((tokenPtr) + ((tokenPtr)->numComponents + 1))

/*
 * Macro to get the offset to the next instruction to be issued. The ANSI C
 * "prototype" for this macro is:
 *
 * static ptrdiff_t	CurrentOffset(CompileEnv *envPtr);
 */

#define CurrentOffset(envPtr) \
    ((envPtr)->codeNext - (envPtr)->codeStart)

/*
 * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
Changes to generic/tclConfig.c.
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
    const Tcl_Config *configuration,	/* Embedded configuration. */
    const char *valEncoding)	/* Name of the encoding used to store the
				 * configuration values, ASCII, thus UTF-8. */
{
    Tcl_Obj *pDB, *pkgDict;
    Tcl_DString cmdName;
    const Tcl_Config *cfg;
    QCCD *cdPtr = ckalloc(sizeof(QCCD));

    cdPtr->interp = interp;
    if (valEncoding) {
	cdPtr->encoding = ckalloc(strlen(valEncoding)+1);
	strcpy(cdPtr->encoding, valEncoding);
    } else {
	cdPtr->encoding = NULL;
    }
    cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);

    /*







|



|







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
    const Tcl_Config *configuration,	/* Embedded configuration. */
    const char *valEncoding)	/* Name of the encoding used to store the
				 * configuration values, ASCII, thus UTF-8. */
{
    Tcl_Obj *pDB, *pkgDict;
    Tcl_DString cmdName;
    const Tcl_Config *cfg;
    QCCD *cdPtr = Tcl_Alloc(sizeof(QCCD));

    cdPtr->interp = interp;
    if (valEncoding) {
	cdPtr->encoding = Tcl_Alloc(strlen(valEncoding)+1);
	strcpy(cdPtr->encoding, valEncoding);
    } else {
	cdPtr->encoding = NULL;
    }
    cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);

    /*
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
    QCCD *cdPtr = clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);

    Tcl_DictObjRemove(NULL, pDB, pkgName);
    Tcl_DecrRefCount(pkgName);
    if (cdPtr->encoding) {
	ckfree(cdPtr->encoding);
    }
    ckfree(cdPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * GetConfigDict --
 *







|

|







329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
    QCCD *cdPtr = clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);

    Tcl_DictObjRemove(NULL, pDB, pkgName);
    Tcl_DecrRefCount(pkgName);
    if (cdPtr->encoding) {
	Tcl_Free(cdPtr->encoding);
    }
    Tcl_Free(cdPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * GetConfigDict --
 *
Changes to generic/tclDTrace.d.
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
    void *freeIntRepProc;
    void *dupIntRepProc;
    void *updateStringProc;
    void *setFromAnyProc;
} Tcl_ObjType;

struct Tcl_Obj {
    int refCount;
    char *bytes;
    int length;
    Tcl_ObjType *typePtr;
    union {
	long longValue;
	double doubleValue;
	void *otherValuePtr;
	int64_t wideValue;
	struct {







|

|







178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
    void *freeIntRepProc;
    void *dupIntRepProc;
    void *updateStringProc;
    void *setFromAnyProc;
} Tcl_ObjType;

struct Tcl_Obj {
    size_t refCount;
    char *bytes;
    size_t length;
    Tcl_ObjType *typePtr;
    union {
	long longValue;
	double doubleValue;
	void *otherValuePtr;
	int64_t wideValue;
	struct {
Changes to generic/tclDate.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
/* A Bison parser, made by GNU Bison 2.3.  */

/* Skeleton implementation for Bison's Yacc-like parsers in C

   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
   Free Software Foundation, Inc.

   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 51 Franklin Street, Fifth Floor,
   Boston, MA 02110-1301, USA.  */

/* As a special exception, you may create a larger work that contains
   part or all of the Bison parser skeleton and distribute that work
   under terms of your choice, so long as that work isn't itself a
   parser generator using the skeleton or a modified version thereof
   as a parser skeleton.  Alternatively, if you modify or redistribute
   the parser skeleton itself, you may (at your option) remove this
|

|

<
|

|

|
|







|
<
<







1
2
3
4

5
6
7
8
9
10
11
12
13
14
15
16
17
18


19
20
21
22
23
24
25
/* A Bison parser, made by GNU Bison 3.1.  */

/* Bison implementation for Yacc-like parsers in C


   Copyright (C) 1984, 1989-1990, 2000-2015, 2018 Free Software Foundation, Inc.

   This program is free software: you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation, either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */



/* As a special exception, you may create a larger work that contains
   part or all of the Bison parser skeleton and distribute that work
   under terms of your choice, so long as that work isn't itself a
   parser generator using the skeleton or a modified version thereof
   as a parser skeleton.  Alternatively, if you modify or redistribute
   the parser skeleton itself, you may (at your option) remove this
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57


58

59
60

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

132
133
134
135
136
137
138
   define necessary library symbols; they are noted "INFRINGES ON
   USER NAME SPACE" below.  */

/* Identify Bison output.  */
#define YYBISON 1

/* Bison version.  */
#define YYBISON_VERSION "2.3"

/* Skeleton name.  */
#define YYSKELETON_NAME "yacc.c"

/* Pure parsers.  */
#define YYPURE 1



/* Using locations.  */

#define YYLSP_NEEDED 1


/* Substitute the variable and function names.  */
#define yyparse TclDateparse
#define yylex   TclDatelex
#define yyerror TclDateerror
#define yylval  TclDatelval
#define yychar  TclDatechar
#define yydebug TclDatedebug
#define yynerrs TclDatenerrs
#define yylloc TclDatelloc

/* Tokens.  */
#ifndef YYTOKENTYPE
# define YYTOKENTYPE
   /* Put the tokens into the symbol table, so that GDB and other debuggers
      know about them.  */
   enum yytokentype {
     tAGO = 258,
     tDAY = 259,
     tDAYZONE = 260,
     tID = 261,
     tMERIDIAN = 262,
     tMONTH = 263,
     tMONTH_UNIT = 264,
     tSTARDATE = 265,
     tSEC_UNIT = 266,
     tSNUMBER = 267,
     tUNUMBER = 268,
     tZONE = 269,
     tEPOCH = 270,
     tDST = 271,
     tISOBASE = 272,
     tDAY_UNIT = 273,
     tNEXT = 274
   };
#endif
/* Tokens.  */
#define tAGO 258
#define tDAY 259
#define tDAYZONE 260
#define tID 261
#define tMERIDIAN 262
#define tMONTH 263
#define tMONTH_UNIT 264
#define tSTARDATE 265
#define tSEC_UNIT 266
#define tSNUMBER 267
#define tUNUMBER 268
#define tZONE 269
#define tEPOCH 270
#define tDST 271
#define tISOBASE 272
#define tDAY_UNIT 273
#define tNEXT 274




/* Copy the first part of user declarations.  */


/*
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in the file
 *	tclGetDate.y. It should not be edited directly.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.

 */
#include "tclInt.h"

/*
 * Bison generates several labels that happen to be unused. MS Visual C++
 * doesn't like that, and complains. Tell it to shut up.
 */







|







>
>
|
>
|

>

|
|
|
<
<
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
















>







40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65


66
67















































68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
   define necessary library symbols; they are noted "INFRINGES ON
   USER NAME SPACE" below.  */

/* Identify Bison output.  */
#define YYBISON 1

/* Bison version.  */
#define YYBISON_VERSION "3.1"

/* Skeleton name.  */
#define YYSKELETON_NAME "yacc.c"

/* Pure parsers.  */
#define YYPURE 1

/* Push parsers.  */
#define YYPUSH 0

/* Pull parsers.  */
#define YYPULL 1


/* Substitute the variable and function names.  */
#define yyparse         TclDateparse
#define yylex           TclDatelex
#define yyerror         TclDateerror


#define yydebug         TclDatedebug
#define yynerrs         TclDatenerrs

















































/* Copy the first part of user declarations.  */


/*
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in the file
 *	tclGetDate.y. It should not be edited directly.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */
#include "tclInt.h"

/*
 * Bison generates several labels that happen to be unused. MS Visual C++
 * doesn't like that, and complains. Tell it to shut up.
 */
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#define YYMALLOC	ckalloc
#define YYFREE(x)	(ckfree((void*) (x)))

#define yyDSTmode	(info->dateDSTmode)
#define yyDayOrdinal	(info->dateDayOrdinal)
#define yyDayNumber	(info->dateDayNumber)
#define yyMonthOrdinal	(info->dateMonthOrdinal)
#define yyHaveDate	(info->dateHaveDate)
#define yyHaveDay	(info->dateHaveDay)







|
|







134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#define YYMALLOC	Tcl_Alloc
#define YYFREE(x)	(Tcl_Free((void*) (x)))

#define yyDSTmode	(info->dateDSTmode)
#define yyDayOrdinal	(info->dateDayOrdinal)
#define yyDayNumber	(info->dateDayNumber)
#define yyMonthOrdinal	(info->dateMonthOrdinal)
#define yyHaveDate	(info->dateHaveDate)
#define yyHaveDay	(info->dateHaveDay)
252
253
254
255
256
257
258
259
260



261

262
263
264
265
266
267
268
269
270
271
272









273
274




















275
276

277

278
279
280

281
282
283
284

285
286
287
288
289
290
291

292
293

294
295
296
297
298
299
300
301
302
303





304
305
306
307
308
309
310

typedef enum _MERIDIAN {
    MERam, MERpm, MER24
} MERIDIAN;



/* Enabling traces.  */
#ifndef YYDEBUG



# define YYDEBUG 0

#endif

/* Enabling verbose error messages.  */
#ifdef YYERROR_VERBOSE
# undef YYERROR_VERBOSE
# define YYERROR_VERBOSE 1
#else
# define YYERROR_VERBOSE 0
#endif

/* Enabling the token table.  */









#ifndef YYTOKEN_TABLE
# define YYTOKEN_TABLE 0




















#endif


#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED

typedef union YYSTYPE

{

    time_t Number;
    enum _MERIDIAN Meridian;
}
/* Line 187 of yacc.c.  */


	YYSTYPE;
# define yystype YYSTYPE /* obsolescent; will be withdrawn */
# define YYSTYPE_IS_DECLARED 1
# define YYSTYPE_IS_TRIVIAL 1
#endif


#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
typedef struct YYLTYPE

{
  int first_line;
  int first_column;
  int last_line;
  int last_column;
} YYLTYPE;
# define yyltype YYLTYPE /* obsolescent; will be withdrawn */
# define YYLTYPE_IS_DECLARED 1
# define YYLTYPE_IS_TRIVIAL 1
#endif







/* Copy the second part of user declarations.  */



/*







|
|
>
>
>
|
>
|









|
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>

>
|
|
|
>


|
|
>

|
<
|
|


>

|
>





|
<



>
>
>
>
>







205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
284
285
286
287
288
289
290

291
292
293
294
295
296
297
298
299
300
301
302
303
304
305

typedef enum _MERIDIAN {
    MERam, MERpm, MER24
} MERIDIAN;




# ifndef YY_NULLPTR
#  if defined __cplusplus && 201103L <= __cplusplus
#   define YY_NULLPTR nullptr
#  else
#   define YY_NULLPTR 0
#  endif
# endif

/* Enabling verbose error messages.  */
#ifdef YYERROR_VERBOSE
# undef YYERROR_VERBOSE
# define YYERROR_VERBOSE 1
#else
# define YYERROR_VERBOSE 0
#endif


/* Debug traces.  */
#ifndef YYDEBUG
# define YYDEBUG 0
#endif
#if YYDEBUG
extern int TclDatedebug;
#endif

/* Token type.  */
#ifndef YYTOKENTYPE
# define YYTOKENTYPE
  enum yytokentype
  {
    tAGO = 258,
    tDAY = 259,
    tDAYZONE = 260,
    tID = 261,
    tMERIDIAN = 262,
    tMONTH = 263,
    tMONTH_UNIT = 264,
    tSTARDATE = 265,
    tSEC_UNIT = 266,
    tSNUMBER = 267,
    tUNUMBER = 268,
    tZONE = 269,
    tEPOCH = 270,
    tDST = 271,
    tISOBASE = 272,
    tDAY_UNIT = 273,
    tNEXT = 274
  };
#endif

/* Value type.  */
#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED

union YYSTYPE
{


    time_t Number;
    enum _MERIDIAN Meridian;


};

typedef union YYSTYPE YYSTYPE;

# define YYSTYPE_IS_TRIVIAL 1
# define YYSTYPE_IS_DECLARED 1
#endif

/* Location type.  */
#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
typedef struct YYLTYPE YYLTYPE;
struct YYLTYPE
{
  int first_line;
  int first_column;
  int last_line;
  int last_column;
};

# define YYLTYPE_IS_DECLARED 1
# define YYLTYPE_IS_TRIVIAL 1
#endif



int TclDateparse (DateInfo* info);



/* Copy the second part of user declarations.  */



/*
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361





362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377



























378
379
380
381
382
383
384
385
386
387

388
389



390

391
392


393
394
395

396
397
398
399

400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425

426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532




















533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548

549
550
551
552
553
554
555

556
557
558
559
560
561
562
				   DateInfo* info);
static time_t		ToSeconds(time_t Hours, time_t Minutes,
			    time_t Seconds, MERIDIAN Meridian);
MODULE_SCOPE int	yyparse(DateInfo*);



/* Line 216 of yacc.c.  */


#ifdef short
# undef short
#endif

#ifdef YYTYPE_UINT8
typedef YYTYPE_UINT8 yytype_uint8;
#else
typedef unsigned char yytype_uint8;
#endif

#ifdef YYTYPE_INT8
typedef YYTYPE_INT8 yytype_int8;
#elif (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
typedef signed char yytype_int8;
#else
typedef short int yytype_int8;
#endif

#ifdef YYTYPE_UINT16
typedef YYTYPE_UINT16 yytype_uint16;
#else
typedef unsigned short int yytype_uint16;
#endif

#ifdef YYTYPE_INT16
typedef YYTYPE_INT16 yytype_int16;
#else
typedef short int yytype_int16;
#endif

#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
#  define YYSIZE_T __SIZE_TYPE__





# else
#  define YYSIZE_T size_t
# endif
#endif

#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)

#ifndef YY_
# if YYENABLE_NLS
#  if ENABLE_NLS
#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
#   define YY_(msgid) dgettext ("bison-runtime", msgid)
#  endif
# endif
# ifndef YY_
#  define YY_(msgid) msgid



























# endif
#endif

/* Suppress unused-variable warnings by "using" E.  */
#if ! defined lint || defined __GNUC__
# define YYUSE(e) ((void) (e))
#else
# define YYUSE(e) /* empty */
#endif


/* Identity function, used to suppress warnings about constant conditions.  */
#ifndef lint



# define YYID(n) (n)

#else
#if (defined __STDC__ || defined __C99__FUNC__ \


     || defined __cplusplus || defined _MSC_VER)
static int
YYID (int i)

#else
static int
YYID (i)
    int i;

#endif
{
  return i;
}
#endif

#if ! defined yyoverflow || YYERROR_VERBOSE

/* The parser invokes alloca or malloc; define the necessary symbols.  */

# ifdef YYSTACK_USE_ALLOCA
#  if YYSTACK_USE_ALLOCA
#   ifdef __GNUC__
#    define YYSTACK_ALLOC __builtin_alloca
#   elif defined __BUILTIN_VA_ARG_INCR
#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
#   elif defined _AIX
#    define YYSTACK_ALLOC __alloca
#   elif defined _MSC_VER
#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
#    define alloca _alloca
#   else
#    define YYSTACK_ALLOC alloca
#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */

#     ifndef _STDLIB_H
#      define _STDLIB_H 1
#     endif
#    endif
#   endif
#  endif
# endif

# ifdef YYSTACK_ALLOC
   /* Pacify GCC's `empty if-body' warning.  */
#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
#  ifndef YYSTACK_ALLOC_MAXIMUM
    /* The OS might guarantee only one guard page at the bottom of the stack,
       and a page size can be as small as 4096 bytes.  So we cannot safely
       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
       to allow for a few compiler-allocated temporary stack slots.  */
#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
#  endif
# else
#  define YYSTACK_ALLOC YYMALLOC
#  define YYSTACK_FREE YYFREE
#  ifndef YYSTACK_ALLOC_MAXIMUM
#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
#  endif
#  if (defined __cplusplus && ! defined _STDLIB_H \
       && ! ((defined YYMALLOC || defined malloc) \
	     && (defined YYFREE || defined free)))
#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
#   ifndef _STDLIB_H
#    define _STDLIB_H 1
#   endif
#  endif
#  ifndef YYMALLOC
#   define YYMALLOC malloc
#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
#   endif
#  endif
#  ifndef YYFREE
#   define YYFREE free
#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
void free (void *); /* INFRINGES ON USER NAME SPACE */
#   endif
#  endif
# endif
#endif /* ! defined yyoverflow || YYERROR_VERBOSE */


#if (! defined yyoverflow \
     && (! defined __cplusplus \
	 || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
	     && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))

/* A type that is properly aligned for any stack member.  */
union yyalloc
{
  yytype_int16 yyss;
  YYSTYPE yyvs;
    YYLTYPE yyls;
};

/* The size of the maximum gap between one aligned stack and the next.  */
# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)

/* The size of an array large to enough to hold all stacks, each with
   N elements.  */
# define YYSTACK_BYTES(N) \
     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \
      + 2 * YYSTACK_GAP_MAXIMUM)

/* Copy COUNT objects from FROM to TO.  The source and destination do
   not overlap.  */
# ifndef YYCOPY
#  if defined __GNUC__ && 1 < __GNUC__
#   define YYCOPY(To, From, Count) \
      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
#  else
#   define YYCOPY(To, From, Count)		\
      do					\
	{					\
	  YYSIZE_T yyi;				\
	  for (yyi = 0; yyi < (Count); yyi++)	\
	    (To)[yyi] = (From)[yyi];		\
	}					\
      while (YYID (0))
#  endif
# endif

/* Relocate STACK from its old location to the new one.  The
   local variables YYSIZE and YYSTACKSIZE give the old and new number of
   elements in the stack, and YYPTR gives the new location of the
   stack.  Advance YYPTR to a properly aligned location for the next
   stack.  */
# define YYSTACK_RELOCATE(Stack)					\
    do									\
      {									\
	YYSIZE_T yynewbytes;						\
	YYCOPY (&yyptr->Stack, Stack, yysize);				\
	Stack = &yyptr->Stack;						\
	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
	yyptr += yynewbytes / sizeof (*yyptr);				\
      }									\
    while (YYID (0))

#endif





















/* YYFINAL -- State number of the termination state.  */
#define YYFINAL  2
/* YYLAST -- Last index in YYTABLE.  */
#define YYLAST   79

/* YYNTOKENS -- Number of terminals.  */
#define YYNTOKENS  26
/* YYNNTS -- Number of nonterminals.  */
#define YYNNTS  16
/* YYNRULES -- Number of rules.  */
#define YYNRULES  56
/* YYNRULES -- Number of states.  */
#define YYNSTATES  83

/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */

#define YYUNDEFTOK  2
#define YYMAXUTOK   274

#define YYTRANSLATE(YYX)						\
  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)

/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */

static const yytype_uint8 yytranslate[] =
{
       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,    25,    22,    21,    24,    23,     2,     2,







<
<













<
<
<

|





|





|





>
>
>
>
>

|






|


|



|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





|

|


>
|
|
>
>
>
|
>

|
>
>
|
<
<
>
|
<
|
<
>

|
<
<
<


















|
<

>
|
|







|
|













|

|

|
|




|
<





|
<









|
|




|
|
|











<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<






|
|
|
|
|
|
|
|
|
|


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>












|


|
>



|
|

|
>







313
314
315
316
317
318
319


320
321
322
323
324
325
326
327
328
329
330
331
332



333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422


423
424

425

426
427
428



429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447

448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484

485
486
487
488
489
490

491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519




520












521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
				   DateInfo* info);
static time_t		ToSeconds(time_t Hours, time_t Minutes,
			    time_t Seconds, MERIDIAN Meridian);
MODULE_SCOPE int	yyparse(DateInfo*);






#ifdef short
# undef short
#endif

#ifdef YYTYPE_UINT8
typedef YYTYPE_UINT8 yytype_uint8;
#else
typedef unsigned char yytype_uint8;
#endif

#ifdef YYTYPE_INT8
typedef YYTYPE_INT8 yytype_int8;



#else
typedef signed char yytype_int8;
#endif

#ifdef YYTYPE_UINT16
typedef YYTYPE_UINT16 yytype_uint16;
#else
typedef unsigned short yytype_uint16;
#endif

#ifdef YYTYPE_INT16
typedef YYTYPE_INT16 yytype_int16;
#else
typedef short yytype_int16;
#endif

#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
#  define YYSIZE_T __SIZE_TYPE__
# elif defined size_t
#  define YYSIZE_T size_t
# elif ! defined YYSIZE_T
#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
#  define YYSIZE_T size_t
# else
#  define YYSIZE_T unsigned
# endif
#endif

#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)

#ifndef YY_
# if defined YYENABLE_NLS && YYENABLE_NLS
#  if ENABLE_NLS
#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
#   define YY_(Msgid) dgettext ("bison-runtime", Msgid)
#  endif
# endif
# ifndef YY_
#  define YY_(Msgid) Msgid
# endif
#endif

#ifndef YY_ATTRIBUTE
# if (defined __GNUC__                                               \
      && (2 < __GNUC__ || (__GNUC__ == 2 && 96 <= __GNUC_MINOR__)))  \
     || defined __SUNPRO_C && 0x5110 <= __SUNPRO_C
#  define YY_ATTRIBUTE(Spec) __attribute__(Spec)
# else
#  define YY_ATTRIBUTE(Spec) /* empty */
# endif
#endif

#ifndef YY_ATTRIBUTE_PURE
# define YY_ATTRIBUTE_PURE   YY_ATTRIBUTE ((__pure__))
#endif

#ifndef YY_ATTRIBUTE_UNUSED
# define YY_ATTRIBUTE_UNUSED YY_ATTRIBUTE ((__unused__))
#endif

#if !defined _Noreturn \
     && (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112)
# if defined _MSC_VER && 1200 <= _MSC_VER
#  define _Noreturn __declspec (noreturn)
# else
#  define _Noreturn YY_ATTRIBUTE ((__noreturn__))
# endif
#endif

/* Suppress unused-variable warnings by "using" E.  */
#if ! defined lint || defined __GNUC__
# define YYUSE(E) ((void) (E))
#else
# define YYUSE(E) /* empty */
#endif

#if defined __GNUC__ && ! defined __ICC && 407 <= __GNUC__ * 100 + __GNUC_MINOR__
/* Suppress an incorrect diagnostic about yylval being uninitialized.  */
# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \
    _Pragma ("GCC diagnostic push") \
    _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")\
    _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"")
# define YY_IGNORE_MAYBE_UNINITIALIZED_END \
    _Pragma ("GCC diagnostic pop")
#else
# define YY_INITIAL_VALUE(Value) Value
#endif
#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN


# define YY_IGNORE_MAYBE_UNINITIALIZED_END
#endif

#ifndef YY_INITIAL_VALUE

# define YY_INITIAL_VALUE(Value) /* Nothing. */
#endif





#if ! defined yyoverflow || YYERROR_VERBOSE

/* The parser invokes alloca or malloc; define the necessary symbols.  */

# ifdef YYSTACK_USE_ALLOCA
#  if YYSTACK_USE_ALLOCA
#   ifdef __GNUC__
#    define YYSTACK_ALLOC __builtin_alloca
#   elif defined __BUILTIN_VA_ARG_INCR
#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
#   elif defined _AIX
#    define YYSTACK_ALLOC __alloca
#   elif defined _MSC_VER
#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
#    define alloca _alloca
#   else
#    define YYSTACK_ALLOC alloca
#    if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS

#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
      /* Use EXIT_SUCCESS as a witness for stdlib.h.  */
#     ifndef EXIT_SUCCESS
#      define EXIT_SUCCESS 0
#     endif
#    endif
#   endif
#  endif
# endif

# ifdef YYSTACK_ALLOC
   /* Pacify GCC's 'empty if-body' warning.  */
#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)
#  ifndef YYSTACK_ALLOC_MAXIMUM
    /* The OS might guarantee only one guard page at the bottom of the stack,
       and a page size can be as small as 4096 bytes.  So we cannot safely
       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
       to allow for a few compiler-allocated temporary stack slots.  */
#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
#  endif
# else
#  define YYSTACK_ALLOC YYMALLOC
#  define YYSTACK_FREE YYFREE
#  ifndef YYSTACK_ALLOC_MAXIMUM
#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
#  endif
#  if (defined __cplusplus && ! defined EXIT_SUCCESS \
       && ! ((defined YYMALLOC || defined malloc) \
             && (defined YYFREE || defined free)))
#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
#   ifndef EXIT_SUCCESS
#    define EXIT_SUCCESS 0
#   endif
#  endif
#  ifndef YYMALLOC
#   define YYMALLOC malloc
#   if ! defined malloc && ! defined EXIT_SUCCESS

void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
#   endif
#  endif
#  ifndef YYFREE
#   define YYFREE free
#   if ! defined free && ! defined EXIT_SUCCESS

void free (void *); /* INFRINGES ON USER NAME SPACE */
#   endif
#  endif
# endif
#endif /* ! defined yyoverflow || YYERROR_VERBOSE */


#if (! defined yyoverflow \
     && (! defined __cplusplus \
         || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
             && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))

/* A type that is properly aligned for any stack member.  */
union yyalloc
{
  yytype_int16 yyss_alloc;
  YYSTYPE yyvs_alloc;
  YYLTYPE yyls_alloc;
};

/* The size of the maximum gap between one aligned stack and the next.  */
# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)

/* The size of an array large to enough to hold all stacks, each with
   N elements.  */
# define YYSTACK_BYTES(N) \
     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \
      + 2 * YYSTACK_GAP_MAXIMUM)





# define YYCOPY_NEEDED 1













/* Relocate STACK from its old location to the new one.  The
   local variables YYSIZE and YYSTACKSIZE give the old and new number of
   elements in the stack, and YYPTR gives the new location of the
   stack.  Advance YYPTR to a properly aligned location for the next
   stack.  */
# define YYSTACK_RELOCATE(Stack_alloc, Stack)                           \
    do                                                                  \
      {                                                                 \
        YYSIZE_T yynewbytes;                                            \
        YYCOPY (&yyptr->Stack_alloc, Stack, yysize);                    \
        Stack = &yyptr->Stack_alloc;                                    \
        yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
        yyptr += yynewbytes / sizeof (*yyptr);                          \
      }                                                                 \
    while (0)

#endif

#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
/* Copy COUNT objects from SRC to DST.  The source and destination do
   not overlap.  */
# ifndef YYCOPY
#  if defined __GNUC__ && 1 < __GNUC__
#   define YYCOPY(Dst, Src, Count) \
      __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src)))
#  else
#   define YYCOPY(Dst, Src, Count)              \
      do                                        \
        {                                       \
          YYSIZE_T yyi;                         \
          for (yyi = 0; yyi < (Count); yyi++)   \
            (Dst)[yyi] = (Src)[yyi];            \
        }                                       \
      while (0)
#  endif
# endif
#endif /* !YYCOPY_NEEDED */

/* YYFINAL -- State number of the termination state.  */
#define YYFINAL  2
/* YYLAST -- Last index in YYTABLE.  */
#define YYLAST   79

/* YYNTOKENS -- Number of terminals.  */
#define YYNTOKENS  26
/* YYNNTS -- Number of nonterminals.  */
#define YYNNTS  16
/* YYNRULES -- Number of rules.  */
#define YYNRULES  56
/* YYNSTATES -- Number of states.  */
#define YYNSTATES  83

/* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned
   by yylex, with out-of-bounds checking.  */
#define YYUNDEFTOK  2
#define YYMAXUTOK   274

#define YYTRANSLATE(YYX)                                                \
  ((unsigned) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)

/* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM
   as returned by yylex, without out-of-bounds checking.  */
static const yytype_uint8 yytranslate[] =
{
       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,    25,    22,    21,    24,    23,     2,     2,
582
583
584
585
586
587
588
589
590
591
592

593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661

662

663
664
665
666
667
668
669
670
671
672
673


674
675
676
677
678
679
680



681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699







700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     1,     2,     3,     4,
       5,     6,     7,     8,     9,    10,    11,    12,    13,    14,
      15,    16,    17,    18,    19
};

#if YYDEBUG
/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
   YYRHS.  */
static const yytype_uint8 yyprhs[] =
{

       0,     0,     3,     4,     7,     9,    11,    13,    15,    17,
      19,    21,    23,    25,    28,    33,    39,    46,    54,    57,
      59,    61,    63,    66,    69,    73,    76,    80,    86,    88,
      94,   100,   103,   108,   111,   113,   117,   120,   124,   128,
     136,   139,   144,   147,   149,   153,   156,   159,   163,   165,
     167,   169,   171,   173,   175,   177,   178
};

/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
static const yytype_int8 yyrhs[] =
{
      27,     0,    -1,    -1,    27,    28,    -1,    29,    -1,    30,
      -1,    32,    -1,    33,    -1,    31,    -1,    36,    -1,    34,
      -1,    35,    -1,    40,    -1,    13,     7,    -1,    13,    20,
      13,    41,    -1,    13,    20,    13,    21,    13,    -1,    13,
      20,    13,    20,    13,    41,    -1,    13,    20,    13,    20,
      13,    21,    13,    -1,    14,    16,    -1,    14,    -1,     5,
      -1,     4,    -1,     4,    22,    -1,    13,     4,    -1,    38,
      13,     4,    -1,    19,     4,    -1,    13,    23,    13,    -1,
      13,    23,    13,    23,    13,    -1,    17,    -1,    13,    21,
       8,    21,    13,    -1,    13,    21,    13,    21,    13,    -1,
       8,    13,    -1,     8,    13,    22,    13,    -1,    13,     8,
      -1,    15,    -1,    13,     8,    13,    -1,    19,     8,    -1,
      19,    13,     8,    -1,    17,    14,    17,    -1,    17,    14,
      13,    20,    13,    20,    13,    -1,    17,    17,    -1,    10,
      13,    24,    13,    -1,    37,     3,    -1,    37,    -1,    38,
      13,    39,    -1,    13,    39,    -1,    19,    39,    -1,    19,
      13,    39,    -1,    39,    -1,    21,    -1,    25,    -1,    11,
      -1,    18,    -1,     9,    -1,    13,    -1,    -1,     7,    -1
};

/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
static const yytype_uint16 yyrline[] =
{
       0,   225,   225,   226,   229,   232,   235,   238,   241,   244,
     247,   251,   256,   259,   265,   271,   279,   285,   296,   300,
     304,   310,   314,   318,   322,   326,   332,   336,   341,   346,
     351,   356,   360,   365,   369,   374,   381,   385,   391,   400,
     409,   419,   433,   438,   441,   444,   447,   450,   453,   458,
     461,   466,   470,   474,   480,   498,   501
};
#endif

#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
static const char *const yytname[] =
{
  "$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID",
  "tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE", "tSEC_UNIT",
  "tSNUMBER", "tUNUMBER", "tZONE", "tEPOCH", "tDST", "tISOBASE",
  "tDAY_UNIT", "tNEXT", "':'", "'-'", "','", "'/'", "'.'", "'+'",
  "$accept", "spec", "item", "time", "zone", "day", "date", "ordMonth",
  "iso", "trek", "relspec", "relunits", "sign", "unit", "number",
  "o_merid", 0
};
#endif

# ifdef YYPRINT
/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
   token YYLEX-NUM.  */
static const yytype_uint16 yytoknum[] =
{
       0,   256,   257,   258,   259,   260,   261,   262,   263,   264,
     265,   266,   267,   268,   269,   270,   271,   272,   273,   274,
      58,    45,    44,    47,    46,    43
};
# endif


/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */

static const yytype_uint8 yyr1[] =
{
       0,    26,    27,    27,    28,    28,    28,    28,    28,    28,
      28,    28,    28,    29,    29,    29,    29,    29,    30,    30,
      30,    31,    31,    31,    31,    31,    32,    32,    32,    32,
      32,    32,    32,    32,    32,    32,    33,    33,    34,    34,
      34,    35,    36,    36,    37,    37,    37,    37,    37,    38,
      38,    39,    39,    39,    40,    41,    41
};

/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */


static const yytype_uint8 yyr2[] =
{
       0,     2,     0,     2,     1,     1,     1,     1,     1,     1,
       1,     1,     1,     2,     4,     5,     6,     7,     2,     1,
       1,     1,     2,     2,     3,     2,     3,     5,     1,     5,
       5,     2,     4,     2,     1,     3,     2,     3,     3,     7,
       2,     4,     2,     1,     3,     2,     2,     3,     1,     1,



       1,     1,     1,     1,     1,     0,     1
};

/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
   means the default is an error.  */
static const yytype_uint8 yydefact[] =
{
       2,     0,     1,    21,    20,     0,    53,     0,    51,    54,
      19,    34,    28,    52,     0,    49,    50,     3,     4,     5,
       8,     6,     7,    10,    11,     9,    43,     0,    48,    12,
      22,    31,     0,    23,    13,    33,     0,     0,     0,    45,
      18,     0,    40,    25,    36,     0,    46,    42,     0,     0,
       0,    35,    55,     0,     0,    26,     0,    38,    37,    47,
      24,    44,    32,    41,    56,     0,     0,    14,     0,     0,
       0,     0,    55,    15,    29,    30,    27,     0,     0,    16,
       0,    17,    39
};








/* YYDEFGOTO[NTERM-NUM].  */
static const yytype_int8 yydefgoto[] =
{
      -1,     1,    17,    18,    19,    20,    21,    22,    23,    24,
      25,    26,    27,    28,    29,    67
};

/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
   STATE-NUM.  */
#define YYPACT_NINF -22
static const yytype_int8 yypact[] =
{
     -22,     2,   -22,   -21,   -22,    -4,   -22,     1,   -22,    22,
      18,   -22,     8,   -22,    40,   -22,   -22,   -22,   -22,   -22,
     -22,   -22,   -22,   -22,   -22,   -22,    32,    28,   -22,   -22,
     -22,    24,    26,   -22,   -22,    42,    47,    -5,    49,   -22,
     -22,    15,   -22,   -22,   -22,    48,   -22,   -22,    43,    50,
      51,   -22,    17,    44,    46,    45,    52,   -22,   -22,   -22,
     -22,   -22,   -22,   -22,   -22,    56,    57,   -22,    58,    60,
      61,    62,    -3,   -22,   -22,   -22,   -22,    59,    63,   -22,
      64,   -22,   -22
};

/* YYPGOTO[NTERM-NUM].  */
static const yytype_int8 yypgoto[] =
{
     -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,
     -22,   -22,   -22,    -9,   -22,     6
};

/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
   positive, shift that token.  If negative, reduce the rule which
   number is the opposite.  If zero, do what YYDEFACT says.
   If YYTABLE_NINF, syntax error.  */
#define YYTABLE_NINF -1
static const yytype_uint8 yytable[] =
{
      39,    30,     2,    53,    64,    46,     3,     4,    54,    31,
       5,     6,     7,     8,    32,     9,    10,    11,    78,    12,
      13,    14,    41,    15,    64,    42,    33,    16,    56,    34,
      35,     6,    57,     8,    40,    47,    59,    65,    66,    61,
      13,    48,    36,    37,    43,    38,    49,    60,    44,     6,







|
<
|

>
|
|
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
|



|










|




|
|








>
|
>
|
|
<
<
|
|
|
<
<
|
|
>
>
|

|
|
|
|
|
>
>
>
|


|
|
|













>
>
>
>
>
>
>
|






<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<
|
<







610
611
612
613
614
615
616
617

618
619
620
621
622





623






















624








625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659


660
661
662


663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709























710
711

712

713
714
715
716
717
718
719
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     1,     2,     3,     4,
       5,     6,     7,     8,     9,    10,    11,    12,    13,    14,
      15,    16,    17,    18,    19
};

#if YYDEBUG
  /* YYRLINE[YYN] -- Source line where rule number YYN was defined.  */

static const yytype_uint16 yyrline[] =
{
       0,   223,   223,   224,   227,   230,   233,   236,   239,   242,
     245,   249,   254,   257,   263,   269,   277,   283,   294,   298,
     302,   308,   312,   316,   320,   324,   330,   334,   339,   344,





     349,   354,   358,   363,   367,   372,   379,   383,   389,   398,






















     407,   417,   431,   436,   439,   442,   445,   448,   451,   456,








     459,   464,   468,   472,   478,   496,   499
};
#endif

#if YYDEBUG || YYERROR_VERBOSE || 0
/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
static const char *const yytname[] =
{
  "$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID",
  "tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE", "tSEC_UNIT",
  "tSNUMBER", "tUNUMBER", "tZONE", "tEPOCH", "tDST", "tISOBASE",
  "tDAY_UNIT", "tNEXT", "':'", "'-'", "','", "'/'", "'.'", "'+'",
  "$accept", "spec", "item", "time", "zone", "day", "date", "ordMonth",
  "iso", "trek", "relspec", "relunits", "sign", "unit", "number",
  "o_merid", YY_NULLPTR
};
#endif

# ifdef YYPRINT
/* YYTOKNUM[NUM] -- (External) token number corresponding to the
   (internal) symbol number NUM (which must be that of a token).  */
static const yytype_uint16 yytoknum[] =
{
       0,   256,   257,   258,   259,   260,   261,   262,   263,   264,
     265,   266,   267,   268,   269,   270,   271,   272,   273,   274,
      58,    45,    44,    47,    46,    43
};
# endif

#define YYPACT_NINF -22

#define yypact_value_is_default(Yystate) \
  (!!((Yystate) == (-22)))



#define YYTABLE_NINF -1

#define yytable_value_is_error(Yytable_value) \


  0

  /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
     STATE-NUM.  */
static const yytype_int8 yypact[] =
{
     -22,     2,   -22,   -21,   -22,    -4,   -22,     1,   -22,    22,
      18,   -22,     8,   -22,    40,   -22,   -22,   -22,   -22,   -22,
     -22,   -22,   -22,   -22,   -22,   -22,    32,    28,   -22,   -22,
     -22,    24,    26,   -22,   -22,    42,    47,    -5,    49,   -22,
     -22,    15,   -22,   -22,   -22,    48,   -22,   -22,    43,    50,
      51,   -22,    17,    44,    46,    45,    52,   -22,   -22,   -22,
     -22,   -22,   -22,   -22,   -22,    56,    57,   -22,    58,    60,
      61,    62,    -3,   -22,   -22,   -22,   -22,    59,    63,   -22,
      64,   -22,   -22
};

  /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM.
     Performed when YYTABLE does not specify something else to do.  Zero
     means the default is an error.  */
static const yytype_uint8 yydefact[] =
{
       2,     0,     1,    21,    20,     0,    53,     0,    51,    54,
      19,    34,    28,    52,     0,    49,    50,     3,     4,     5,
       8,     6,     7,    10,    11,     9,    43,     0,    48,    12,
      22,    31,     0,    23,    13,    33,     0,     0,     0,    45,
      18,     0,    40,    25,    36,     0,    46,    42,     0,     0,
       0,    35,    55,     0,     0,    26,     0,    38,    37,    47,
      24,    44,    32,    41,    56,     0,     0,    14,     0,     0,
       0,     0,    55,    15,    29,    30,    27,     0,     0,    16,
       0,    17,    39
};

  /* YYPGOTO[NTERM-NUM].  */
static const yytype_int8 yypgoto[] =
{
     -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,
     -22,   -22,   -22,    -9,   -22,     6
};

  /* YYDEFGOTO[NTERM-NUM].  */
static const yytype_int8 yydefgoto[] =
{
      -1,     1,    17,    18,    19,    20,    21,    22,    23,    24,
      25,    26,    27,    28,    29,    67
};
























  /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM.  If
     positive, shift that token.  If negative, reduce the rule whose

     number is the opposite.  If YYTABLE_NINF, syntax error.  */

static const yytype_uint8 yytable[] =
{
      39,    30,     2,    53,    64,    46,     3,     4,    54,    31,
       5,     6,     7,     8,    32,     9,    10,    11,    78,    12,
      13,    14,    41,    15,    64,    42,    33,    16,    56,    34,
      35,     6,    57,     8,    40,    47,    59,    65,    66,    61,
      13,    48,    36,    37,    43,    38,    49,    60,    44,     6,
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773























774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799

800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821

822
823

824
825
826
827
828

829
830

831
832
833
834
835

836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880

881
882

883

884








885
886



887






888


889
























890
891
892
893
894
895
896
897
898
899
900
901

902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973


974

975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001

1002
1003
1004
1005
1006
1007
1008
1009
1010
1011

1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
       8,     9,    17,    11,    16,     3,    45,    20,    21,    48,
      18,    13,    20,    21,     4,    23,    22,     4,     8,     9,
      24,    11,     9,    13,    11,    13,     8,     9,    18,    11,
      13,    18,    13,    13,    13,    21,    18,    21,    23,    13,
      13,    13,    20,    13,    13,    13,    13,    13,    72,    20
};

/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
   symbol of state STATE-NUM.  */
static const yytype_uint8 yystos[] =
{
       0,    27,     0,     4,     5,     8,     9,    10,    11,    13,
      14,    15,    17,    18,    19,    21,    25,    28,    29,    30,
      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
      22,    13,    13,     4,     7,     8,    20,    21,    23,    39,
      16,    14,    17,     4,     8,    13,    39,     3,    13,    22,
      24,    13,    13,     8,    13,    13,    13,    17,     8,    39,
       4,    39,    13,    13,     7,    20,    21,    41,    21,    21,
      23,    20,    13,    13,    13,    13,    13,    13,    21,    41,
      20,    13,    13
};
























#define yyerrok		(yyerrstatus = 0)
#define yyclearin	(yychar = YYEMPTY)
#define YYEMPTY		(-2)
#define YYEOF		0

#define YYACCEPT	goto yyacceptlab
#define YYABORT		goto yyabortlab
#define YYERROR		goto yyerrorlab


/* Like YYERROR except do call yyerror.  This remains here temporarily
   to ease the transition to the new meaning of YYERROR, for GCC.
   Once GCC version 2 has supplanted version 1, this can go.  */

#define YYFAIL		goto yyerrlab

#define YYRECOVERING()  (!!yyerrstatus)

#define YYBACKUP(Token, Value)					\
do								\
  if (yychar == YYEMPTY && yylen == 1)				\
    {								\
      yychar = (Token);						\
      yylval = (Value);						\
      yytoken = YYTRANSLATE (yychar);				\
      YYPOPSTACK (1);						\

      goto yybackup;						\
    }								\
  else								\
    {								\
      yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \
      YYERROR;							\
    }								\
while (YYID (0))


#define YYTERROR	1
#define YYERRCODE	256


/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
   If N is 0, then set CURRENT to the empty location which ends
   the previous symbol: RHS[0] (always defined).  */

#define YYRHSLOC(Rhs, K) ((Rhs)[K])
#ifndef YYLLOC_DEFAULT
# define YYLLOC_DEFAULT(Current, Rhs, N)				\
    do									\

      if (YYID (N))                                                    \
	{								\

	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
	}								\

      else								\
	{								\

	  (Current).first_line   = (Current).last_line   =		\
	    YYRHSLOC (Rhs, 0).last_line;				\
	  (Current).first_column = (Current).last_column =		\
	    YYRHSLOC (Rhs, 0).last_column;				\
	}								\

    while (YYID (0))
#endif


/* YY_LOCATION_PRINT -- Print the location on the stream.
   This macro was not mandated originally: define only if we know
   we won't break user code: when these are the locations we know.  */

#ifndef YY_LOCATION_PRINT
# if YYLTYPE_IS_TRIVIAL
#  define YY_LOCATION_PRINT(File, Loc)			\
     fprintf (File, "%d.%d-%d.%d",			\
	      (Loc).first_line, (Loc).first_column,	\
	      (Loc).last_line,  (Loc).last_column)
# else
#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
# endif
#endif


/* YYLEX -- calling `yylex' with the right arguments.  */

#ifdef YYLEX_PARAM
# define YYLEX yylex (&yylval, &yylloc, YYLEX_PARAM)
#else
# define YYLEX yylex (&yylval, &yylloc, info)
#endif

/* Enable debugging if requested.  */
#if YYDEBUG

# ifndef YYFPRINTF
#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
#  define YYFPRINTF fprintf
# endif

# define YYDPRINTF(Args)			\
do {						\
  if (yydebug)					\
    YYFPRINTF Args;				\
} while (YYID (0))

# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
do {									  \
  if (yydebug)								  \

    {									  \
      YYFPRINTF (stderr, "%s ", Title);					  \

      yy_symbol_print (stderr,						  \

		  Type, Value, Location, info); \








      YYFPRINTF (stderr, "\n");						  \
    }									  \



} while (YYID (0))


































/*--------------------------------.
| Print this symbol on YYOUTPUT.  |
`--------------------------------*/

/*ARGSUSED*/
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
#else
static void
yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info)

    FILE *yyoutput;
    int yytype;
    YYSTYPE const * const yyvaluep;
    YYLTYPE const * const yylocationp;
    DateInfo* info;
#endif
{
  if (!yyvaluep)
    return;
  YYUSE (yylocationp);
  YYUSE (info);
# ifdef YYPRINT
  if (yytype < YYNTOKENS)
    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
# else
  YYUSE (yyoutput);
# endif
  switch (yytype)
    {
      default:
	break;
    }
}


/*--------------------------------.
| Print this symbol on YYOUTPUT.  |
`--------------------------------*/

#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
#else
static void
yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info)
    FILE *yyoutput;
    int yytype;
    YYSTYPE const * const yyvaluep;
    YYLTYPE const * const yylocationp;
    DateInfo* info;
#endif
{
  if (yytype < YYNTOKENS)
    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
  else
    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);

  YY_LOCATION_PRINT (yyoutput, *yylocationp);
  YYFPRINTF (yyoutput, ": ");
  yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info);
  YYFPRINTF (yyoutput, ")");
}

/*------------------------------------------------------------------.
| yy_stack_print -- Print the state stack from its BOTTOM up to its |
| TOP (included).                                                   |
`------------------------------------------------------------------*/

#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
#else
static void
yy_stack_print (bottom, top)
    yytype_int16 *bottom;
    yytype_int16 *top;
#endif
{
  YYFPRINTF (stderr, "Stack now");
  for (; bottom <= top; ++bottom)


    YYFPRINTF (stderr, " %d", *bottom);

  YYFPRINTF (stderr, "\n");
}

# define YY_STACK_PRINT(Bottom, Top)				\
do {								\
  if (yydebug)							\
    yy_stack_print ((Bottom), (Top));				\
} while (YYID (0))


/*------------------------------------------------.
| Report that the YYRULE is going to be reduced.  |
`------------------------------------------------*/

#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_reduce_print (YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)
#else
static void
yy_reduce_print (yyvsp, yylsp, yyrule, info)
    YYSTYPE *yyvsp;
    YYLTYPE *yylsp;
    int yyrule;
    DateInfo* info;
#endif
{

  int yynrhs = yyr2[yyrule];
  int yyi;
  unsigned long int yylno = yyrline[yyrule];
  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
	     yyrule - 1, yylno);
  /* The symbols being reduced.  */
  for (yyi = 0; yyi < yynrhs; yyi++)
    {
      fprintf (stderr, "   $%d = ", yyi + 1);
      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],

		       &(yyvsp[(yyi + 1) - (yynrhs)])
		       , &(yylsp[(yyi + 1) - (yynrhs)])		       , info);
      fprintf (stderr, "\n");
    }
}

# define YY_REDUCE_PRINT(Rule)		\
do {					\
  if (yydebug)				\
    yy_reduce_print (yyvsp, yylsp, Rule, info); \
} while (YYID (0))

/* Nonzero means print parse trace.  It is left uninitialized so that
   multiple parsers can coexist.  */
int yydebug;
#else /* !YYDEBUG */
# define YYDPRINTF(Args)
# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
# define YY_STACK_PRINT(Bottom, Top)
# define YY_REDUCE_PRINT(Rule)
#endif /* !YYDEBUG */


/* YYINITDEPTH -- initial size of the parser's stacks.  */
#ifndef	YYINITDEPTH
# define YYINITDEPTH 200
#endif

/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
   if the built-in stack extension method is used).

   Do not make this value too large; the results are undefined if
   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
   evaluated with infinite-precision integer arithmetic.  */

#ifndef YYMAXDEPTH
# define YYMAXDEPTH 10000
#endif



#if YYERROR_VERBOSE

# ifndef yystrlen
#  if defined __GLIBC__ && defined _STRING_H
#   define yystrlen strlen
#  else
/* Return the length of YYSTR.  */
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static YYSIZE_T
yystrlen (const char *yystr)
#else
static YYSIZE_T
yystrlen (yystr)
    const char *yystr;
#endif
{
  YYSIZE_T yylen;
  for (yylen = 0; yystr[yylen]; yylen++)
    continue;
  return yylen;
}
#  endif
# endif

# ifndef yystpcpy
#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
#   define yystpcpy stpcpy
#  else
/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
   YYDEST.  */
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static char *
yystpcpy (char *yydest, const char *yysrc)
#else
static char *
yystpcpy (yydest, yysrc)
    char *yydest;
    const char *yysrc;
#endif
{
  char *yyd = yydest;
  const char *yys = yysrc;

  while ((*yyd++ = *yys++) != '\0')
    continue;








|
|













>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|

|
|
|

<
<
<
<
<
<



|
|
|
|
|
|
<
|
>
|
|
|
|

|
|
|

|
|
|






<

|
<
>
|
<
>
|
|
|
|
<
>
|
<
>
|
|
|
|
<
>
|


|
<
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<









|
|
|
|
|

|
|
|
>
|
|
>
|
>
|
>
>
>
>
>
>
>
>
|
<
>
>
>
|
>
>
>
>
>
>
|
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|

<
<
<


<
<
<
>
|
|
<
|
|
<
<


<
<



<
<

|
<
<
<
<







<
<


<
<
<
<
<
<
<
<
<

<
|
<
|












<
<

|
<
<
<
<
<
<


|
>
>
|
>



|
|
|
|
|






<
<

|
<
<
<
<
<
<
<
<

>


<

|



|
|
>
|
|
|



|
|
|
|
|













|














<








<
<


<
<
<
<
<















<
<


<
<
<
<
<
<







730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783






784
785
786
787
788
789
790
791
792

793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812

813
814

815
816

817
818
819
820
821

822
823

824
825
826
827
828

829
830
831
832
833



834



















835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868

869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910



911
912



913
914
915

916
917


918
919


920
921
922


923
924




925
926
927
928
929
930
931


932
933









934

935

936
937
938
939
940
941
942
943
944
945
946
947
948


949
950






951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971


972
973








974
975
976
977

978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024

1025
1026
1027
1028
1029
1030
1031
1032


1033
1034





1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049


1050
1051






1052
1053
1054
1055
1056
1057
1058
       8,     9,    17,    11,    16,     3,    45,    20,    21,    48,
      18,    13,    20,    21,     4,    23,    22,     4,     8,     9,
      24,    11,     9,    13,    11,    13,     8,     9,    18,    11,
      13,    18,    13,    13,    13,    21,    18,    21,    23,    13,
      13,    13,    20,    13,    13,    13,    13,    13,    72,    20
};

  /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
     symbol of state STATE-NUM.  */
static const yytype_uint8 yystos[] =
{
       0,    27,     0,     4,     5,     8,     9,    10,    11,    13,
      14,    15,    17,    18,    19,    21,    25,    28,    29,    30,
      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
      22,    13,    13,     4,     7,     8,    20,    21,    23,    39,
      16,    14,    17,     4,     8,    13,    39,     3,    13,    22,
      24,    13,    13,     8,    13,    13,    13,    17,     8,    39,
       4,    39,    13,    13,     7,    20,    21,    41,    21,    21,
      23,    20,    13,    13,    13,    13,    13,    13,    21,    41,
      20,    13,    13
};

  /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
static const yytype_uint8 yyr1[] =
{
       0,    26,    27,    27,    28,    28,    28,    28,    28,    28,
      28,    28,    28,    29,    29,    29,    29,    29,    30,    30,
      30,    31,    31,    31,    31,    31,    32,    32,    32,    32,
      32,    32,    32,    32,    32,    32,    33,    33,    34,    34,
      34,    35,    36,    36,    37,    37,    37,    37,    37,    38,
      38,    39,    39,    39,    40,    41,    41
};

  /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN.  */
static const yytype_uint8 yyr2[] =
{
       0,     2,     0,     2,     1,     1,     1,     1,     1,     1,
       1,     1,     1,     2,     4,     5,     6,     7,     2,     1,
       1,     1,     2,     2,     3,     2,     3,     5,     1,     5,
       5,     2,     4,     2,     1,     3,     2,     3,     3,     7,
       2,     4,     2,     1,     3,     2,     2,     3,     1,     1,
       1,     1,     1,     1,     1,     0,     1
};


#define yyerrok         (yyerrstatus = 0)
#define yyclearin       (yychar = YYEMPTY)
#define YYEMPTY         (-2)
#define YYEOF           0

#define YYACCEPT        goto yyacceptlab
#define YYABORT         goto yyabortlab
#define YYERROR         goto yyerrorlab








#define YYRECOVERING()  (!!yyerrstatus)

#define YYBACKUP(Token, Value)                                  \
do                                                              \
  if (yychar == YYEMPTY)                                        \
    {                                                           \
      yychar = (Token);                                         \
      yylval = (Value);                                         \

      YYPOPSTACK (yylen);                                       \
      yystate = *yyssp;                                         \
      goto yybackup;                                            \
    }                                                           \
  else                                                          \
    {                                                           \
      yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \
      YYERROR;                                                  \
    }                                                           \
while (0)

/* Error token number */
#define YYTERROR        1
#define YYERRCODE       256


/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
   If N is 0, then set CURRENT to the empty location which ends
   the previous symbol: RHS[0] (always defined).  */


#ifndef YYLLOC_DEFAULT
# define YYLLOC_DEFAULT(Current, Rhs, N)                                \

    do                                                                  \
      if (N)                                                            \

        {                                                               \
          (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;        \
          (Current).first_column = YYRHSLOC (Rhs, 1).first_column;      \
          (Current).last_line    = YYRHSLOC (Rhs, N).last_line;         \
          (Current).last_column  = YYRHSLOC (Rhs, N).last_column;       \

        }                                                               \
      else                                                              \

        {                                                               \
          (Current).first_line   = (Current).last_line   =              \
            YYRHSLOC (Rhs, 0).last_line;                                \
          (Current).first_column = (Current).last_column =              \
            YYRHSLOC (Rhs, 0).last_column;                              \

        }                                                               \
    while (0)
#endif

#define YYRHSLOC(Rhs, K) ((Rhs)[K])
























/* Enable debugging if requested.  */
#if YYDEBUG

# ifndef YYFPRINTF
#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
#  define YYFPRINTF fprintf
# endif

# define YYDPRINTF(Args)                        \
do {                                            \
  if (yydebug)                                  \
    YYFPRINTF Args;                             \
} while (0)


/* YY_LOCATION_PRINT -- Print the location on the stream.
   This macro was not mandated originally: define only if we know
   we won't break user code: when these are the locations we know.  */

#ifndef YY_LOCATION_PRINT
# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL

/* Print *YYLOCP on YYO.  Private, do not rely on its existence. */

YY_ATTRIBUTE_UNUSED
static unsigned
yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp)
{
  unsigned res = 0;
  int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0;
  if (0 <= yylocp->first_line)
    {
      res += YYFPRINTF (yyo, "%d", yylocp->first_line);

      if (0 <= yylocp->first_column)
        res += YYFPRINTF (yyo, ".%d", yylocp->first_column);
    }
  if (0 <= yylocp->last_line)
    {
      if (yylocp->first_line < yylocp->last_line)
        {
          res += YYFPRINTF (yyo, "-%d", yylocp->last_line);
          if (0 <= end_col)
            res += YYFPRINTF (yyo, ".%d", end_col);
        }
      else if (0 <= end_col && yylocp->first_column < end_col)
        res += YYFPRINTF (yyo, "-%d", end_col);
    }
  return res;
 }

#  define YY_LOCATION_PRINT(File, Loc)          \
  yy_location_print_ (File, &(Loc))

# else
#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
# endif
#endif


# define YY_SYMBOL_PRINT(Title, Type, Value, Location)                    \
do {                                                                      \
  if (yydebug)                                                            \
    {                                                                     \
      YYFPRINTF (stderr, "%s ", Title);                                   \
      yy_symbol_print (stderr,                                            \
                  Type, Value, Location, info); \
      YYFPRINTF (stderr, "\n");                                           \
    }                                                                     \
} while (0)


/*----------------------------------------.
| Print this symbol's value on YYOUTPUT.  |
`----------------------------------------*/




static void
yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)



{
  FILE *yyo = yyoutput;
  YYUSE (yyo);

  YYUSE (yylocationp);
  YYUSE (info);


  if (!yyvaluep)
    return;


# ifdef YYPRINT
  if (yytype < YYNTOKENS)
    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);


# endif
  YYUSE (yytype);




}


/*--------------------------------.
| Print this symbol on YYOUTPUT.  |
`--------------------------------*/



static void
yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)









{

  YYFPRINTF (yyoutput, "%s %s (",

             yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]);

  YY_LOCATION_PRINT (yyoutput, *yylocationp);
  YYFPRINTF (yyoutput, ": ");
  yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info);
  YYFPRINTF (yyoutput, ")");
}

/*------------------------------------------------------------------.
| yy_stack_print -- Print the state stack from its BOTTOM up to its |
| TOP (included).                                                   |
`------------------------------------------------------------------*/



static void
yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)






{
  YYFPRINTF (stderr, "Stack now");
  for (; yybottom <= yytop; yybottom++)
    {
      int yybot = *yybottom;
      YYFPRINTF (stderr, " %d", yybot);
    }
  YYFPRINTF (stderr, "\n");
}

# define YY_STACK_PRINT(Bottom, Top)                            \
do {                                                            \
  if (yydebug)                                                  \
    yy_stack_print ((Bottom), (Top));                           \
} while (0)


/*------------------------------------------------.
| Report that the YYRULE is going to be reduced.  |
`------------------------------------------------*/



static void
yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)








{
  unsigned long yylno = yyrline[yyrule];
  int yynrhs = yyr2[yyrule];
  int yyi;

  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
             yyrule - 1, yylno);
  /* The symbols being reduced.  */
  for (yyi = 0; yyi < yynrhs; yyi++)
    {
      YYFPRINTF (stderr, "   $%d = ", yyi + 1);
      yy_symbol_print (stderr,
                       yystos[yyssp[yyi + 1 - yynrhs]],
                       &(yyvsp[(yyi + 1) - (yynrhs)])
                       , &(yylsp[(yyi + 1) - (yynrhs)])                       , info);
      YYFPRINTF (stderr, "\n");
    }
}

# define YY_REDUCE_PRINT(Rule)          \
do {                                    \
  if (yydebug)                          \
    yy_reduce_print (yyssp, yyvsp, yylsp, Rule, info); \
} while (0)

/* Nonzero means print parse trace.  It is left uninitialized so that
   multiple parsers can coexist.  */
int yydebug;
#else /* !YYDEBUG */
# define YYDPRINTF(Args)
# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
# define YY_STACK_PRINT(Bottom, Top)
# define YY_REDUCE_PRINT(Rule)
#endif /* !YYDEBUG */


/* YYINITDEPTH -- initial size of the parser's stacks.  */
#ifndef YYINITDEPTH
# define YYINITDEPTH 200
#endif

/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
   if the built-in stack extension method is used).

   Do not make this value too large; the results are undefined if
   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
   evaluated with infinite-precision integer arithmetic.  */

#ifndef YYMAXDEPTH
# define YYMAXDEPTH 10000
#endif



#if YYERROR_VERBOSE

# ifndef yystrlen
#  if defined __GLIBC__ && defined _STRING_H
#   define yystrlen strlen
#  else
/* Return the length of YYSTR.  */


static YYSIZE_T
yystrlen (const char *yystr)





{
  YYSIZE_T yylen;
  for (yylen = 0; yystr[yylen]; yylen++)
    continue;
  return yylen;
}
#  endif
# endif

# ifndef yystpcpy
#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
#   define yystpcpy stpcpy
#  else
/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
   YYDEST.  */


static char *
yystpcpy (char *yydest, const char *yysrc)






{
  char *yyd = yydest;
  const char *yys = yysrc;

  while ((*yyd++ = *yys++) != '\0')
    continue;

1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153

1154
1155
1156
1157
1158

1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175



1176


1177
1178


1179
1180




1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194

1195

1196
1197

1198
1199
1200

1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212

1213
1214
1215
1216
1217
1218
1219
1220
1221

1222

1223

1224
1225
1226
1227
1228


1229
1230
1231



1232









1233
1234

1235



1236
1237

1238







1239
1240
1241

1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349

1350



1351
1352








1353
1354
1355
























1356

1357



1358

1359
1360
1361
1362
1363
1364





1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409





1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466

1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509



1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
{
  if (*yystr == '"')
    {
      YYSIZE_T yyn = 0;
      char const *yyp = yystr;

      for (;;)
	switch (*++yyp)
	  {
	  case '\'':
	  case ',':
	    goto do_not_strip_quotes;

	  case '\\':
	    if (*++yyp != '\\')
	      goto do_not_strip_quotes;
	    /* Fall through.  */
	  default:
	    if (yyres)
	      yyres[yyn] = *yyp;
	    yyn++;
	    break;

	  case '"':
	    if (yyres)
	      yyres[yyn] = '\0';
	    return yyn;
	  }
    do_not_strip_quotes: ;
    }

  if (! yyres)
    return yystrlen (yystr);

  return yystpcpy (yyres, yystr) - yyres;
}
# endif


/* Copy into YYRESULT an error message about the unexpected token
   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
   including the terminating null byte.  If YYRESULT is null, do not
   copy anything; just return the number of bytes that would be
   copied.  As a special case, return 0 if an ordinary "syntax error"

   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
   size calculation.  */
static YYSIZE_T
yysyntax_error (char *yyresult, int yystate, int yychar)
{
  int yyn = yypact[yystate];

  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
    return 0;
  else
    {
      int yytype = YYTRANSLATE (yychar);
      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
      YYSIZE_T yysize = yysize0;
      YYSIZE_T yysize1;
      int yysize_overflow = 0;
      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };



      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];


      int yyx;



# if 0
      /* This is so xgettext sees the translatable formats that are




	 constructed on the fly.  */
      YY_("syntax error, unexpected %s");
      YY_("syntax error, unexpected %s, expecting %s");
      YY_("syntax error, unexpected %s, expecting %s or %s");
      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
# endif
      char *yyfmt;
      char const *yyf;
      static char const yyunexpected[] = "syntax error, unexpected %s";
      static char const yyexpecting[] = ", expecting %s";
      static char const yyor[] = " or %s";
      char yyformat[sizeof yyunexpected
		    + sizeof yyexpecting - 1

		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)

		       * (sizeof yyor - 1))];
      char const *yyprefix = yyexpecting;


      /* Start YYX at -YYN if negative to avoid negative indexes in
	 YYCHECK.  */

      int yyxbegin = yyn < 0 ? -yyn : 0;

      /* Stay within bounds of both yycheck and yytname.  */
      int yychecklim = YYLAST - yyn + 1;
      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
      int yycount = 1;

      yyarg[0] = yytname[yytype];
      yyfmt = yystpcpy (yyformat, yyunexpected);

      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)

	  {
	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
	      {
		yycount = 1;
		yysize = yysize0;
		yyformat[sizeof yyunexpected - 1] = '\0';
		break;
	      }
	    yyarg[yycount++] = yytname[yyx];

	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);

	    yysize_overflow |= (yysize1 < yysize);

	    yysize = yysize1;
	    yyfmt = yystpcpy (yyfmt, yyprefix);
	    yyprefix = yyor;
	  }



      yyf = YY_(yyformat);
      yysize1 = yysize + yystrlen (yyf);
      yysize_overflow |= (yysize1 < yysize);



      yysize = yysize1;










      if (yysize_overflow)

	return YYSIZE_MAXIMUM;




      if (yyresult)

	{







	  /* Avoid sprintf, as that infringes on the user's name space.
	     Don't have undefined behavior even if the translation
	     produced a string with the wrong number of "%s"s.  */

	  char *yyp = yyresult;
	  int yyi = 0;
	  while ((*yyp = *yyf) != '\0')
	    {
	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
		{
		  yyp += yytnamerr (yyp, yyarg[yyi++]);
		  yyf += 2;
		}
	      else
		{
		  yyp++;
		  yyf++;
		}
	    }
	}
      return yysize;
    }
}
#endif /* YYERROR_VERBOSE */


/*-----------------------------------------------.
| Release the memory associated to this symbol.  |
`-----------------------------------------------*/

/*ARGSUSED*/
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, DateInfo* info)
#else
static void
yydestruct (yymsg, yytype, yyvaluep, yylocationp, info)
    const char *yymsg;
    int yytype;
    YYSTYPE *yyvaluep;
    YYLTYPE *yylocationp;
    DateInfo* info;
#endif
{
  YYUSE (yyvaluep);
  YYUSE (yylocationp);
  YYUSE (info);

  if (!yymsg)
    yymsg = "Deleting";
  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);

  switch (yytype)
    {

      default:
	break;
    }
}


/* Prevent warnings from -Wmissing-prototypes.  */

#ifdef YYPARSE_PARAM
#if defined __STDC__ || defined __cplusplus
int yyparse (void *YYPARSE_PARAM);
#else
int yyparse ();
#endif
#else /* ! YYPARSE_PARAM */
#if defined __STDC__ || defined __cplusplus
int yyparse (DateInfo* info);
#else
int yyparse ();
#endif
#endif /* ! YYPARSE_PARAM */






/*----------.
| yyparse.  |
`----------*/

#ifdef YYPARSE_PARAM
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
int
yyparse (void *YYPARSE_PARAM)
#else
int
yyparse (YYPARSE_PARAM)
    void *YYPARSE_PARAM;
#endif
#else /* ! YYPARSE_PARAM */
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
int
yyparse (DateInfo* info)
#else
int
yyparse (info)
    DateInfo* info;
#endif
#endif
{
  /* The look-ahead symbol.  */
int yychar;


/* The semantic value of the look-ahead symbol.  */



YYSTYPE yylval = {0};









/* Number of syntax errors so far.  */
int yynerrs;
/* Location data for the look-ahead symbol.  */
























YYLTYPE yylloc;





  int yystate;

  int yyn;
  int yyresult;
  /* Number of tokens to shift before error messages enabled.  */
  int yyerrstatus;
  /* Look-ahead token as an internal (translated) token number.  */
  int yytoken = 0;





#if YYERROR_VERBOSE
  /* Buffer for error messages, and its allocated size.  */
  char yymsgbuf[128];
  char *yymsg = yymsgbuf;
  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
#endif

  /* Three stacks and their tools:
     `yyss': related to states,
     `yyvs': related to semantic values,
     `yyls': related to locations.

     Refer to the stacks thru separate pointers, to allow yyoverflow
     to reallocate them elsewhere.  */

  /* The state stack.  */
  yytype_int16 yyssa[YYINITDEPTH];
  yytype_int16 *yyss = yyssa;
  yytype_int16 *yyssp;

  /* The semantic value stack.  */
  YYSTYPE yyvsa[YYINITDEPTH];
  YYSTYPE *yyvs = yyvsa;
  YYSTYPE *yyvsp;

  /* The location stack.  */
  YYLTYPE yylsa[YYINITDEPTH];
  YYLTYPE *yyls = yylsa;
  YYLTYPE *yylsp;
  /* The locations where the error started and ended.  */
  YYLTYPE yyerror_range[2];

#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N), yylsp -= (N))

  YYSIZE_T yystacksize = YYINITDEPTH;

  /* The variables used to return semantic value and location from the
     action routines.  */
  YYSTYPE yyval;
  YYLTYPE yyloc;

  /* The number of symbols on the RHS of the reduced rule.
     Keep to zero when no symbol should be popped.  */
  int yylen = 0;






  YYDPRINTF ((stderr, "Starting parse\n"));

  yystate = 0;
  yyerrstatus = 0;
  yynerrs = 0;
  yychar = YYEMPTY;		/* Cause a token to be read.  */

  /* Initialize stack pointers.
     Waste one element of value and location stack
     so that they stay on the same level as the state stack.
     The wasted elements are never initialized.  */

  yyssp = yyss;
  yyvsp = yyvs;
  yylsp = yyls;
#if YYLTYPE_IS_TRIVIAL
  /* Initialize the default location before parsing starts.  */
  yylloc.first_line   = yylloc.last_line   = 1;
  yylloc.first_column = yylloc.last_column = 0;
#endif

  goto yysetstate;

/*------------------------------------------------------------.
| yynewstate -- Push a new state, which is found in yystate.  |
`------------------------------------------------------------*/
 yynewstate:
  /* In all cases, when you get here, the value and location stacks
     have just been pushed.  So pushing a state here evens the stacks.  */
  yyssp++;

 yysetstate:
  *yyssp = yystate;

  if (yyss + yystacksize - 1 <= yyssp)
    {
      /* Get the current used size of the three stacks, in elements.  */
      YYSIZE_T yysize = yyssp - yyss + 1;

#ifdef yyoverflow
      {
	/* Give user a chance to reallocate the stack.  Use copies of
	   these so that the &'s don't force the real ones into
	   memory.  */
	YYSTYPE *yyvs1 = yyvs;
	yytype_int16 *yyss1 = yyss;
	YYLTYPE *yyls1 = yyls;

	/* Each stack pointer address is followed by the size of the
	   data in use in that stack, in bytes.  This used to be a
	   conditional around just the two extra args, but that might
	   be undefined if yyoverflow is a macro.  */
	yyoverflow (YY_("memory exhausted"),
		    &yyss1, yysize * sizeof (*yyssp),
		    &yyvs1, yysize * sizeof (*yyvsp),
		    &yyls1, yysize * sizeof (*yylsp),
		    &yystacksize);

	yyls = yyls1;
	yyss = yyss1;
	yyvs = yyvs1;
      }
#else /* no yyoverflow */
# ifndef YYSTACK_RELOCATE
      goto yyexhaustedlab;
# else
      /* Extend the stack our own way.  */
      if (YYMAXDEPTH <= yystacksize)
	goto yyexhaustedlab;
      yystacksize *= 2;
      if (YYMAXDEPTH < yystacksize)
	yystacksize = YYMAXDEPTH;

      {
	yytype_int16 *yyss1 = yyss;
	union yyalloc *yyptr =
	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
	if (! yyptr)
	  goto yyexhaustedlab;
	YYSTACK_RELOCATE (yyss);
	YYSTACK_RELOCATE (yyvs);
	YYSTACK_RELOCATE (yyls);
#  undef YYSTACK_RELOCATE
	if (yyss1 != yyssa)
	  YYSTACK_FREE (yyss1);
      }
# endif
#endif /* no yyoverflow */

      yyssp = yyss + yysize - 1;
      yyvsp = yyvs + yysize - 1;
      yylsp = yyls + yysize - 1;

      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
		  (unsigned long int) yystacksize));

      if (yyss + yystacksize - 1 <= yyssp)
	YYABORT;
    }

  YYDPRINTF ((stderr, "Entering state %d\n", yystate));




  goto yybackup;

/*-----------.
| yybackup.  |
`-----------*/
yybackup:

  /* Do appropriate processing given the current state.  Read a
     look-ahead token if we need one and don't already have one.  */

  /* First try to decide what to do without reference to look-ahead token.  */
  yyn = yypact[yystate];
  if (yyn == YYPACT_NINF)
    goto yydefault;

  /* Not known => get a look-ahead token if don't already have one.  */

  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
  if (yychar == YYEMPTY)
    {
      YYDPRINTF ((stderr, "Reading a token: "));
      yychar = YYLEX;
    }

  if (yychar <= YYEOF)
    {
      yychar = yytoken = YYEOF;
      YYDPRINTF ((stderr, "Now at end of input.\n"));
    }







|
|
|
|
|

|
|
|
|
|
|
|
|
|

|
|
|
|
|










>
|
<
|
|
|
>
|
|
|
|
<
<
|
<
<
<
|
<
|
|
<
<
|
>
>
>
|
>
>
|

>
>
|
|
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
>
|
|
>
|
|
|
>
|
<
|
|
|
|

<
<
<
|
|
>
|
|
|
|
|
<
|
|
|
>
|
>
|
>
|
<
<
|
|
>
>
|
|
<
>
>
>
|
>
>
>
>
>
>
>
>
>
|
|
>
|
>
>
>
|
|
>
|
>
>
>
>
>
>
>
|
|
|
>
|
|
|
<
|
|
|
|
|
|
|
|
|
|
|
<
|
<


<





<
<
<


<
<
<
<
<
<
<
<
<




<




<
<
|
<
<
<
<
|
|
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








<
<
<

<
<
<
<
<
<
<
<
<
<

<
<
<
<
<
<

|


>
|
>
>
>
|

>
>
>
>
>
>
>
>
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>

>
>
>
|
>


<
<
|

>
>
>
>
>







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


<
<
<
<
<
<
<




>
>
>
>
>





|
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<




















|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
>
|
|
|







|


|


|
|
|
|
|
|
|
|

|
|









|


|



>
>
>









|

|

|


|

|



|







1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113

1114
1115
1116
1117
1118
1119
1120
1121


1122



1123

1124
1125


1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167

1168
1169
1170
1171
1172



1173
1174
1175
1176
1177
1178
1179
1180

1181
1182
1183
1184
1185
1186
1187
1188
1189


1190
1191
1192
1193
1194
1195

1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233

1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244

1245

1246
1247

1248
1249
1250
1251
1252



1253
1254









1255
1256
1257
1258

1259
1260
1261
1262


1263




1264
1265

1266















1267
1268
1269
1270
1271
1272
1273
1274



1275










1276






1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332


1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346

























1347
1348







1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363








1364






1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
{
  if (*yystr == '"')
    {
      YYSIZE_T yyn = 0;
      char const *yyp = yystr;

      for (;;)
        switch (*++yyp)
          {
          case '\'':
          case ',':
            goto do_not_strip_quotes;

          case '\\':
            if (*++yyp != '\\')
              goto do_not_strip_quotes;
            /* Fall through.  */
          default:
            if (yyres)
              yyres[yyn] = *yyp;
            yyn++;
            break;

          case '"':
            if (yyres)
              yyres[yyn] = '\0';
            return yyn;
          }
    do_not_strip_quotes: ;
    }

  if (! yyres)
    return yystrlen (yystr);

  return yystpcpy (yyres, yystr) - yyres;
}
# endif

/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message
   about the unexpected token YYTOKEN for the state stack whose top is

   YYSSP.

   Return 0 if *YYMSG was successfully written.  Return 1 if *YYMSG is
   not large enough to hold the message.  In that case, also set
   *YYMSG_ALLOC to the required number of bytes.  Return 2 if the
   required number of bytes is too large to store.  */
static int
yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg,


                yytype_int16 *yyssp, int yytoken)



{

  YYSIZE_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]);
  YYSIZE_T yysize = yysize0;


  enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
  /* Internationalized format string. */
  const char *yyformat = YY_NULLPTR;
  /* Arguments of yyformat. */
  char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
  /* Number of reported tokens (one for the "unexpected", one per
     "expected"). */
  int yycount = 0;

  /* There are many possibilities here to consider:
     - If this state is a consistent state with a default action, then
       the only way this function was invoked is if the default action
       is an error action.  In that case, don't check for expected
       tokens because there are none.
     - The only way there can be no lookahead present (in yychar) is if
       this state is a consistent state with a default action.  Thus,
       detecting the absence of a lookahead is sufficient to determine
       that there is no unexpected or expected token to report.  In that
       case, just report a simple "syntax error".
     - Don't assume there isn't a lookahead just because this state is a
       consistent state with a default action.  There might have been a
       previous inconsistent state, consistent state with a non-default
       action, or user semantic action that manipulated yychar.
     - Of course, the expected token list depends on states to have
       correct lookahead information, and it depends on the parser not
       to perform extra reductions after fetching a lookahead from the
       scanner and before detecting a syntax error.  Thus, state merging
       (from LALR or IELR) and default reductions corrupt the expected
       token list.  However, the list is correct for canonical LR with
       one exception: it will still contain any token that will not be
       accepted due to an error action in a later state.
  */
  if (yytoken != YYEMPTY)
    {
      int yyn = yypact[*yyssp];
      yyarg[yycount++] = yytname[yytoken];
      if (!yypact_value_is_default (yyn))
        {
          /* Start YYX at -YYN if negative to avoid negative indexes in
             YYCHECK.  In other words, skip the first -YYN actions for
             this state because they are default actions.  */
          int yyxbegin = yyn < 0 ? -yyn : 0;

          /* Stay within bounds of both yycheck and yytname.  */
          int yychecklim = YYLAST - yyn + 1;
          int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
          int yyx;




          for (yyx = yyxbegin; yyx < yyxend; ++yyx)
            if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR
                && !yytable_value_is_error (yytable[yyx + yyn]))
              {
                if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
                  {
                    yycount = 1;
                    yysize = yysize0;

                    break;
                  }
                yyarg[yycount++] = yytname[yyx];
                {
                  YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]);
                  if (! (yysize <= yysize1
                         && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
                    return 2;
                  yysize = yysize1;


                }
              }
        }
    }

  switch (yycount)

    {
# define YYCASE_(N, S)                      \
      case N:                               \
        yyformat = S;                       \
      break
    default: /* Avoid compiler warnings. */
      YYCASE_(0, YY_("syntax error"));
      YYCASE_(1, YY_("syntax error, unexpected %s"));
      YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));
      YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));
      YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));
      YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));
# undef YYCASE_
    }

  {
    YYSIZE_T yysize1 = yysize + yystrlen (yyformat);
    if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
      return 2;
    yysize = yysize1;
  }

  if (*yymsg_alloc < yysize)
    {
      *yymsg_alloc = 2 * yysize;
      if (! (yysize <= *yymsg_alloc
             && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))
        *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;
      return 1;
    }

  /* Avoid sprintf, as that infringes on the user's name space.
     Don't have undefined behavior even if the translation
     produced a string with the wrong number of "%s"s.  */
  {
    char *yyp = *yymsg;
    int yyi = 0;
    while ((*yyp = *yyformat) != '\0')

      if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)
        {
          yyp += yytnamerr (yyp, yyarg[yyi++]);
          yyformat += 2;
        }
      else
        {
          yyp++;
          yyformat++;
        }
  }

  return 0;

}
#endif /* YYERROR_VERBOSE */


/*-----------------------------------------------.
| Release the memory associated to this symbol.  |
`-----------------------------------------------*/




static void
yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, DateInfo* info)









{
  YYUSE (yyvaluep);
  YYUSE (yylocationp);
  YYUSE (info);

  if (!yymsg)
    yymsg = "Deleting";
  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);



  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN




  YYUSE (yytype);
  YY_IGNORE_MAYBE_UNINITIALIZED_END

}



















/*----------.
| yyparse.  |
`----------*/




int










yyparse (DateInfo* info)






{
/* The lookahead symbol.  */
int yychar;


/* The semantic value of the lookahead symbol.  */
/* Default value used for initialization, for pacifying older GCCs
   or non-GCC compilers.  */
YY_INITIAL_VALUE (static YYSTYPE yyval_default;)
YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default);

/* Location data for the lookahead symbol.  */
static YYLTYPE yyloc_default
# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
  = { 1, 1, 1, 1 }
# endif
;
YYLTYPE yylloc = yyloc_default;

    /* Number of syntax errors so far.  */
    int yynerrs;

    int yystate;
    /* Number of tokens to shift before error messages enabled.  */
    int yyerrstatus;

    /* The stacks and their tools:
       'yyss': related to states.
       'yyvs': related to semantic values.
       'yyls': related to locations.

       Refer to the stacks through separate pointers, to allow yyoverflow
       to reallocate them elsewhere.  */

    /* The state stack.  */
    yytype_int16 yyssa[YYINITDEPTH];
    yytype_int16 *yyss;
    yytype_int16 *yyssp;

    /* The semantic value stack.  */
    YYSTYPE yyvsa[YYINITDEPTH];
    YYSTYPE *yyvs;
    YYSTYPE *yyvsp;

    /* The location stack.  */
    YYLTYPE yylsa[YYINITDEPTH];
    YYLTYPE *yyls;
    YYLTYPE *yylsp;

    /* The locations where the error started and ended.  */
    YYLTYPE yyerror_range[3];

    YYSIZE_T yystacksize;

  int yyn;
  int yyresult;


  /* Lookahead token as an internal (translated) token number.  */
  int yytoken = 0;
  /* The variables used to return semantic value and location from the
     action routines.  */
  YYSTYPE yyval;
  YYLTYPE yyloc;

#if YYERROR_VERBOSE
  /* Buffer for error messages, and its allocated size.  */
  char yymsgbuf[128];
  char *yymsg = yymsgbuf;
  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
#endif


























#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N), yylsp -= (N))








  /* The number of symbols on the RHS of the reduced rule.
     Keep to zero when no symbol should be popped.  */
  int yylen = 0;

  yyssp = yyss = yyssa;
  yyvsp = yyvs = yyvsa;
  yylsp = yyls = yylsa;
  yystacksize = YYINITDEPTH;

  YYDPRINTF ((stderr, "Starting parse\n"));

  yystate = 0;
  yyerrstatus = 0;
  yynerrs = 0;
  yychar = YYEMPTY; /* Cause a token to be read.  */








  yylsp[0] = yylloc;






  goto yysetstate;

/*------------------------------------------------------------.
| yynewstate -- Push a new state, which is found in yystate.  |
`------------------------------------------------------------*/
 yynewstate:
  /* In all cases, when you get here, the value and location stacks
     have just been pushed.  So pushing a state here evens the stacks.  */
  yyssp++;

 yysetstate:
  *yyssp = yystate;

  if (yyss + yystacksize - 1 <= yyssp)
    {
      /* Get the current used size of the three stacks, in elements.  */
      YYSIZE_T yysize = yyssp - yyss + 1;

#ifdef yyoverflow
      {
        /* Give user a chance to reallocate the stack.  Use copies of
           these so that the &'s don't force the real ones into
           memory.  */
        YYSTYPE *yyvs1 = yyvs;
        yytype_int16 *yyss1 = yyss;
        YYLTYPE *yyls1 = yyls;

        /* Each stack pointer address is followed by the size of the
           data in use in that stack, in bytes.  This used to be a
           conditional around just the two extra args, but that might
           be undefined if yyoverflow is a macro.  */
        yyoverflow (YY_("memory exhausted"),
                    &yyss1, yysize * sizeof (*yyssp),
                    &yyvs1, yysize * sizeof (*yyvsp),
                    &yyls1, yysize * sizeof (*yylsp),
                    &yystacksize);

        yyls = yyls1;
        yyss = yyss1;
        yyvs = yyvs1;
      }
#else /* no yyoverflow */
# ifndef YYSTACK_RELOCATE
      goto yyexhaustedlab;
# else
      /* Extend the stack our own way.  */
      if (YYMAXDEPTH <= yystacksize)
        goto yyexhaustedlab;
      yystacksize *= 2;
      if (YYMAXDEPTH < yystacksize)
        yystacksize = YYMAXDEPTH;

      {
        yytype_int16 *yyss1 = yyss;
        union yyalloc *yyptr =
          (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
        if (! yyptr)
          goto yyexhaustedlab;
        YYSTACK_RELOCATE (yyss_alloc, yyss);
        YYSTACK_RELOCATE (yyvs_alloc, yyvs);
        YYSTACK_RELOCATE (yyls_alloc, yyls);
#  undef YYSTACK_RELOCATE
        if (yyss1 != yyssa)
          YYSTACK_FREE (yyss1);
      }
# endif
#endif /* no yyoverflow */

      yyssp = yyss + yysize - 1;
      yyvsp = yyvs + yysize - 1;
      yylsp = yyls + yysize - 1;

      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
                  (unsigned long) yystacksize));

      if (yyss + yystacksize - 1 <= yyssp)
        YYABORT;
    }

  YYDPRINTF ((stderr, "Entering state %d\n", yystate));

  if (yystate == YYFINAL)
    YYACCEPT;

  goto yybackup;

/*-----------.
| yybackup.  |
`-----------*/
yybackup:

  /* Do appropriate processing given the current state.  Read a
     lookahead token if we need one and don't already have one.  */

  /* First try to decide what to do without reference to lookahead token.  */
  yyn = yypact[yystate];
  if (yypact_value_is_default (yyn))
    goto yydefault;

  /* Not known => get a lookahead token if don't already have one.  */

  /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
  if (yychar == YYEMPTY)
    {
      YYDPRINTF ((stderr, "Reading a token: "));
      yychar = yylex (&yylval, &yylloc, info);
    }

  if (yychar <= YYEOF)
    {
      yychar = yytoken = YYEOF;
      YYDPRINTF ((stderr, "Now at end of input.\n"));
    }
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575

1576

1577
1578
1579
1580
1581
1582
1583
     detect an error, take that action.  */
  yyn += yytoken;
  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
    goto yydefault;
  yyn = yytable[yyn];
  if (yyn <= 0)
    {
      if (yyn == 0 || yyn == YYTABLE_NINF)
	goto yyerrlab;
      yyn = -yyn;
      goto yyreduce;
    }

  if (yyn == YYFINAL)
    YYACCEPT;

  /* Count tokens shifted since error; after three, turn off error
     status.  */
  if (yyerrstatus)
    yyerrstatus--;

  /* Shift the look-ahead token.  */
  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);

  /* Discard the shifted token unless it is eof.  */
  if (yychar != YYEOF)
    yychar = YYEMPTY;

  yystate = yyn;

  *++yyvsp = yylval;

  *++yylsp = yylloc;
  goto yynewstate;


/*-----------------------------------------------------------.
| yydefault -- do the default action for the current state.  |
`-----------------------------------------------------------*/







|
|




<
<
<





|


|
<
|


>

>







1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497



1498
1499
1500
1501
1502
1503
1504
1505
1506

1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
     detect an error, take that action.  */
  yyn += yytoken;
  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
    goto yydefault;
  yyn = yytable[yyn];
  if (yyn <= 0)
    {
      if (yytable_value_is_error (yyn))
        goto yyerrlab;
      yyn = -yyn;
      goto yyreduce;
    }




  /* Count tokens shifted since error; after three, turn off error
     status.  */
  if (yyerrstatus)
    yyerrstatus--;

  /* Shift the lookahead token.  */
  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);

  /* Discard the shifted token.  */

  yychar = YYEMPTY;

  yystate = yyn;
  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
  *++yyvsp = yylval;
  YY_IGNORE_MAYBE_UNINITIALIZED_END
  *++yylsp = yylloc;
  goto yynewstate;


/*-----------------------------------------------------------.
| yydefault -- do the default action for the current state.  |
`-----------------------------------------------------------*/
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609

1610
1611
1612
1613
1614
1615
1616

1617
1618
1619
1620
1621
1622
1623

1624
1625
1626
1627
1628
1629
1630

1631
1632
1633
1634
1635
1636
1637

1638
1639
1640
1641
1642
1643
1644

1645
1646
1647
1648
1649
1650
1651

1652
1653
1654
1655
1656
1657
1658
1659

1660
1661
1662
1663
1664
1665
1666
1667
1668

1669
1670
1671
1672
1673
1674
1675
1676
1677
1678

1679
1680
1681
1682
1683
1684
1685
1686
1687
1688

1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700

1701
1702
1703
1704
1705
1706
1707
1708
1709
1710

1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723

1724
1725
1726
1727
1728
1729
1730
1731

1732
1733
1734
1735
1736
1737
1738
1739

1740
1741
1742
1743
1744
1745
1746
1747

1748
1749
1750
1751
1752
1753
1754
1755

1756
1757
1758
1759
1760
1761
1762
1763

1764
1765
1766
1767
1768
1769
1770
1771

1772
1773
1774
1775
1776
1777
1778
1779

1780
1781
1782
1783
1784
1785
1786
1787

1788
1789
1790
1791
1792
1793
1794
1795

1796
1797
1798
1799
1800
1801
1802
1803
1804

1805
1806
1807
1808
1809
1810
1811
1812
1813

1814
1815
1816
1817
1818
1819
1820
1821
1822

1823
1824
1825
1826
1827
1828
1829
1830
1831

1832
1833
1834
1835
1836
1837
1838
1839

1840
1841
1842
1843
1844
1845
1846
1847
1848

1849
1850
1851
1852
1853
1854
1855
1856

1857
1858
1859
1860
1861
1862
1863
1864
1865

1866
1867
1868
1869
1870
1871
1872
1873
1874

1875
1876
1877
1878
1879
1880
1881
1882

1883
1884
1885
1886
1887
1888
1889
1890

1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903

1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916

1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928

1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944

1945
1946
1947
1948
1949
1950
1951
1952
1953

1954
1955
1956
1957
1958
1959
1960

1961
1962
1963
1964
1965
1966
1967

1968
1969
1970
1971
1972
1973
1974

1975
1976
1977
1978
1979
1980
1981

1982
1983
1984
1985
1986
1987
1988

1989
1990
1991
1992
1993
1994
1995

1996
1997
1998
1999
2000
2001
2002

2003
2004
2005
2006
2007
2008
2009
2010

2011
2012
2013
2014
2015
2016
2017
2018

2019
2020
2021
2022
2023
2024
2025
2026

2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046

2047
2048
2049
2050
2051
2052
2053

2054
2055
2056
2057
2058
2059
2060

2061
2062
2063
2064
2065
2066
2067
2068











2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096




2097
2098
2099
2100
2101
2102
2103


2104

2105

2106


2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119

2120
2121
2122
2123
2124
2125
2126
2127
2128
2129

2130
2131
2132
2133
2134

2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220

2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
| yyreduce -- Do a reduction.  |
`-----------------------------*/
yyreduce:
  /* yyn is the number of a rule to reduce with.  */
  yylen = yyr2[yyn];

  /* If YYLEN is nonzero, implement the default value of the action:
     `$$ = $1'.

     Otherwise, the following line sets YYVAL to garbage.
     This behavior is undocumented and Bison
     users should not rely upon it.  Assigning to YYVAL
     unconditionally makes the parser a bit smaller, and it avoids a
     GCC warning that YYVAL may be used uninitialized.  */
  yyval = yyvsp[1-yylen];

  /* Default location.  */
  YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen);

  YY_REDUCE_PRINT (yyn);
  switch (yyn)
    {
        case 4:

    {
	    yyHaveTime++;

	;}
    break;

  case 5:

    {
	    yyHaveZone++;

	;}
    break;

  case 6:

    {
	    yyHaveDate++;

	;}
    break;

  case 7:

    {
	    yyHaveOrdinalMonth++;

	;}
    break;

  case 8:

    {
	    yyHaveDay++;

	;}
    break;

  case 9:

    {
	    yyHaveRel++;

	;}
    break;

  case 10:

    {
	    yyHaveTime++;
	    yyHaveDate++;

	;}
    break;

  case 11:

    {
	    yyHaveTime++;
	    yyHaveDate++;
	    yyHaveRel++;

	;}
    break;

  case 13:

    {
	    yyHour = (yyvsp[(1) - (2)].Number);
	    yyMinutes = 0;
	    yySeconds = 0;
	    yyMeridian = (yyvsp[(2) - (2)].Meridian);

	;}
    break;

  case 14:

    {
	    yyHour = (yyvsp[(1) - (4)].Number);
	    yyMinutes = (yyvsp[(3) - (4)].Number);
	    yySeconds = 0;
	    yyMeridian = (yyvsp[(4) - (4)].Meridian);

	;}
    break;

  case 15:

    {
	    yyHour = (yyvsp[(1) - (5)].Number);
	    yyMinutes = (yyvsp[(3) - (5)].Number);
	    yyMeridian = MER24;
	    yyDSTmode = DSToff;
	    yyTimezone = ((yyvsp[(5) - (5)].Number) % 100 + ((yyvsp[(5) - (5)].Number) / 100) * 60);
	    ++yyHaveZone;

	;}
    break;

  case 16:

    {
	    yyHour = (yyvsp[(1) - (6)].Number);
	    yyMinutes = (yyvsp[(3) - (6)].Number);
	    yySeconds = (yyvsp[(5) - (6)].Number);
	    yyMeridian = (yyvsp[(6) - (6)].Meridian);

	;}
    break;

  case 17:

    {
	    yyHour = (yyvsp[(1) - (7)].Number);
	    yyMinutes = (yyvsp[(3) - (7)].Number);
	    yySeconds = (yyvsp[(5) - (7)].Number);
	    yyMeridian = MER24;
	    yyDSTmode = DSToff;
	    yyTimezone = ((yyvsp[(7) - (7)].Number) % 100 + ((yyvsp[(7) - (7)].Number) / 100) * 60);
	    ++yyHaveZone;

	;}
    break;

  case 18:

    {
	    yyTimezone = (yyvsp[(1) - (2)].Number);
	    yyDSTmode = DSTon;

	;}
    break;

  case 19:

    {
	    yyTimezone = (yyvsp[(1) - (1)].Number);
	    yyDSTmode = DSToff;

	;}
    break;

  case 20:

    {
	    yyTimezone = (yyvsp[(1) - (1)].Number);
	    yyDSTmode = DSTon;

	;}
    break;

  case 21:

    {
	    yyDayOrdinal = 1;
	    yyDayNumber = (yyvsp[(1) - (1)].Number);

	;}
    break;

  case 22:

    {
	    yyDayOrdinal = 1;
	    yyDayNumber = (yyvsp[(1) - (2)].Number);

	;}
    break;

  case 23:

    {
	    yyDayOrdinal = (yyvsp[(1) - (2)].Number);
	    yyDayNumber = (yyvsp[(2) - (2)].Number);

	;}
    break;

  case 24:

    {
	    yyDayOrdinal = (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number);
	    yyDayNumber = (yyvsp[(3) - (3)].Number);

	;}
    break;

  case 25:

    {
	    yyDayOrdinal = 2;
	    yyDayNumber = (yyvsp[(2) - (2)].Number);

	;}
    break;

  case 26:

    {
	    yyMonth = (yyvsp[(1) - (3)].Number);
	    yyDay = (yyvsp[(3) - (3)].Number);

	;}
    break;

  case 27:

    {
	    yyMonth = (yyvsp[(1) - (5)].Number);
	    yyDay = (yyvsp[(3) - (5)].Number);
	    yyYear = (yyvsp[(5) - (5)].Number);

	;}
    break;

  case 28:

    {
	    yyYear = (yyvsp[(1) - (1)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (1)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (1)].Number) % 100;

	;}
    break;

  case 29:

    {
	    yyDay = (yyvsp[(1) - (5)].Number);
	    yyMonth = (yyvsp[(3) - (5)].Number);
	    yyYear = (yyvsp[(5) - (5)].Number);

	;}
    break;

  case 30:

    {
	    yyMonth = (yyvsp[(3) - (5)].Number);
	    yyDay = (yyvsp[(5) - (5)].Number);
	    yyYear = (yyvsp[(1) - (5)].Number);

	;}
    break;

  case 31:

    {
	    yyMonth = (yyvsp[(1) - (2)].Number);
	    yyDay = (yyvsp[(2) - (2)].Number);

	;}
    break;

  case 32:

    {
	    yyMonth = (yyvsp[(1) - (4)].Number);
	    yyDay = (yyvsp[(2) - (4)].Number);
	    yyYear = (yyvsp[(4) - (4)].Number);

	;}
    break;

  case 33:

    {
	    yyMonth = (yyvsp[(2) - (2)].Number);
	    yyDay = (yyvsp[(1) - (2)].Number);

	;}
    break;

  case 34:

    {
	    yyMonth = 1;
	    yyDay = 1;
	    yyYear = EPOCH;

	;}
    break;

  case 35:

    {
	    yyMonth = (yyvsp[(2) - (3)].Number);
	    yyDay = (yyvsp[(1) - (3)].Number);
	    yyYear = (yyvsp[(3) - (3)].Number);

	;}
    break;

  case 36:

    {
	    yyMonthOrdinal = 1;
	    yyMonth = (yyvsp[(2) - (2)].Number);

	;}
    break;

  case 37:

    {
	    yyMonthOrdinal = (yyvsp[(2) - (3)].Number);
	    yyMonth = (yyvsp[(3) - (3)].Number);

	;}
    break;

  case 38:

    {
	    if ((yyvsp[(2) - (3)].Number) != HOUR( 7)) YYABORT;
	    yyYear = (yyvsp[(1) - (3)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (3)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (3)].Number) % 100;
	    yyHour = (yyvsp[(3) - (3)].Number) / 10000;
	    yyMinutes = ((yyvsp[(3) - (3)].Number) % 10000)/100;
	    yySeconds = (yyvsp[(3) - (3)].Number) % 100;

	;}
    break;

  case 39:

    {
	    if ((yyvsp[(2) - (7)].Number) != HOUR( 7)) YYABORT;
	    yyYear = (yyvsp[(1) - (7)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (7)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (7)].Number) % 100;
	    yyHour = (yyvsp[(3) - (7)].Number);
	    yyMinutes = (yyvsp[(5) - (7)].Number);
	    yySeconds = (yyvsp[(7) - (7)].Number);

	;}
    break;

  case 40:

    {
	    yyYear = (yyvsp[(1) - (2)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (2)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (2)].Number) % 100;
	    yyHour = (yyvsp[(2) - (2)].Number) / 10000;
	    yyMinutes = ((yyvsp[(2) - (2)].Number) % 10000)/100;
	    yySeconds = (yyvsp[(2) - (2)].Number) % 100;

	;}
    break;

  case 41:

    {
	    /*
	     * Offset computed year by -377 so that the returned years will be
	     * in a range accessible with a 32 bit clock seconds value.
	     */

	    yyYear = (yyvsp[(2) - (4)].Number)/1000 + 2323 - 377;
	    yyDay  = 1;
	    yyMonth = 1;
	    yyRelDay += (((yyvsp[(2) - (4)].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
	    yyRelSeconds += (yyvsp[(4) - (4)].Number) * 144 * 60;

	;}
    break;

  case 42:

    {
	    yyRelSeconds *= -1;
	    yyRelMonth *= -1;
	    yyRelDay *= -1;

	;}
    break;

  case 44:

    {
	    *yyRelPointer += (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);

	;}
    break;

  case 45:

    {
	    *yyRelPointer += (yyvsp[(1) - (2)].Number) * (yyvsp[(2) - (2)].Number);

	;}
    break;

  case 46:

    {
	    *yyRelPointer += (yyvsp[(2) - (2)].Number);

	;}
    break;

  case 47:

    {
	    *yyRelPointer += (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);

	;}
    break;

  case 48:

    {
	    *yyRelPointer += (yyvsp[(1) - (1)].Number);

	;}
    break;

  case 49:

    {
	    (yyval.Number) = -1;

	;}
    break;

  case 50:

    {
	    (yyval.Number) =  1;

	;}
    break;

  case 51:

    {
	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
	    yyRelPointer = &yyRelSeconds;

	;}
    break;

  case 52:

    {
	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
	    yyRelPointer = &yyRelDay;

	;}
    break;

  case 53:

    {
	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
	    yyRelPointer = &yyRelMonth;

	;}
    break;

  case 54:

    {
	    if (yyHaveTime && yyHaveDate && !yyHaveRel) {
		yyYear = (yyvsp[(1) - (1)].Number);
	    } else {
		yyHaveTime++;
		if (yyDigitCount <= 2) {
		    yyHour = (yyvsp[(1) - (1)].Number);
		    yyMinutes = 0;
		} else {
		    yyHour = (yyvsp[(1) - (1)].Number) / 100;
		    yyMinutes = (yyvsp[(1) - (1)].Number) % 100;
		}
		yySeconds = 0;
		yyMeridian = MER24;
	    }

	;}
    break;

  case 55:

    {
	    (yyval.Meridian) = MER24;

	;}
    break;

  case 56:

    {
	    (yyval.Meridian) = (yyvsp[(1) - (1)].Meridian);

	;}
    break;


/* Line 1267 of yacc.c.  */

      default: break;
    }











  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);

  YYPOPSTACK (yylen);
  yylen = 0;
  YY_STACK_PRINT (yyss, yyssp);

  *++yyvsp = yyval;
  *++yylsp = yyloc;

  /* Now `shift' the result of the reduction.  Determine what state
     that goes to, based on the state we popped back to and the rule
     number reduced by.  */

  yyn = yyr1[yyn];

  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
    yystate = yytable[yystate];
  else
    yystate = yydefgoto[yyn - YYNTOKENS];

  goto yynewstate;


/*------------------------------------.
| yyerrlab -- here on detecting error |
`------------------------------------*/
yyerrlab:




  /* If not already recovering from an error, report this error.  */
  if (!yyerrstatus)
    {
      ++yynerrs;
#if ! YYERROR_VERBOSE
      yyerror (&yylloc, info, YY_("syntax error"));
#else


      {

	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);

	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)


	  {
	    YYSIZE_T yyalloc = 2 * yysize;
	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
	    if (yymsg != yymsgbuf)
	      YYSTACK_FREE (yymsg);
	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
	    if (yymsg)
	      yymsg_alloc = yyalloc;
	    else
	      {
		yymsg = yymsgbuf;
		yymsg_alloc = sizeof yymsgbuf;

	      }
	  }

	if (0 < yysize && yysize <= yymsg_alloc)
	  {
	    (void) yysyntax_error (yymsg, yystate, yychar);
	    yyerror (&yylloc, info, yymsg);
	  }
	else
	  {

	    yyerror (&yylloc, info, YY_("syntax error"));
	    if (yysize != 0)
	      goto yyexhaustedlab;
	  }
      }

#endif
    }

  yyerror_range[0] = yylloc;

  if (yyerrstatus == 3)
    {
      /* If just tried and failed to reuse look-ahead token after an
	 error, discard it.  */

      if (yychar <= YYEOF)
	{
	  /* Return failure if at end of input.  */
	  if (yychar == YYEOF)
	    YYABORT;
	}
      else
	{
	  yydestruct ("Error: discarding",
		      yytoken, &yylval, &yylloc, info);
	  yychar = YYEMPTY;
	}
    }

  /* Else will try to reuse look-ahead token after shifting the error
     token.  */
  goto yyerrlab1;


/*---------------------------------------------------.
| yyerrorlab -- error raised explicitly by YYERROR.  |
`---------------------------------------------------*/
yyerrorlab:

  /* Pacify compilers like GCC when the user code never invokes
     YYERROR and the label yyerrorlab therefore never appears in user
     code.  */
  if (/*CONSTCOND*/ 0)
     goto yyerrorlab;

  yyerror_range[0] = yylsp[1-yylen];
  /* Do not reclaim the symbols of the rule which action triggered
     this YYERROR.  */
  YYPOPSTACK (yylen);
  yylen = 0;
  YY_STACK_PRINT (yyss, yyssp);
  yystate = *yyssp;
  goto yyerrlab1;


/*-------------------------------------------------------------.
| yyerrlab1 -- common code for both syntax error and YYERROR.  |
`-------------------------------------------------------------*/
yyerrlab1:
  yyerrstatus = 3;	/* Each real token shifted decrements this.  */

  for (;;)
    {
      yyn = yypact[yystate];
      if (yyn != YYPACT_NINF)
	{
	  yyn += YYTERROR;
	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
	    {
	      yyn = yytable[yyn];
	      if (0 < yyn)
		break;
	    }
	}

      /* Pop the current state because it cannot handle the error token.  */
      if (yyssp == yyss)
	YYABORT;

      yyerror_range[0] = *yylsp;
      yydestruct ("Error: popping",
		  yystos[yystate], yyvsp, yylsp, info);
      YYPOPSTACK (1);
      yystate = *yyssp;
      YY_STACK_PRINT (yyss, yyssp);
    }

  if (yyn == YYFINAL)
    YYACCEPT;

  *++yyvsp = yylval;


  yyerror_range[1] = yylloc;
  /* Using YYLLOC is tempting, but would change the location of
     the look-ahead.  YYLOC is available though.  */
  YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2);
  *++yylsp = yyloc;

  /* Shift the error token.  */
  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);

  yystate = yyn;
  goto yynewstate;







|








|

>







>
|






>
|






>
|






>
|






>
|






>
|







>
|








>
|





|


|
>
|





|
|

|
>
|





|
|


|

>
|





|
|
|
|
>
|





|
|
|


|

>
|





|

>
|





|

>
|





|

>
|






|
>
|






|
>
|





|
|
>
|





|
|
>
|






|
>
|





|
|
>
|





|
|
|
>
|





|
|
|
>
|





|
|
|
>
|





|
|
|
>
|





|
|
>
|





|
|
|
>
|





|
|
>
|








>
|





|
|
|
>
|






|
>
|





|
|
>
|





|
|
|
|
|
|
|
>
|





|
|
|
|
|
|
|
>
|





|
|
|
|
|
|
>
|










|


|
|
>
|








>
|





|
>
|





|
>
|





|
>
|





|
>
|





|
>
|






>
|






>
|





|

>
|





|

>
|





|

>
|






|



|


|
|




>
|






>
|





|
>
|



<



>
>
>
>
>
>
>
>
>
>
>









|














|
|
|

>
>
>
>







>
>

>
|
>
|
>
>
|
<
<
<
|
|
|
|
<
<
|
|
|
>
|
<
|
<
|
|
|
|
<
<
>
|
|
|
|
<
>



|



|
|


|
|
|
|
|

|
|
|
|
|


|















<
|












|




|
|
|
|
|
|
|
|
|
|



|

|

|





<
<
|

>

|

|
|







1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052

2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115



2116
2117
2118
2119


2120
2121
2122
2123
2124

2125

2126
2127
2128
2129


2130
2131
2132
2133
2134

2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175

2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216


2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
| yyreduce -- Do a reduction.  |
`-----------------------------*/
yyreduce:
  /* yyn is the number of a rule to reduce with.  */
  yylen = yyr2[yyn];

  /* If YYLEN is nonzero, implement the default value of the action:
     '$$ = $1'.

     Otherwise, the following line sets YYVAL to garbage.
     This behavior is undocumented and Bison
     users should not rely upon it.  Assigning to YYVAL
     unconditionally makes the parser a bit smaller, and it avoids a
     GCC warning that YYVAL may be used uninitialized.  */
  yyval = yyvsp[1-yylen];

  /* Default location. */
  YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen);
  yyerror_range[1] = yyloc;
  YY_REDUCE_PRINT (yyn);
  switch (yyn)
    {
        case 4:

    {
	    yyHaveTime++;
	}

    break;

  case 5:

    {
	    yyHaveZone++;
	}

    break;

  case 6:

    {
	    yyHaveDate++;
	}

    break;

  case 7:

    {
	    yyHaveOrdinalMonth++;
	}

    break;

  case 8:

    {
	    yyHaveDay++;
	}

    break;

  case 9:

    {
	    yyHaveRel++;
	}

    break;

  case 10:

    {
	    yyHaveTime++;
	    yyHaveDate++;
	}

    break;

  case 11:

    {
	    yyHaveTime++;
	    yyHaveDate++;
	    yyHaveRel++;
	}

    break;

  case 13:

    {
	    yyHour = (yyvsp[-1].Number);
	    yyMinutes = 0;
	    yySeconds = 0;
	    yyMeridian = (yyvsp[0].Meridian);
	}

    break;

  case 14:

    {
	    yyHour = (yyvsp[-3].Number);
	    yyMinutes = (yyvsp[-1].Number);
	    yySeconds = 0;
	    yyMeridian = (yyvsp[0].Meridian);
	}

    break;

  case 15:

    {
	    yyHour = (yyvsp[-4].Number);
	    yyMinutes = (yyvsp[-2].Number);
	    yyMeridian = MER24;
	    yyDSTmode = DSToff;
	    yyTimezone = ((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
	    ++yyHaveZone;
	}

    break;

  case 16:

    {
	    yyHour = (yyvsp[-5].Number);
	    yyMinutes = (yyvsp[-3].Number);
	    yySeconds = (yyvsp[-1].Number);
	    yyMeridian = (yyvsp[0].Meridian);
	}

    break;

  case 17:

    {
	    yyHour = (yyvsp[-6].Number);
	    yyMinutes = (yyvsp[-4].Number);
	    yySeconds = (yyvsp[-2].Number);
	    yyMeridian = MER24;
	    yyDSTmode = DSToff;
	    yyTimezone = ((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
	    ++yyHaveZone;
	}

    break;

  case 18:

    {
	    yyTimezone = (yyvsp[-1].Number);
	    yyDSTmode = DSTon;
	}

    break;

  case 19:

    {
	    yyTimezone = (yyvsp[0].Number);
	    yyDSTmode = DSToff;
	}

    break;

  case 20:

    {
	    yyTimezone = (yyvsp[0].Number);
	    yyDSTmode = DSTon;
	}

    break;

  case 21:

    {
	    yyDayOrdinal = 1;
	    yyDayNumber = (yyvsp[0].Number);
	}

    break;

  case 22:

    {
	    yyDayOrdinal = 1;
	    yyDayNumber = (yyvsp[-1].Number);
	}

    break;

  case 23:

    {
	    yyDayOrdinal = (yyvsp[-1].Number);
	    yyDayNumber = (yyvsp[0].Number);
	}

    break;

  case 24:

    {
	    yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number);
	    yyDayNumber = (yyvsp[0].Number);
	}

    break;

  case 25:

    {
	    yyDayOrdinal = 2;
	    yyDayNumber = (yyvsp[0].Number);
	}

    break;

  case 26:

    {
	    yyMonth = (yyvsp[-2].Number);
	    yyDay = (yyvsp[0].Number);
	}

    break;

  case 27:

    {
	    yyMonth = (yyvsp[-4].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}

    break;

  case 28:

    {
	    yyYear = (yyvsp[0].Number) / 10000;
	    yyMonth = ((yyvsp[0].Number) % 10000)/100;
	    yyDay = (yyvsp[0].Number) % 100;
	}

    break;

  case 29:

    {
	    yyDay = (yyvsp[-4].Number);
	    yyMonth = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}

    break;

  case 30:

    {
	    yyMonth = (yyvsp[-2].Number);
	    yyDay = (yyvsp[0].Number);
	    yyYear = (yyvsp[-4].Number);
	}

    break;

  case 31:

    {
	    yyMonth = (yyvsp[-1].Number);
	    yyDay = (yyvsp[0].Number);
	}

    break;

  case 32:

    {
	    yyMonth = (yyvsp[-3].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}

    break;

  case 33:

    {
	    yyMonth = (yyvsp[0].Number);
	    yyDay = (yyvsp[-1].Number);
	}

    break;

  case 34:

    {
	    yyMonth = 1;
	    yyDay = 1;
	    yyYear = EPOCH;
	}

    break;

  case 35:

    {
	    yyMonth = (yyvsp[-1].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}

    break;

  case 36:

    {
	    yyMonthOrdinal = 1;
	    yyMonth = (yyvsp[0].Number);
	}

    break;

  case 37:

    {
	    yyMonthOrdinal = (yyvsp[-1].Number);
	    yyMonth = (yyvsp[0].Number);
	}

    break;

  case 38:

    {
	    if ((yyvsp[-1].Number) != HOUR( 7)) YYABORT;
	    yyYear = (yyvsp[-2].Number) / 10000;
	    yyMonth = ((yyvsp[-2].Number) % 10000)/100;
	    yyDay = (yyvsp[-2].Number) % 100;
	    yyHour = (yyvsp[0].Number) / 10000;
	    yyMinutes = ((yyvsp[0].Number) % 10000)/100;
	    yySeconds = (yyvsp[0].Number) % 100;
	}

    break;

  case 39:

    {
	    if ((yyvsp[-5].Number) != HOUR( 7)) YYABORT;
	    yyYear = (yyvsp[-6].Number) / 10000;
	    yyMonth = ((yyvsp[-6].Number) % 10000)/100;
	    yyDay = (yyvsp[-6].Number) % 100;
	    yyHour = (yyvsp[-4].Number);
	    yyMinutes = (yyvsp[-2].Number);
	    yySeconds = (yyvsp[0].Number);
	}

    break;

  case 40:

    {
	    yyYear = (yyvsp[-1].Number) / 10000;
	    yyMonth = ((yyvsp[-1].Number) % 10000)/100;
	    yyDay = (yyvsp[-1].Number) % 100;
	    yyHour = (yyvsp[0].Number) / 10000;
	    yyMinutes = ((yyvsp[0].Number) % 10000)/100;
	    yySeconds = (yyvsp[0].Number) % 100;
	}

    break;

  case 41:

    {
	    /*
	     * Offset computed year by -377 so that the returned years will be
	     * in a range accessible with a 32 bit clock seconds value.
	     */

	    yyYear = (yyvsp[-2].Number)/1000 + 2323 - 377;
	    yyDay  = 1;
	    yyMonth = 1;
	    yyRelDay += (((yyvsp[-2].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
	    yyRelSeconds += (yyvsp[0].Number) * 144 * 60;
	}

    break;

  case 42:

    {
	    yyRelSeconds *= -1;
	    yyRelMonth *= -1;
	    yyRelDay *= -1;
	}

    break;

  case 44:

    {
	    *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number);
	}

    break;

  case 45:

    {
	    *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
	}

    break;

  case 46:

    {
	    *yyRelPointer += (yyvsp[0].Number);
	}

    break;

  case 47:

    {
	    *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
	}

    break;

  case 48:

    {
	    *yyRelPointer += (yyvsp[0].Number);
	}

    break;

  case 49:

    {
	    (yyval.Number) = -1;
	}

    break;

  case 50:

    {
	    (yyval.Number) =  1;
	}

    break;

  case 51:

    {
	    (yyval.Number) = (yyvsp[0].Number);
	    yyRelPointer = &yyRelSeconds;
	}

    break;

  case 52:

    {
	    (yyval.Number) = (yyvsp[0].Number);
	    yyRelPointer = &yyRelDay;
	}

    break;

  case 53:

    {
	    (yyval.Number) = (yyvsp[0].Number);
	    yyRelPointer = &yyRelMonth;
	}

    break;

  case 54:

    {
	    if (yyHaveTime && yyHaveDate && !yyHaveRel) {
		yyYear = (yyvsp[0].Number);
	    } else {
		yyHaveTime++;
		if (yyDigitCount <= 2) {
		    yyHour = (yyvsp[0].Number);
		    yyMinutes = 0;
		} else {
		    yyHour = (yyvsp[0].Number) / 100;
		    yyMinutes = (yyvsp[0].Number) % 100;
		}
		yySeconds = 0;
		yyMeridian = MER24;
	    }
	}

    break;

  case 55:

    {
	    (yyval.Meridian) = MER24;
	}

    break;

  case 56:

    {
	    (yyval.Meridian) = (yyvsp[0].Meridian);
	}

    break;




      default: break;
    }
  /* User semantic actions sometimes alter yychar, and that requires
     that yytoken be updated with the new translation.  We take the
     approach of translating immediately before every use of yytoken.
     One alternative is translating here after every semantic action,
     but that translation would be missed if the semantic action invokes
     YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
     if it invokes YYBACKUP.  In the case of YYABORT or YYACCEPT, an
     incorrect destructor might then be invoked immediately.  In the
     case of YYERROR or YYBACKUP, subsequent parser actions might lead
     to an incorrect destructor call or verbose syntax error message
     before the lookahead is translated.  */
  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);

  YYPOPSTACK (yylen);
  yylen = 0;
  YY_STACK_PRINT (yyss, yyssp);

  *++yyvsp = yyval;
  *++yylsp = yyloc;

  /* Now 'shift' the result of the reduction.  Determine what state
     that goes to, based on the state we popped back to and the rule
     number reduced by.  */

  yyn = yyr1[yyn];

  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
    yystate = yytable[yystate];
  else
    yystate = yydefgoto[yyn - YYNTOKENS];

  goto yynewstate;


/*--------------------------------------.
| yyerrlab -- here on detecting error.  |
`--------------------------------------*/
yyerrlab:
  /* Make sure we have latest lookahead translation.  See comments at
     user semantic actions for why this is necessary.  */
  yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);

  /* If not already recovering from an error, report this error.  */
  if (!yyerrstatus)
    {
      ++yynerrs;
#if ! YYERROR_VERBOSE
      yyerror (&yylloc, info, YY_("syntax error"));
#else
# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \
                                        yyssp, yytoken)
      {
        char const *yymsgp = YY_("syntax error");
        int yysyntax_error_status;
        yysyntax_error_status = YYSYNTAX_ERROR;
        if (yysyntax_error_status == 0)
          yymsgp = yymsg;
        else if (yysyntax_error_status == 1)
          {



            if (yymsg != yymsgbuf)
              YYSTACK_FREE (yymsg);
            yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc);
            if (!yymsg)


              {
                yymsg = yymsgbuf;
                yymsg_alloc = sizeof yymsgbuf;
                yysyntax_error_status = 2;
              }

            else

              {
                yysyntax_error_status = YYSYNTAX_ERROR;
                yymsgp = yymsg;
              }


          }
        yyerror (&yylloc, info, yymsgp);
        if (yysyntax_error_status == 2)
          goto yyexhaustedlab;
      }

# undef YYSYNTAX_ERROR
#endif
    }

  yyerror_range[1] = yylloc;

  if (yyerrstatus == 3)
    {
      /* If just tried and failed to reuse lookahead token after an
         error, discard it.  */

      if (yychar <= YYEOF)
        {
          /* Return failure if at end of input.  */
          if (yychar == YYEOF)
            YYABORT;
        }
      else
        {
          yydestruct ("Error: discarding",
                      yytoken, &yylval, &yylloc, info);
          yychar = YYEMPTY;
        }
    }

  /* Else will try to reuse lookahead token after shifting the error
     token.  */
  goto yyerrlab1;


/*---------------------------------------------------.
| yyerrorlab -- error raised explicitly by YYERROR.  |
`---------------------------------------------------*/
yyerrorlab:

  /* Pacify compilers like GCC when the user code never invokes
     YYERROR and the label yyerrorlab therefore never appears in user
     code.  */
  if (/*CONSTCOND*/ 0)
     goto yyerrorlab;


  /* Do not reclaim the symbols of the rule whose action triggered
     this YYERROR.  */
  YYPOPSTACK (yylen);
  yylen = 0;
  YY_STACK_PRINT (yyss, yyssp);
  yystate = *yyssp;
  goto yyerrlab1;


/*-------------------------------------------------------------.
| yyerrlab1 -- common code for both syntax error and YYERROR.  |
`-------------------------------------------------------------*/
yyerrlab1:
  yyerrstatus = 3;      /* Each real token shifted decrements this.  */

  for (;;)
    {
      yyn = yypact[yystate];
      if (!yypact_value_is_default (yyn))
        {
          yyn += YYTERROR;
          if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
            {
              yyn = yytable[yyn];
              if (0 < yyn)
                break;
            }
        }

      /* Pop the current state because it cannot handle the error token.  */
      if (yyssp == yyss)
        YYABORT;

      yyerror_range[1] = *yylsp;
      yydestruct ("Error: popping",
                  yystos[yystate], yyvsp, yylsp, info);
      YYPOPSTACK (1);
      yystate = *yyssp;
      YY_STACK_PRINT (yyss, yyssp);
    }



  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
  *++yyvsp = yylval;
  YY_IGNORE_MAYBE_UNINITIALIZED_END

  yyerror_range[2] = yylloc;
  /* Using YYLLOC is tempting, but would change the location of
     the lookahead.  YYLOC is available though.  */
  YYLLOC_DEFAULT (yyloc, yyerror_range, 2);
  *++yylsp = yyloc;

  /* Shift the error token.  */
  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);

  yystate = yyn;
  goto yynewstate;
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260




2261
2262

2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
/*-----------------------------------.
| yyabortlab -- YYABORT comes here.  |
`-----------------------------------*/
yyabortlab:
  yyresult = 1;
  goto yyreturn;

#ifndef yyoverflow
/*-------------------------------------------------.
| yyexhaustedlab -- memory exhaustion comes here.  |
`-------------------------------------------------*/
yyexhaustedlab:
  yyerror (&yylloc, info, YY_("memory exhausted"));
  yyresult = 2;
  /* Fall through.  */
#endif

yyreturn:
  if (yychar != YYEOF && yychar != YYEMPTY)




     yydestruct ("Cleanup: discarding lookahead",
		 yytoken, &yylval, &yylloc, info);

  /* Do not reclaim the symbols of the rule which action triggered
     this YYABORT or YYACCEPT.  */
  YYPOPSTACK (yylen);
  YY_STACK_PRINT (yyss, yyssp);
  while (yyssp != yyss)
    {
      yydestruct ("Cleanup: popping",
		  yystos[*yyssp], yyvsp, yylsp, info);
      YYPOPSTACK (1);
    }
#ifndef yyoverflow
  if (yyss != yyssa)
    YYSTACK_FREE (yyss);
#endif
#if YYERROR_VERBOSE
  if (yymsg != yymsgbuf)
    YYSTACK_FREE (yymsg);
#endif
  /* Make sure YYID is used.  */
  return YYID (yyresult);
}




/*
 * Month and day table.
 */

static const TABLE MonthDayTable[] = {







|










|
>
>
>
>
|
|
>
|






|










<
|

<
<







2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284

2285
2286


2287
2288
2289
2290
2291
2292
2293
/*-----------------------------------.
| yyabortlab -- YYABORT comes here.  |
`-----------------------------------*/
yyabortlab:
  yyresult = 1;
  goto yyreturn;

#if !defined yyoverflow || YYERROR_VERBOSE
/*-------------------------------------------------.
| yyexhaustedlab -- memory exhaustion comes here.  |
`-------------------------------------------------*/
yyexhaustedlab:
  yyerror (&yylloc, info, YY_("memory exhausted"));
  yyresult = 2;
  /* Fall through.  */
#endif

yyreturn:
  if (yychar != YYEMPTY)
    {
      /* Make sure we have latest lookahead translation.  See comments at
         user semantic actions for why this is necessary.  */
      yytoken = YYTRANSLATE (yychar);
      yydestruct ("Cleanup: discarding lookahead",
                  yytoken, &yylval, &yylloc, info);
    }
  /* Do not reclaim the symbols of the rule whose action triggered
     this YYABORT or YYACCEPT.  */
  YYPOPSTACK (yylen);
  YY_STACK_PRINT (yyss, yyssp);
  while (yyssp != yyss)
    {
      yydestruct ("Cleanup: popping",
                  yystos[*yyssp], yyvsp, yylsp, info);
      YYPOPSTACK (1);
    }
#ifndef yyoverflow
  if (yyss != yyssa)
    YYSTACK_FREE (yyss);
#endif
#if YYERROR_VERBOSE
  if (yymsg != yymsgbuf)
    YYSTACK_FREE (yymsg);
#endif

  return yyresult;
}




/*
 * Month and day table.
 */

static const TABLE MonthDayTable[] = {
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
    register char c;
    register char *p;
    char buff[20];
    int Count;

    location->first_column = yyInput - info->dateStart;
    for ( ; ; ) {
	while (TclIsSpaceProc(*yyInput)) {
	    yyInput++;
	}

	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
	    /*
	     * Convert the string into a number; count the number of digits.
	     */







|







2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
    register char c;
    register char *p;
    char buff[20];
    int Count;

    location->first_column = yyInput - info->dateStart;
    for ( ; ; ) {
	while (TclIsSpaceProc(UCHAR(*yyInput))) {
	    yyInput++;
	}

	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
	    /*
	     * Convert the string into a number; count the number of digits.
	     */
2907
2908
2909
2910
2911
2912
2913
2914
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */








<
2908
2909
2910
2911
2912
2913
2914

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclDecls.h.
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
/* 1 */
TCLAPI const char *	Tcl_PkgRequireEx(Tcl_Interp *interp,
				const char *name, const char *version,
				int exact, void *clientDataPtr);
/* 2 */
TCLAPI TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 3 */
TCLAPI char *		Tcl_Alloc(unsigned int size);
/* 4 */
TCLAPI void		Tcl_Free(char *ptr);
/* 5 */
TCLAPI char *		Tcl_Realloc(char *ptr, unsigned int size);
/* 6 */
TCLAPI char *		Tcl_DbCkalloc(unsigned int size, const char *file,
				int line);
/* 7 */
TCLAPI void		Tcl_DbCkfree(char *ptr, const char *file, int line);
/* 8 */
TCLAPI char *		Tcl_DbCkrealloc(char *ptr, unsigned int size,
				const char *file, int line);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 9 */
TCLAPI void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, ClientData clientData);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 9 */
TCLAPI void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, ClientData clientData);
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 10 */
TCLAPI void		Tcl_DeleteFileHandler(int fd);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 10 */







|

|

|

|


|

|




|




|







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
/* 1 */
TCLAPI const char *	Tcl_PkgRequireEx(Tcl_Interp *interp,
				const char *name, const char *version,
				int exact, void *clientDataPtr);
/* 2 */
TCLAPI TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 3 */
TCLAPI void *		Tcl_Alloc(size_t size);
/* 4 */
TCLAPI void		Tcl_Free(void *ptr);
/* 5 */
TCLAPI void *		Tcl_Realloc(void *ptr, size_t size);
/* 6 */
TCLAPI void *		Tcl_DbCkalloc(size_t size, const char *file,
				int line);
/* 7 */
TCLAPI void		Tcl_DbCkfree(void *ptr, const char *file, int line);
/* 8 */
TCLAPI void *		Tcl_DbCkrealloc(void *ptr, size_t size,
				const char *file, int line);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 9 */
TCLAPI void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, void *clientData);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 9 */
TCLAPI void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, void *clientData);
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 10 */
TCLAPI void		Tcl_DeleteFileHandler(int fd);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 10 */
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
/* 14 */
TCLAPI int		Tcl_AppendAllObjTypes(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 15 */
TCLAPI void		Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...);
/* 16 */
TCLAPI void		Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes,
				int length);
/* 17 */
TCLAPI Tcl_Obj *	Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]);
/* 18 */
TCLAPI int		Tcl_ConvertToType(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const Tcl_ObjType *typePtr);
/* 19 */
TCLAPI void		Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file,
				int line);
/* 20 */
TCLAPI void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
				int line);
/* 21 */
TCLAPI int		Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
				int line);
/* Slot 22 is reserved */
/* 23 */
TCLAPI Tcl_Obj *	Tcl_DbNewByteArrayObj(const unsigned char *bytes,
				int length, const char *file, int line);
/* 24 */
TCLAPI Tcl_Obj *	Tcl_DbNewDoubleObj(double doubleValue,
				const char *file, int line);
/* 25 */
TCLAPI Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
				const char *file, int line);
/* Slot 26 is reserved */
/* 27 */
TCLAPI Tcl_Obj *	Tcl_DbNewObj(const char *file, int line);
/* 28 */
TCLAPI Tcl_Obj *	Tcl_DbNewStringObj(const char *bytes, int length,
				const char *file, int line);
/* 29 */
TCLAPI Tcl_Obj *	Tcl_DuplicateObj(Tcl_Obj *objPtr);
/* 30 */
TCLAPI void		TclFreeObj(Tcl_Obj *objPtr);
/* 31 */
TCLAPI int		Tcl_GetBoolean(Tcl_Interp *interp, const char *src,







|

















|










|







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
/* 14 */
TCLAPI int		Tcl_AppendAllObjTypes(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 15 */
TCLAPI void		Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...);
/* 16 */
TCLAPI void		Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes,
				size_t length);
/* 17 */
TCLAPI Tcl_Obj *	Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]);
/* 18 */
TCLAPI int		Tcl_ConvertToType(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const Tcl_ObjType *typePtr);
/* 19 */
TCLAPI void		Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file,
				int line);
/* 20 */
TCLAPI void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
				int line);
/* 21 */
TCLAPI int		Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
				int line);
/* Slot 22 is reserved */
/* 23 */
TCLAPI Tcl_Obj *	Tcl_DbNewByteArrayObj(const unsigned char *bytes,
				size_t length, const char *file, int line);
/* 24 */
TCLAPI Tcl_Obj *	Tcl_DbNewDoubleObj(double doubleValue,
				const char *file, int line);
/* 25 */
TCLAPI Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
				const char *file, int line);
/* Slot 26 is reserved */
/* 27 */
TCLAPI Tcl_Obj *	Tcl_DbNewObj(const char *file, int line);
/* 28 */
TCLAPI Tcl_Obj *	Tcl_DbNewStringObj(const char *bytes, size_t length,
				const char *file, int line);
/* 29 */
TCLAPI Tcl_Obj *	Tcl_DuplicateObj(Tcl_Obj *objPtr);
/* 30 */
TCLAPI void		TclFreeObj(Tcl_Obj *objPtr);
/* 31 */
TCLAPI int		Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197

198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374

375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
/* 48 */
TCLAPI int		Tcl_ListObjReplace(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int first, int count,
				int objc, Tcl_Obj *const objv[]);
/* Slot 49 is reserved */
/* 50 */
TCLAPI Tcl_Obj *	Tcl_NewByteArrayObj(const unsigned char *bytes,
				int length);
/* 51 */
TCLAPI Tcl_Obj *	Tcl_NewDoubleObj(double doubleValue);
/* Slot 52 is reserved */
/* 53 */
TCLAPI Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* Slot 54 is reserved */
/* 55 */
TCLAPI Tcl_Obj *	Tcl_NewObj(void);
/* 56 */
TCLAPI Tcl_Obj *	Tcl_NewStringObj(const char *bytes, int length);
/* Slot 57 is reserved */
/* 58 */
TCLAPI unsigned char *	Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);

/* 59 */
TCLAPI void		Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
				const unsigned char *bytes, int length);
/* 60 */
TCLAPI void		Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* Slot 61 is reserved */
/* 62 */
TCLAPI void		Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
				Tcl_Obj *const objv[]);
/* Slot 63 is reserved */
/* 64 */
TCLAPI void		Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
/* 65 */
TCLAPI void		Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
				int length);
/* Slot 66 is reserved */
/* Slot 67 is reserved */
/* 68 */
TCLAPI void		Tcl_AllowExceptions(Tcl_Interp *interp);
/* 69 */
TCLAPI void		Tcl_AppendElement(Tcl_Interp *interp,
				const char *element);
/* 70 */
TCLAPI void		Tcl_AppendResult(Tcl_Interp *interp, ...);
/* 71 */
TCLAPI Tcl_AsyncHandler	 Tcl_AsyncCreate(Tcl_AsyncProc *proc,
				ClientData clientData);
/* 72 */
TCLAPI void		Tcl_AsyncDelete(Tcl_AsyncHandler async);
/* 73 */
TCLAPI int		Tcl_AsyncInvoke(Tcl_Interp *interp, int code);
/* 74 */
TCLAPI void		Tcl_AsyncMark(Tcl_AsyncHandler async);
/* 75 */
TCLAPI int		Tcl_AsyncReady(void);
/* 76 */
TCLAPI void		Tcl_BackgroundError(Tcl_Interp *interp);
/* Slot 77 is reserved */
/* 78 */
TCLAPI int		Tcl_BadChannelOption(Tcl_Interp *interp,
				const char *optionName,
				const char *optionList);
/* 79 */
TCLAPI void		Tcl_CallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc,
				ClientData clientData);
/* 80 */
TCLAPI void		Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
				ClientData clientData);
/* 81 */
TCLAPI int		Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
/* 82 */
TCLAPI int		Tcl_CommandComplete(const char *cmd);
/* 83 */
TCLAPI char *		Tcl_Concat(int argc, const char *const *argv);
/* 84 */
TCLAPI int		Tcl_ConvertElement(const char *src, char *dst,
				int flags);
/* 85 */
TCLAPI int		Tcl_ConvertCountedElement(const char *src,
				int length, char *dst, int flags);
/* 86 */
TCLAPI int		Tcl_CreateAlias(Tcl_Interp *slave,
				const char *slaveCmd, Tcl_Interp *target,
				const char *targetCmd, int argc,
				const char *const *argv);
/* 87 */
TCLAPI int		Tcl_CreateAliasObj(Tcl_Interp *slave,
				const char *slaveCmd, Tcl_Interp *target,
				const char *targetCmd, int objc,
				Tcl_Obj *const objv[]);
/* 88 */
TCLAPI Tcl_Channel	Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
				const char *chanName,
				ClientData instanceData, int mask);
/* 89 */
TCLAPI void		Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
				Tcl_ChannelProc *proc, ClientData clientData);
/* 90 */
TCLAPI void		Tcl_CreateCloseHandler(Tcl_Channel chan,
				Tcl_CloseProc *proc, ClientData clientData);
/* 91 */
TCLAPI Tcl_Command	Tcl_CreateCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_CmdProc *proc,
				ClientData clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 92 */
TCLAPI void		Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
				Tcl_EventCheckProc *checkProc,
				ClientData clientData);
/* 93 */
TCLAPI void		Tcl_CreateExitHandler(Tcl_ExitProc *proc,
				ClientData clientData);
/* 94 */
TCLAPI Tcl_Interp *	Tcl_CreateInterp(void);
/* Slot 95 is reserved */
/* 96 */
TCLAPI Tcl_Command	Tcl_CreateObjCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				ClientData clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 97 */
TCLAPI Tcl_Interp *	Tcl_CreateSlave(Tcl_Interp *interp,
				const char *slaveName, int isSafe);
/* 98 */
TCLAPI Tcl_TimerToken	Tcl_CreateTimerHandler(int milliseconds,
				Tcl_TimerProc *proc, ClientData clientData);
/* 99 */
TCLAPI Tcl_Trace	Tcl_CreateTrace(Tcl_Interp *interp, int level,
				Tcl_CmdTraceProc *proc,
				ClientData clientData);
/* 100 */
TCLAPI void		Tcl_DeleteAssocData(Tcl_Interp *interp,
				const char *name);
/* 101 */
TCLAPI void		Tcl_DeleteChannelHandler(Tcl_Channel chan,
				Tcl_ChannelProc *proc, ClientData clientData);
/* 102 */
TCLAPI void		Tcl_DeleteCloseHandler(Tcl_Channel chan,
				Tcl_CloseProc *proc, ClientData clientData);
/* 103 */
TCLAPI int		Tcl_DeleteCommand(Tcl_Interp *interp,
				const char *cmdName);
/* 104 */
TCLAPI int		Tcl_DeleteCommandFromToken(Tcl_Interp *interp,
				Tcl_Command command);
/* 105 */
TCLAPI void		Tcl_DeleteEvents(Tcl_EventDeleteProc *proc,
				ClientData clientData);
/* 106 */
TCLAPI void		Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
				Tcl_EventCheckProc *checkProc,
				ClientData clientData);
/* 107 */
TCLAPI void		Tcl_DeleteExitHandler(Tcl_ExitProc *proc,
				ClientData clientData);
/* 108 */
TCLAPI void		Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr);
/* 109 */
TCLAPI void		Tcl_DeleteHashTable(Tcl_HashTable *tablePtr);
/* 110 */
TCLAPI void		Tcl_DeleteInterp(Tcl_Interp *interp);
/* 111 */
TCLAPI void		Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr);
/* 112 */
TCLAPI void		Tcl_DeleteTimerHandler(Tcl_TimerToken token);
/* 113 */
TCLAPI void		Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace);
/* 114 */
TCLAPI void		Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc,
				ClientData clientData);
/* 115 */
TCLAPI int		Tcl_DoOneEvent(int flags);
/* 116 */
TCLAPI void		Tcl_DoWhenIdle(Tcl_IdleProc *proc,
				ClientData clientData);
/* 117 */
TCLAPI char *		Tcl_DStringAppend(Tcl_DString *dsPtr,
				const char *bytes, int length);
/* 118 */
TCLAPI char *		Tcl_DStringAppendElement(Tcl_DString *dsPtr,
				const char *element);
/* 119 */
TCLAPI void		Tcl_DStringEndSublist(Tcl_DString *dsPtr);
/* 120 */
TCLAPI void		Tcl_DStringFree(Tcl_DString *dsPtr);
/* 121 */
TCLAPI void		Tcl_DStringGetResult(Tcl_Interp *interp,
				Tcl_DString *dsPtr);
/* 122 */
TCLAPI void		Tcl_DStringInit(Tcl_DString *dsPtr);
/* 123 */
TCLAPI void		Tcl_DStringResult(Tcl_Interp *interp,
				Tcl_DString *dsPtr);
/* 124 */
TCLAPI void		Tcl_DStringSetLength(Tcl_DString *dsPtr, int length);

/* 125 */
TCLAPI void		Tcl_DStringStartSublist(Tcl_DString *dsPtr);
/* 126 */
TCLAPI int		Tcl_Eof(Tcl_Channel chan);
/* 127 */
TCLAPI const char *	Tcl_ErrnoId(void);
/* 128 */
TCLAPI const char *	Tcl_ErrnoMsg(int err);
/* Slot 129 is reserved */
/* 130 */
TCLAPI int		Tcl_EvalFile(Tcl_Interp *interp,
				const char *fileName);
/* Slot 131 is reserved */
/* 132 */
TCLAPI void		Tcl_EventuallyFree(ClientData clientData,
				Tcl_FreeProc *freeProc);
/* 133 */
TCLAPI TCL_NORETURN void Tcl_Exit(int status);
/* 134 */
TCLAPI int		Tcl_ExposeCommand(Tcl_Interp *interp,
				const char *hiddenCmdToken,
				const char *cmdName);







|









|


|
>


|








|


|











|

















|
<


|







|


|
|












|
|


|


|



|




|


|






|






|


|
<





|


|








|



|


|














|
<



|
<


|
















|
>














|







177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243

244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307

308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347

348
349
350
351

352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
/* 48 */
TCLAPI int		Tcl_ListObjReplace(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int first, int count,
				int objc, Tcl_Obj *const objv[]);
/* Slot 49 is reserved */
/* 50 */
TCLAPI Tcl_Obj *	Tcl_NewByteArrayObj(const unsigned char *bytes,
				size_t length);
/* 51 */
TCLAPI Tcl_Obj *	Tcl_NewDoubleObj(double doubleValue);
/* Slot 52 is reserved */
/* 53 */
TCLAPI Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* Slot 54 is reserved */
/* 55 */
TCLAPI Tcl_Obj *	Tcl_NewObj(void);
/* 56 */
TCLAPI Tcl_Obj *	Tcl_NewStringObj(const char *bytes, size_t length);
/* Slot 57 is reserved */
/* 58 */
TCLAPI unsigned char *	Tcl_SetByteArrayLength(Tcl_Obj *objPtr,
				size_t length);
/* 59 */
TCLAPI void		Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
				const unsigned char *bytes, size_t length);
/* 60 */
TCLAPI void		Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* Slot 61 is reserved */
/* 62 */
TCLAPI void		Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
				Tcl_Obj *const objv[]);
/* Slot 63 is reserved */
/* 64 */
TCLAPI void		Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length);
/* 65 */
TCLAPI void		Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
				size_t length);
/* Slot 66 is reserved */
/* Slot 67 is reserved */
/* 68 */
TCLAPI void		Tcl_AllowExceptions(Tcl_Interp *interp);
/* 69 */
TCLAPI void		Tcl_AppendElement(Tcl_Interp *interp,
				const char *element);
/* 70 */
TCLAPI void		Tcl_AppendResult(Tcl_Interp *interp, ...);
/* 71 */
TCLAPI Tcl_AsyncHandler	 Tcl_AsyncCreate(Tcl_AsyncProc *proc,
				void *clientData);
/* 72 */
TCLAPI void		Tcl_AsyncDelete(Tcl_AsyncHandler async);
/* 73 */
TCLAPI int		Tcl_AsyncInvoke(Tcl_Interp *interp, int code);
/* 74 */
TCLAPI void		Tcl_AsyncMark(Tcl_AsyncHandler async);
/* 75 */
TCLAPI int		Tcl_AsyncReady(void);
/* 76 */
TCLAPI void		Tcl_BackgroundError(Tcl_Interp *interp);
/* Slot 77 is reserved */
/* 78 */
TCLAPI int		Tcl_BadChannelOption(Tcl_Interp *interp,
				const char *optionName,
				const char *optionList);
/* 79 */
TCLAPI void		Tcl_CallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc, void *clientData);

/* 80 */
TCLAPI void		Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
				void *clientData);
/* 81 */
TCLAPI int		Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
/* 82 */
TCLAPI int		Tcl_CommandComplete(const char *cmd);
/* 83 */
TCLAPI char *		Tcl_Concat(int argc, const char *const *argv);
/* 84 */
TCLAPI size_t		Tcl_ConvertElement(const char *src, char *dst,
				int flags);
/* 85 */
TCLAPI size_t		Tcl_ConvertCountedElement(const char *src,
				size_t length, char *dst, int flags);
/* 86 */
TCLAPI int		Tcl_CreateAlias(Tcl_Interp *slave,
				const char *slaveCmd, Tcl_Interp *target,
				const char *targetCmd, int argc,
				const char *const *argv);
/* 87 */
TCLAPI int		Tcl_CreateAliasObj(Tcl_Interp *slave,
				const char *slaveCmd, Tcl_Interp *target,
				const char *targetCmd, int objc,
				Tcl_Obj *const objv[]);
/* 88 */
TCLAPI Tcl_Channel	Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
				const char *chanName, void *instanceData,
				int mask);
/* 89 */
TCLAPI void		Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
				Tcl_ChannelProc *proc, void *clientData);
/* 90 */
TCLAPI void		Tcl_CreateCloseHandler(Tcl_Channel chan,
				Tcl_CloseProc *proc, void *clientData);
/* 91 */
TCLAPI Tcl_Command	Tcl_CreateCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_CmdProc *proc,
				void *clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 92 */
TCLAPI void		Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
				Tcl_EventCheckProc *checkProc,
				void *clientData);
/* 93 */
TCLAPI void		Tcl_CreateExitHandler(Tcl_ExitProc *proc,
				void *clientData);
/* 94 */
TCLAPI Tcl_Interp *	Tcl_CreateInterp(void);
/* Slot 95 is reserved */
/* 96 */
TCLAPI Tcl_Command	Tcl_CreateObjCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				void *clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 97 */
TCLAPI Tcl_Interp *	Tcl_CreateSlave(Tcl_Interp *interp,
				const char *slaveName, int isSafe);
/* 98 */
TCLAPI Tcl_TimerToken	Tcl_CreateTimerHandler(int milliseconds,
				Tcl_TimerProc *proc, void *clientData);
/* 99 */
TCLAPI Tcl_Trace	Tcl_CreateTrace(Tcl_Interp *interp, int level,
				Tcl_CmdTraceProc *proc, void *clientData);

/* 100 */
TCLAPI void		Tcl_DeleteAssocData(Tcl_Interp *interp,
				const char *name);
/* 101 */
TCLAPI void		Tcl_DeleteChannelHandler(Tcl_Channel chan,
				Tcl_ChannelProc *proc, void *clientData);
/* 102 */
TCLAPI void		Tcl_DeleteCloseHandler(Tcl_Channel chan,
				Tcl_CloseProc *proc, void *clientData);
/* 103 */
TCLAPI int		Tcl_DeleteCommand(Tcl_Interp *interp,
				const char *cmdName);
/* 104 */
TCLAPI int		Tcl_DeleteCommandFromToken(Tcl_Interp *interp,
				Tcl_Command command);
/* 105 */
TCLAPI void		Tcl_DeleteEvents(Tcl_EventDeleteProc *proc,
				void *clientData);
/* 106 */
TCLAPI void		Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
				Tcl_EventCheckProc *checkProc,
				void *clientData);
/* 107 */
TCLAPI void		Tcl_DeleteExitHandler(Tcl_ExitProc *proc,
				void *clientData);
/* 108 */
TCLAPI void		Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr);
/* 109 */
TCLAPI void		Tcl_DeleteHashTable(Tcl_HashTable *tablePtr);
/* 110 */
TCLAPI void		Tcl_DeleteInterp(Tcl_Interp *interp);
/* 111 */
TCLAPI void		Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr);
/* 112 */
TCLAPI void		Tcl_DeleteTimerHandler(Tcl_TimerToken token);
/* 113 */
TCLAPI void		Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace);
/* 114 */
TCLAPI void		Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc, void *clientData);

/* 115 */
TCLAPI int		Tcl_DoOneEvent(int flags);
/* 116 */
TCLAPI void		Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData);

/* 117 */
TCLAPI char *		Tcl_DStringAppend(Tcl_DString *dsPtr,
				const char *bytes, size_t length);
/* 118 */
TCLAPI char *		Tcl_DStringAppendElement(Tcl_DString *dsPtr,
				const char *element);
/* 119 */
TCLAPI void		Tcl_DStringEndSublist(Tcl_DString *dsPtr);
/* 120 */
TCLAPI void		Tcl_DStringFree(Tcl_DString *dsPtr);
/* 121 */
TCLAPI void		Tcl_DStringGetResult(Tcl_Interp *interp,
				Tcl_DString *dsPtr);
/* 122 */
TCLAPI void		Tcl_DStringInit(Tcl_DString *dsPtr);
/* 123 */
TCLAPI void		Tcl_DStringResult(Tcl_Interp *interp,
				Tcl_DString *dsPtr);
/* 124 */
TCLAPI void		Tcl_DStringSetLength(Tcl_DString *dsPtr,
				size_t length);
/* 125 */
TCLAPI void		Tcl_DStringStartSublist(Tcl_DString *dsPtr);
/* 126 */
TCLAPI int		Tcl_Eof(Tcl_Channel chan);
/* 127 */
TCLAPI const char *	Tcl_ErrnoId(void);
/* 128 */
TCLAPI const char *	Tcl_ErrnoMsg(int err);
/* Slot 129 is reserved */
/* 130 */
TCLAPI int		Tcl_EvalFile(Tcl_Interp *interp,
				const char *fileName);
/* Slot 131 is reserved */
/* 132 */
TCLAPI void		Tcl_EventuallyFree(void *clientData,
				Tcl_FreeProc *freeProc);
/* 133 */
TCLAPI TCL_NORETURN void Tcl_Exit(int status);
/* 134 */
TCLAPI int		Tcl_ExposeCommand(Tcl_Interp *interp,
				const char *hiddenCmdToken,
				const char *cmdName);
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
/* 149 */
TCLAPI int		Tcl_GetAliasObj(Tcl_Interp *interp,
				const char *slaveCmd,
				Tcl_Interp **targetInterpPtr,
				const char **targetCmdPtr, int *objcPtr,
				Tcl_Obj ***objv);
/* 150 */
TCLAPI ClientData	Tcl_GetAssocData(Tcl_Interp *interp,
				const char *name,
				Tcl_InterpDeleteProc **procPtr);
/* 151 */
TCLAPI Tcl_Channel	Tcl_GetChannel(Tcl_Interp *interp,
				const char *chanName, int *modePtr);
/* 152 */
TCLAPI int		Tcl_GetChannelBufferSize(Tcl_Channel chan);
/* 153 */
TCLAPI int		Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
				ClientData *handlePtr);
/* 154 */
TCLAPI ClientData	Tcl_GetChannelInstanceData(Tcl_Channel chan);
/* 155 */
TCLAPI int		Tcl_GetChannelMode(Tcl_Channel chan);
/* 156 */
TCLAPI const char *	Tcl_GetChannelName(Tcl_Channel chan);
/* 157 */
TCLAPI int		Tcl_GetChannelOption(Tcl_Interp *interp,
				Tcl_Channel chan, const char *optionName,







|









|

|







434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
/* 149 */
TCLAPI int		Tcl_GetAliasObj(Tcl_Interp *interp,
				const char *slaveCmd,
				Tcl_Interp **targetInterpPtr,
				const char **targetCmdPtr, int *objcPtr,
				Tcl_Obj ***objv);
/* 150 */
TCLAPI void *		Tcl_GetAssocData(Tcl_Interp *interp,
				const char *name,
				Tcl_InterpDeleteProc **procPtr);
/* 151 */
TCLAPI Tcl_Channel	Tcl_GetChannel(Tcl_Interp *interp,
				const char *chanName, int *modePtr);
/* 152 */
TCLAPI int		Tcl_GetChannelBufferSize(Tcl_Channel chan);
/* 153 */
TCLAPI int		Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
				void **handlePtr);
/* 154 */
TCLAPI void *		Tcl_GetChannelInstanceData(Tcl_Channel chan);
/* 155 */
TCLAPI int		Tcl_GetChannelMode(Tcl_Channel chan);
/* 156 */
TCLAPI const char *	Tcl_GetChannelName(Tcl_Channel chan);
/* 157 */
TCLAPI int		Tcl_GetChannelOption(Tcl_Interp *interp,
				Tcl_Channel chan, const char *optionName,
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
TCLAPI const char *	Tcl_GetNameOfExecutable(void);
/* 166 */
TCLAPI Tcl_Obj *	Tcl_GetObjResult(Tcl_Interp *interp);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 167 */
TCLAPI int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, ClientData *filePtr);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 167 */
TCLAPI int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, ClientData *filePtr);
#endif /* MACOSX */
/* 168 */
TCLAPI Tcl_PathType	Tcl_GetPathType(const char *path);
/* 169 */
TCLAPI int		Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr);
/* 170 */
TCLAPI int		Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 171 */
TCLAPI int		Tcl_GetServiceMode(void);
/* 172 */
TCLAPI Tcl_Interp *	Tcl_GetSlave(Tcl_Interp *interp,
				const char *slaveName);
/* 173 */
TCLAPI Tcl_Channel	Tcl_GetStdChannel(int type);







|





|




|

|







480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
TCLAPI const char *	Tcl_GetNameOfExecutable(void);
/* 166 */
TCLAPI Tcl_Obj *	Tcl_GetObjResult(Tcl_Interp *interp);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 167 */
TCLAPI int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, void **filePtr);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 167 */
TCLAPI int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, void **filePtr);
#endif /* MACOSX */
/* 168 */
TCLAPI Tcl_PathType	Tcl_GetPathType(const char *path);
/* 169 */
TCLAPI size_t		Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr);
/* 170 */
TCLAPI size_t		Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 171 */
TCLAPI int		Tcl_GetServiceMode(void);
/* 172 */
TCLAPI Tcl_Interp *	Tcl_GetSlave(Tcl_Interp *interp,
				const char *slaveName);
/* 173 */
TCLAPI Tcl_Channel	Tcl_GetStdChannel(int type);
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
TCLAPI char *		Tcl_JoinPath(int argc, const char *const *argv,
				Tcl_DString *resultPtr);
/* 187 */
TCLAPI int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
				char *addr, int type);
/* Slot 188 is reserved */
/* 189 */
TCLAPI Tcl_Channel	Tcl_MakeFileChannel(ClientData handle, int mode);
/* 190 */
TCLAPI int		Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
TCLAPI Tcl_Channel	Tcl_MakeTcpClientChannel(ClientData tcpSocket);
/* 192 */
TCLAPI char *		Tcl_Merge(int argc, const char *const *argv);
/* 193 */
TCLAPI Tcl_HashEntry *	Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
/* 194 */
TCLAPI void		Tcl_NotifyChannel(Tcl_Channel channel, int mask);
/* 195 */







|



|







534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
TCLAPI char *		Tcl_JoinPath(int argc, const char *const *argv,
				Tcl_DString *resultPtr);
/* 187 */
TCLAPI int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
				char *addr, int type);
/* Slot 188 is reserved */
/* 189 */
TCLAPI Tcl_Channel	Tcl_MakeFileChannel(void *handle, int mode);
/* 190 */
TCLAPI int		Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
TCLAPI Tcl_Channel	Tcl_MakeTcpClientChannel(void *tcpSocket);
/* 192 */
TCLAPI char *		Tcl_Merge(int argc, const char *const *argv);
/* 193 */
TCLAPI Tcl_HashEntry *	Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
/* 194 */
TCLAPI void		Tcl_NotifyChannel(Tcl_Channel channel, int mask);
/* 195 */
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590

591
592
593
594
595
596
597
TCLAPI Tcl_Channel	Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
				const char *address, const char *myaddr,
				int myport, int async);
/* 200 */
TCLAPI Tcl_Channel	Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
				const char *host,
				Tcl_TcpAcceptProc *acceptProc,
				ClientData callbackData);
/* 201 */
TCLAPI void		Tcl_Preserve(ClientData data);
/* 202 */
TCLAPI void		Tcl_PrintDouble(Tcl_Interp *interp, double value,
				char *dst);
/* 203 */
TCLAPI int		Tcl_PutEnv(const char *assignment);
/* 204 */
TCLAPI const char *	Tcl_PosixError(Tcl_Interp *interp);
/* 205 */
TCLAPI void		Tcl_QueueEvent(Tcl_Event *evPtr,
				Tcl_QueuePosition position);
/* 206 */
TCLAPI int		Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead);

/* 207 */
TCLAPI void		Tcl_ReapDetachedProcs(void);
/* 208 */
TCLAPI int		Tcl_RecordAndEval(Tcl_Interp *interp,
				const char *cmd, int flags);
/* 209 */
TCLAPI int		Tcl_RecordAndEvalObj(Tcl_Interp *interp,







|

|











|
>







567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
TCLAPI Tcl_Channel	Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
				const char *address, const char *myaddr,
				int myport, int async);
/* 200 */
TCLAPI Tcl_Channel	Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
				const char *host,
				Tcl_TcpAcceptProc *acceptProc,
				void *callbackData);
/* 201 */
TCLAPI void		Tcl_Preserve(void *data);
/* 202 */
TCLAPI void		Tcl_PrintDouble(Tcl_Interp *interp, double value,
				char *dst);
/* 203 */
TCLAPI int		Tcl_PutEnv(const char *assignment);
/* 204 */
TCLAPI const char *	Tcl_PosixError(Tcl_Interp *interp);
/* 205 */
TCLAPI void		Tcl_QueueEvent(Tcl_Event *evPtr,
				Tcl_QueuePosition position);
/* 206 */
TCLAPI size_t		Tcl_Read(Tcl_Channel chan, char *bufPtr,
				size_t toRead);
/* 207 */
TCLAPI void		Tcl_ReapDetachedProcs(void);
/* 208 */
TCLAPI int		Tcl_RecordAndEval(Tcl_Interp *interp,
				const char *cmd, int flags);
/* 209 */
TCLAPI int		Tcl_RecordAndEvalObj(Tcl_Interp *interp,
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
/* 213 */
TCLAPI int		Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
				const char *text, const char *start);
/* 214 */
TCLAPI int		Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
				const char *pattern);
/* 215 */
TCLAPI void		Tcl_RegExpRange(Tcl_RegExp regexp, int index,
				const char **startPtr, const char **endPtr);
/* 216 */
TCLAPI void		Tcl_Release(ClientData clientData);
/* 217 */
TCLAPI void		Tcl_ResetResult(Tcl_Interp *interp);
/* 218 */
TCLAPI int		Tcl_ScanElement(const char *src, int *flagPtr);
/* 219 */
TCLAPI int		Tcl_ScanCountedElement(const char *src, int length,
				int *flagPtr);
/* Slot 220 is reserved */
/* 221 */
TCLAPI int		Tcl_ServiceAll(void);
/* 222 */
TCLAPI int		Tcl_ServiceEvent(int flags);
/* 223 */
TCLAPI void		Tcl_SetAssocData(Tcl_Interp *interp,
				const char *name, Tcl_InterpDeleteProc *proc,
				ClientData clientData);
/* 224 */
TCLAPI void		Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz);
/* 225 */
TCLAPI int		Tcl_SetChannelOption(Tcl_Interp *interp,
				Tcl_Channel chan, const char *optionName,
				const char *newValue);
/* 226 */







|


|



|

|
|








|







606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
/* 213 */
TCLAPI int		Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
				const char *text, const char *start);
/* 214 */
TCLAPI int		Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
				const char *pattern);
/* 215 */
TCLAPI void		Tcl_RegExpRange(Tcl_RegExp regexp, size_t index,
				const char **startPtr, const char **endPtr);
/* 216 */
TCLAPI void		Tcl_Release(void *clientData);
/* 217 */
TCLAPI void		Tcl_ResetResult(Tcl_Interp *interp);
/* 218 */
TCLAPI size_t		Tcl_ScanElement(const char *src, int *flagPtr);
/* 219 */
TCLAPI size_t		Tcl_ScanCountedElement(const char *src,
				size_t length, int *flagPtr);
/* Slot 220 is reserved */
/* 221 */
TCLAPI int		Tcl_ServiceAll(void);
/* 222 */
TCLAPI int		Tcl_ServiceEvent(int flags);
/* 223 */
TCLAPI void		Tcl_SetAssocData(Tcl_Interp *interp,
				const char *name, Tcl_InterpDeleteProc *proc,
				void *clientData);
/* 224 */
TCLAPI void		Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz);
/* 225 */
TCLAPI int		Tcl_SetChannelOption(Tcl_Interp *interp,
				Tcl_Channel chan, const char *optionName,
				const char *newValue);
/* 226 */
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734

735
736
737
738
739
740
741
/* 245 */
TCLAPI int		Tcl_StringMatch(const char *str, const char *pattern);
/* Slot 246 is reserved */
/* Slot 247 is reserved */
/* 248 */
TCLAPI int		Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags,
				Tcl_VarTraceProc *proc,
				ClientData clientData);
/* 249 */
TCLAPI char *		Tcl_TranslateFileName(Tcl_Interp *interp,
				const char *name, Tcl_DString *bufferPtr);
/* 250 */
TCLAPI int		Tcl_Ungets(Tcl_Channel chan, const char *str,
				int len, int atHead);
/* 251 */
TCLAPI void		Tcl_UnlinkVar(Tcl_Interp *interp,
				const char *varName);
/* 252 */
TCLAPI int		Tcl_UnregisterChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
/* Slot 253 is reserved */
/* 254 */
TCLAPI int		Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* Slot 255 is reserved */
/* 256 */
TCLAPI void		Tcl_UntraceVar2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *proc,
				ClientData clientData);
/* 257 */
TCLAPI void		Tcl_UpdateLinkedVar(Tcl_Interp *interp,
				const char *varName);
/* Slot 258 is reserved */
/* 259 */
TCLAPI int		Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
				const char *part1, const char *part2,
				const char *localName, int flags);
/* Slot 260 is reserved */
/* Slot 261 is reserved */
/* 262 */
TCLAPI ClientData	Tcl_VarTraceInfo2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *procPtr,
				ClientData prevClientData);
/* 263 */
TCLAPI int		Tcl_Write(Tcl_Channel chan, const char *s, int slen);

/* 264 */
TCLAPI void		Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], const char *message);
/* 265 */
TCLAPI int		Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
TCLAPI void		Tcl_ValidateAllMemory(const char *file, int line);







|
<




|
|















|











|


|

|
>







686
687
688
689
690
691
692
693

694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
/* 245 */
TCLAPI int		Tcl_StringMatch(const char *str, const char *pattern);
/* Slot 246 is reserved */
/* Slot 247 is reserved */
/* 248 */
TCLAPI int		Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags,
				Tcl_VarTraceProc *proc, void *clientData);

/* 249 */
TCLAPI char *		Tcl_TranslateFileName(Tcl_Interp *interp,
				const char *name, Tcl_DString *bufferPtr);
/* 250 */
TCLAPI size_t		Tcl_Ungets(Tcl_Channel chan, const char *str,
				size_t len, int atHead);
/* 251 */
TCLAPI void		Tcl_UnlinkVar(Tcl_Interp *interp,
				const char *varName);
/* 252 */
TCLAPI int		Tcl_UnregisterChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
/* Slot 253 is reserved */
/* 254 */
TCLAPI int		Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* Slot 255 is reserved */
/* 256 */
TCLAPI void		Tcl_UntraceVar2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *proc,
				void *clientData);
/* 257 */
TCLAPI void		Tcl_UpdateLinkedVar(Tcl_Interp *interp,
				const char *varName);
/* Slot 258 is reserved */
/* 259 */
TCLAPI int		Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
				const char *part1, const char *part2,
				const char *localName, int flags);
/* Slot 260 is reserved */
/* Slot 261 is reserved */
/* 262 */
TCLAPI void *		Tcl_VarTraceInfo2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *procPtr,
				void *prevClientData);
/* 263 */
TCLAPI size_t		Tcl_Write(Tcl_Channel chan, const char *s,
				size_t slen);
/* 264 */
TCLAPI void		Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], const char *message);
/* 265 */
TCLAPI int		Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
TCLAPI void		Tcl_ValidateAllMemory(const char *file, int line);
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026

1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
TCLAPI void		Tcl_GetVersion(int *major, int *minor,
				int *patchLevel, int *type);
/* 280 */
TCLAPI void		Tcl_InitMemory(Tcl_Interp *interp);
/* 281 */
TCLAPI Tcl_Channel	Tcl_StackChannel(Tcl_Interp *interp,
				const Tcl_ChannelType *typePtr,
				ClientData instanceData, int mask,
				Tcl_Channel prevChan);
/* 282 */
TCLAPI int		Tcl_UnstackChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 283 */
TCLAPI Tcl_Channel	Tcl_GetStackedChannel(Tcl_Channel chan);
/* 284 */
TCLAPI void		Tcl_SetMainLoop(Tcl_MainLoopProc *proc);
/* Slot 285 is reserved */
/* 286 */
TCLAPI void		Tcl_AppendObjToObj(Tcl_Obj *objPtr,
				Tcl_Obj *appendObjPtr);
/* 287 */
TCLAPI Tcl_Encoding	Tcl_CreateEncoding(const Tcl_EncodingType *typePtr);
/* 288 */
TCLAPI void		Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc,
				ClientData clientData);
/* 289 */
TCLAPI void		Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc,
				ClientData clientData);
/* Slot 290 is reserved */
/* 291 */
TCLAPI int		Tcl_EvalEx(Tcl_Interp *interp, const char *script,
				int numBytes, int flags);
/* 292 */
TCLAPI int		Tcl_EvalObjv(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* 293 */
TCLAPI int		Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 294 */
TCLAPI TCL_NORETURN void Tcl_ExitThread(int status);
/* 295 */
TCLAPI int		Tcl_ExternalToUtf(Tcl_Interp *interp,
				Tcl_Encoding encoding, const char *src,
				int srcLen, int flags,
				Tcl_EncodingState *statePtr, char *dst,
				int dstLen, int *srcReadPtr,
				int *dstWrotePtr, int *dstCharsPtr);
/* 296 */
TCLAPI char *		Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
				const char *src, int srcLen,
				Tcl_DString *dsPtr);
/* 297 */
TCLAPI void		Tcl_FinalizeThread(void);
/* 298 */
TCLAPI void		Tcl_FinalizeNotifier(ClientData clientData);
/* 299 */
TCLAPI void		Tcl_FreeEncoding(Tcl_Encoding encoding);
/* 300 */
TCLAPI Tcl_ThreadId	Tcl_GetCurrentThread(void);
/* 301 */
TCLAPI Tcl_Encoding	Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
/* 302 */
TCLAPI const char *	Tcl_GetEncodingName(Tcl_Encoding encoding);
/* 303 */
TCLAPI void		Tcl_GetEncodingNames(Tcl_Interp *interp);
/* 304 */
TCLAPI int		Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const void *tablePtr,
				int offset, const char *msg, int flags,
				int *indexPtr);
/* 305 */
TCLAPI void *		Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
				int size);
/* 306 */
TCLAPI Tcl_Obj *	Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* 307 */
TCLAPI ClientData	Tcl_InitNotifier(void);
/* 308 */
TCLAPI void		Tcl_MutexLock(Tcl_Mutex *mutexPtr);
/* 309 */
TCLAPI void		Tcl_MutexUnlock(Tcl_Mutex *mutexPtr);
/* 310 */
TCLAPI void		Tcl_ConditionNotify(Tcl_Condition *condPtr);
/* 311 */
TCLAPI void		Tcl_ConditionWait(Tcl_Condition *condPtr,
				Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr);
/* 312 */
TCLAPI int		Tcl_NumUtfChars(const char *src, int length);
/* 313 */
TCLAPI int		Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
				int charsToRead, int appendFlag);
/* Slot 314 is reserved */
/* Slot 315 is reserved */
/* 316 */
TCLAPI int		Tcl_SetSystemEncoding(Tcl_Interp *interp,
				const char *name);
/* 317 */
TCLAPI Tcl_Obj *	Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
				const char *part2, Tcl_Obj *newValuePtr,
				int flags);
/* 318 */
TCLAPI void		Tcl_ThreadAlert(Tcl_ThreadId threadId);
/* 319 */
TCLAPI void		Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
				Tcl_Event *evPtr, Tcl_QueuePosition position);
/* 320 */
TCLAPI int		Tcl_UniCharAtIndex(const char *src, int index);
/* 321 */
TCLAPI int		Tcl_UniCharToLower(int ch);
/* 322 */
TCLAPI int		Tcl_UniCharToTitle(int ch);
/* 323 */
TCLAPI int		Tcl_UniCharToUpper(int ch);
/* 324 */
TCLAPI int		Tcl_UniCharToUtf(int ch, char *buf);
/* 325 */
TCLAPI const char *	Tcl_UtfAtIndex(const char *src, int index);
/* 326 */
TCLAPI int		Tcl_UtfCharComplete(const char *src, int length);
/* 327 */
TCLAPI int		Tcl_UtfBackslash(const char *src, int *readPtr,
				char *dst);
/* 328 */
TCLAPI const char *	Tcl_UtfFindFirst(const char *src, int ch);
/* 329 */
TCLAPI const char *	Tcl_UtfFindLast(const char *src, int ch);
/* 330 */
TCLAPI const char *	Tcl_UtfNext(const char *src);
/* 331 */
TCLAPI const char *	Tcl_UtfPrev(const char *src, const char *start);
/* 332 */
TCLAPI int		Tcl_UtfToExternal(Tcl_Interp *interp,
				Tcl_Encoding encoding, const char *src,
				int srcLen, int flags,
				Tcl_EncodingState *statePtr, char *dst,
				int dstLen, int *srcReadPtr,
				int *dstWrotePtr, int *dstCharsPtr);
/* 333 */
TCLAPI char *		Tcl_UtfToExternalDString(Tcl_Encoding encoding,
				const char *src, int srcLen,
				Tcl_DString *dsPtr);
/* 334 */
TCLAPI int		Tcl_UtfToLower(char *src);
/* 335 */
TCLAPI int		Tcl_UtfToTitle(char *src);
/* 336 */
TCLAPI int		Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr);
/* 337 */
TCLAPI int		Tcl_UtfToUpper(char *src);
/* 338 */
TCLAPI int		Tcl_WriteChars(Tcl_Channel chan, const char *src,
				int srcLen);
/* 339 */
TCLAPI int		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
TCLAPI char *		Tcl_GetString(Tcl_Obj *objPtr);
/* Slot 341 is reserved */
/* Slot 342 is reserved */
/* 343 */
TCLAPI void		Tcl_AlertNotifier(ClientData clientData);
/* 344 */
TCLAPI void		Tcl_ServiceModeHook(int mode);
/* 345 */
TCLAPI int		Tcl_UniCharIsAlnum(int ch);
/* 346 */
TCLAPI int		Tcl_UniCharIsAlpha(int ch);
/* 347 */
TCLAPI int		Tcl_UniCharIsDigit(int ch);
/* 348 */
TCLAPI int		Tcl_UniCharIsLower(int ch);
/* 349 */
TCLAPI int		Tcl_UniCharIsSpace(int ch);
/* 350 */
TCLAPI int		Tcl_UniCharIsUpper(int ch);
/* 351 */
TCLAPI int		Tcl_UniCharIsWordChar(int ch);
/* 352 */
TCLAPI int		Tcl_UniCharLen(const Tcl_UniChar *uniStr);
/* 353 */
TCLAPI int		Tcl_UniCharNcmp(const Tcl_UniChar *ucs,
				const Tcl_UniChar *uct,
				unsigned long numChars);
/* 354 */
TCLAPI char *		Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr,
				int uniLength, Tcl_DString *dsPtr);
/* 355 */
TCLAPI Tcl_UniChar *	Tcl_UtfToUniCharDString(const char *src, int length,
				Tcl_DString *dsPtr);
/* 356 */
TCLAPI Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp,
				Tcl_Obj *patObj, int flags);
/* Slot 357 is reserved */
/* 358 */
TCLAPI void		Tcl_FreeParse(Tcl_Parse *parsePtr);
/* 359 */
TCLAPI void		Tcl_LogCommandInfo(Tcl_Interp *interp,
				const char *script, const char *command,
				int length);
/* 360 */
TCLAPI int		Tcl_ParseBraces(Tcl_Interp *interp,
				const char *start, int numBytes,
				Tcl_Parse *parsePtr, int append,
				const char **termPtr);
/* 361 */
TCLAPI int		Tcl_ParseCommand(Tcl_Interp *interp,
				const char *start, int numBytes, int nested,
				Tcl_Parse *parsePtr);
/* 362 */
TCLAPI int		Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
				int numBytes, Tcl_Parse *parsePtr);
/* 363 */
TCLAPI int		Tcl_ParseQuotedString(Tcl_Interp *interp,
				const char *start, int numBytes,
				Tcl_Parse *parsePtr, int append,
				const char **termPtr);
/* 364 */
TCLAPI int		Tcl_ParseVarName(Tcl_Interp *interp,
				const char *start, int numBytes,
				Tcl_Parse *parsePtr, int append);
/* 365 */
TCLAPI char *		Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 366 */
TCLAPI int		Tcl_Chdir(const char *dirName);
/* 367 */
TCLAPI int		Tcl_Access(const char *path, int mode);
/* 368 */
TCLAPI int		Tcl_Stat(const char *path, struct stat *bufPtr);
/* 369 */
TCLAPI int		Tcl_UtfNcmp(const char *s1, const char *s2,
				unsigned long n);
/* 370 */
TCLAPI int		Tcl_UtfNcasecmp(const char *s1, const char *s2,
				unsigned long n);
/* 371 */
TCLAPI int		Tcl_StringCaseMatch(const char *str,
				const char *pattern, int nocase);
/* 372 */
TCLAPI int		Tcl_UniCharIsControl(int ch);
/* 373 */
TCLAPI int		Tcl_UniCharIsGraph(int ch);
/* 374 */
TCLAPI int		Tcl_UniCharIsPrint(int ch);
/* 375 */
TCLAPI int		Tcl_UniCharIsPunct(int ch);
/* 376 */
TCLAPI int		Tcl_RegExpExecObj(Tcl_Interp *interp,
				Tcl_RegExp regexp, Tcl_Obj *textObj,
				int offset, int nmatches, int flags);
/* 377 */
TCLAPI void		Tcl_RegExpGetInfo(Tcl_RegExp regexp,
				Tcl_RegExpInfo *infoPtr);
/* 378 */
TCLAPI Tcl_Obj *	Tcl_NewUnicodeObj(const Tcl_UniChar *unicode,
				int numChars);
/* 379 */
TCLAPI void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, int numChars);
/* 380 */
TCLAPI int		Tcl_GetCharLength(Tcl_Obj *objPtr);
/* 381 */
TCLAPI int		Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
/* Slot 382 is reserved */
/* 383 */
TCLAPI Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);

/* 384 */
TCLAPI void		Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, int length);
/* 385 */
TCLAPI int		Tcl_RegExpMatchObj(Tcl_Interp *interp,
				Tcl_Obj *textObj, Tcl_Obj *patternObj);
/* 386 */
TCLAPI void		Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr);
/* 387 */
TCLAPI Tcl_Mutex *	Tcl_GetAllocMutex(void);
/* 388 */
TCLAPI int		Tcl_GetChannelNames(Tcl_Interp *interp);
/* 389 */
TCLAPI int		Tcl_GetChannelNamesEx(Tcl_Interp *interp,
				const char *pattern);
/* 390 */
TCLAPI int		Tcl_ProcObjCmd(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 391 */
TCLAPI void		Tcl_ConditionFinalize(Tcl_Condition *condPtr);
/* 392 */
TCLAPI void		Tcl_MutexFinalize(Tcl_Mutex *mutex);
/* 393 */
TCLAPI int		Tcl_CreateThread(Tcl_ThreadId *idPtr,
				Tcl_ThreadCreateProc *proc,
				ClientData clientData, int stackSize,
				int flags);
/* 394 */
TCLAPI int		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
				int bytesToRead);
/* 395 */
TCLAPI int		Tcl_WriteRaw(Tcl_Channel chan, const char *src,
				int srcLen);
/* 396 */
TCLAPI Tcl_Channel	Tcl_GetTopChannel(Tcl_Channel chan);
/* 397 */
TCLAPI int		Tcl_ChannelBuffered(Tcl_Channel chan);
/* 398 */
TCLAPI const char *	Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr);
/* 399 */







|
















|


|



|











|

|



|




|













|



|




|










|

|
|















|









|

|

|












|

|



|










|
|

|





|

















|


|
<


|

|
|









|


|




|
|


|


|




|










|
<


|














|





|


|

|

|


|
>


|













|
<
|






|
<
|

|
|

|
|







761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942

943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989

990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041

1042
1043
1044
1045
1046
1047
1048
1049

1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
TCLAPI void		Tcl_GetVersion(int *major, int *minor,
				int *patchLevel, int *type);
/* 280 */
TCLAPI void		Tcl_InitMemory(Tcl_Interp *interp);
/* 281 */
TCLAPI Tcl_Channel	Tcl_StackChannel(Tcl_Interp *interp,
				const Tcl_ChannelType *typePtr,
				void *instanceData, int mask,
				Tcl_Channel prevChan);
/* 282 */
TCLAPI int		Tcl_UnstackChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 283 */
TCLAPI Tcl_Channel	Tcl_GetStackedChannel(Tcl_Channel chan);
/* 284 */
TCLAPI void		Tcl_SetMainLoop(Tcl_MainLoopProc *proc);
/* Slot 285 is reserved */
/* 286 */
TCLAPI void		Tcl_AppendObjToObj(Tcl_Obj *objPtr,
				Tcl_Obj *appendObjPtr);
/* 287 */
TCLAPI Tcl_Encoding	Tcl_CreateEncoding(const Tcl_EncodingType *typePtr);
/* 288 */
TCLAPI void		Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc,
				void *clientData);
/* 289 */
TCLAPI void		Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc,
				void *clientData);
/* Slot 290 is reserved */
/* 291 */
TCLAPI int		Tcl_EvalEx(Tcl_Interp *interp, const char *script,
				size_t numBytes, int flags);
/* 292 */
TCLAPI int		Tcl_EvalObjv(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* 293 */
TCLAPI int		Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 294 */
TCLAPI TCL_NORETURN void Tcl_ExitThread(int status);
/* 295 */
TCLAPI int		Tcl_ExternalToUtf(Tcl_Interp *interp,
				Tcl_Encoding encoding, const char *src,
				size_t srcLen, int flags,
				Tcl_EncodingState *statePtr, char *dst,
				size_t dstLen, int *srcReadPtr,
				int *dstWrotePtr, int *dstCharsPtr);
/* 296 */
TCLAPI char *		Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
				const char *src, size_t srcLen,
				Tcl_DString *dsPtr);
/* 297 */
TCLAPI void		Tcl_FinalizeThread(void);
/* 298 */
TCLAPI void		Tcl_FinalizeNotifier(void *clientData);
/* 299 */
TCLAPI void		Tcl_FreeEncoding(Tcl_Encoding encoding);
/* 300 */
TCLAPI Tcl_ThreadId	Tcl_GetCurrentThread(void);
/* 301 */
TCLAPI Tcl_Encoding	Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
/* 302 */
TCLAPI const char *	Tcl_GetEncodingName(Tcl_Encoding encoding);
/* 303 */
TCLAPI void		Tcl_GetEncodingNames(Tcl_Interp *interp);
/* 304 */
TCLAPI int		Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const void *tablePtr,
				size_t offset, const char *msg, int flags,
				int *indexPtr);
/* 305 */
TCLAPI void *		Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
				size_t size);
/* 306 */
TCLAPI Tcl_Obj *	Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* 307 */
TCLAPI void *		Tcl_InitNotifier(void);
/* 308 */
TCLAPI void		Tcl_MutexLock(Tcl_Mutex *mutexPtr);
/* 309 */
TCLAPI void		Tcl_MutexUnlock(Tcl_Mutex *mutexPtr);
/* 310 */
TCLAPI void		Tcl_ConditionNotify(Tcl_Condition *condPtr);
/* 311 */
TCLAPI void		Tcl_ConditionWait(Tcl_Condition *condPtr,
				Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr);
/* 312 */
TCLAPI size_t		Tcl_NumUtfChars(const char *src, size_t length);
/* 313 */
TCLAPI size_t		Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
				size_t charsToRead, int appendFlag);
/* Slot 314 is reserved */
/* Slot 315 is reserved */
/* 316 */
TCLAPI int		Tcl_SetSystemEncoding(Tcl_Interp *interp,
				const char *name);
/* 317 */
TCLAPI Tcl_Obj *	Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
				const char *part2, Tcl_Obj *newValuePtr,
				int flags);
/* 318 */
TCLAPI void		Tcl_ThreadAlert(Tcl_ThreadId threadId);
/* 319 */
TCLAPI void		Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
				Tcl_Event *evPtr, Tcl_QueuePosition position);
/* 320 */
TCLAPI int		Tcl_UniCharAtIndex(const char *src, size_t index);
/* 321 */
TCLAPI int		Tcl_UniCharToLower(int ch);
/* 322 */
TCLAPI int		Tcl_UniCharToTitle(int ch);
/* 323 */
TCLAPI int		Tcl_UniCharToUpper(int ch);
/* 324 */
TCLAPI int		Tcl_UniCharToUtf(int ch, char *buf);
/* 325 */
TCLAPI const char *	Tcl_UtfAtIndex(const char *src, size_t index);
/* 326 */
TCLAPI int		Tcl_UtfCharComplete(const char *src, size_t length);
/* 327 */
TCLAPI size_t		Tcl_UtfBackslash(const char *src, int *readPtr,
				char *dst);
/* 328 */
TCLAPI const char *	Tcl_UtfFindFirst(const char *src, int ch);
/* 329 */
TCLAPI const char *	Tcl_UtfFindLast(const char *src, int ch);
/* 330 */
TCLAPI const char *	Tcl_UtfNext(const char *src);
/* 331 */
TCLAPI const char *	Tcl_UtfPrev(const char *src, const char *start);
/* 332 */
TCLAPI int		Tcl_UtfToExternal(Tcl_Interp *interp,
				Tcl_Encoding encoding, const char *src,
				size_t srcLen, int flags,
				Tcl_EncodingState *statePtr, char *dst,
				size_t dstLen, int *srcReadPtr,
				int *dstWrotePtr, int *dstCharsPtr);
/* 333 */
TCLAPI char *		Tcl_UtfToExternalDString(Tcl_Encoding encoding,
				const char *src, size_t srcLen,
				Tcl_DString *dsPtr);
/* 334 */
TCLAPI int		Tcl_UtfToLower(char *src);
/* 335 */
TCLAPI int		Tcl_UtfToTitle(char *src);
/* 336 */
TCLAPI int		Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr);
/* 337 */
TCLAPI int		Tcl_UtfToUpper(char *src);
/* 338 */
TCLAPI size_t		Tcl_WriteChars(Tcl_Channel chan, const char *src,
				size_t srcLen);
/* 339 */
TCLAPI size_t		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
TCLAPI char *		Tcl_GetString(Tcl_Obj *objPtr);
/* Slot 341 is reserved */
/* Slot 342 is reserved */
/* 343 */
TCLAPI void		Tcl_AlertNotifier(void *clientData);
/* 344 */
TCLAPI void		Tcl_ServiceModeHook(int mode);
/* 345 */
TCLAPI int		Tcl_UniCharIsAlnum(int ch);
/* 346 */
TCLAPI int		Tcl_UniCharIsAlpha(int ch);
/* 347 */
TCLAPI int		Tcl_UniCharIsDigit(int ch);
/* 348 */
TCLAPI int		Tcl_UniCharIsLower(int ch);
/* 349 */
TCLAPI int		Tcl_UniCharIsSpace(int ch);
/* 350 */
TCLAPI int		Tcl_UniCharIsUpper(int ch);
/* 351 */
TCLAPI int		Tcl_UniCharIsWordChar(int ch);
/* 352 */
TCLAPI size_t		Tcl_UniCharLen(const Tcl_UniChar *uniStr);
/* 353 */
TCLAPI int		Tcl_UniCharNcmp(const Tcl_UniChar *ucs,
				const Tcl_UniChar *uct, size_t numChars);

/* 354 */
TCLAPI char *		Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr,
				size_t uniLength, Tcl_DString *dsPtr);
/* 355 */
TCLAPI Tcl_UniChar *	Tcl_UtfToUniCharDString(const char *src,
				size_t length, Tcl_DString *dsPtr);
/* 356 */
TCLAPI Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp,
				Tcl_Obj *patObj, int flags);
/* Slot 357 is reserved */
/* 358 */
TCLAPI void		Tcl_FreeParse(Tcl_Parse *parsePtr);
/* 359 */
TCLAPI void		Tcl_LogCommandInfo(Tcl_Interp *interp,
				const char *script, const char *command,
				size_t length);
/* 360 */
TCLAPI int		Tcl_ParseBraces(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				Tcl_Parse *parsePtr, int append,
				const char **termPtr);
/* 361 */
TCLAPI int		Tcl_ParseCommand(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				int nested, Tcl_Parse *parsePtr);
/* 362 */
TCLAPI int		Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
				size_t numBytes, Tcl_Parse *parsePtr);
/* 363 */
TCLAPI int		Tcl_ParseQuotedString(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				Tcl_Parse *parsePtr, int append,
				const char **termPtr);
/* 364 */
TCLAPI int		Tcl_ParseVarName(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				Tcl_Parse *parsePtr, int append);
/* 365 */
TCLAPI char *		Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 366 */
TCLAPI int		Tcl_Chdir(const char *dirName);
/* 367 */
TCLAPI int		Tcl_Access(const char *path, int mode);
/* 368 */
TCLAPI int		Tcl_Stat(const char *path, struct stat *bufPtr);
/* 369 */
TCLAPI int		Tcl_UtfNcmp(const char *s1, const char *s2, size_t n);

/* 370 */
TCLAPI int		Tcl_UtfNcasecmp(const char *s1, const char *s2,
				size_t n);
/* 371 */
TCLAPI int		Tcl_StringCaseMatch(const char *str,
				const char *pattern, int nocase);
/* 372 */
TCLAPI int		Tcl_UniCharIsControl(int ch);
/* 373 */
TCLAPI int		Tcl_UniCharIsGraph(int ch);
/* 374 */
TCLAPI int		Tcl_UniCharIsPrint(int ch);
/* 375 */
TCLAPI int		Tcl_UniCharIsPunct(int ch);
/* 376 */
TCLAPI int		Tcl_RegExpExecObj(Tcl_Interp *interp,
				Tcl_RegExp regexp, Tcl_Obj *textObj,
				size_t offset, size_t nmatches, int flags);
/* 377 */
TCLAPI void		Tcl_RegExpGetInfo(Tcl_RegExp regexp,
				Tcl_RegExpInfo *infoPtr);
/* 378 */
TCLAPI Tcl_Obj *	Tcl_NewUnicodeObj(const Tcl_UniChar *unicode,
				size_t numChars);
/* 379 */
TCLAPI void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, size_t numChars);
/* 380 */
TCLAPI size_t		Tcl_GetCharLength(Tcl_Obj *objPtr);
/* 381 */
TCLAPI int		Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index);
/* Slot 382 is reserved */
/* 383 */
TCLAPI Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, size_t first,
				size_t last);
/* 384 */
TCLAPI void		Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, size_t length);
/* 385 */
TCLAPI int		Tcl_RegExpMatchObj(Tcl_Interp *interp,
				Tcl_Obj *textObj, Tcl_Obj *patternObj);
/* 386 */
TCLAPI void		Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr);
/* 387 */
TCLAPI Tcl_Mutex *	Tcl_GetAllocMutex(void);
/* 388 */
TCLAPI int		Tcl_GetChannelNames(Tcl_Interp *interp);
/* 389 */
TCLAPI int		Tcl_GetChannelNamesEx(Tcl_Interp *interp,
				const char *pattern);
/* 390 */
TCLAPI int		Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp,

				int objc, Tcl_Obj *const objv[]);
/* 391 */
TCLAPI void		Tcl_ConditionFinalize(Tcl_Condition *condPtr);
/* 392 */
TCLAPI void		Tcl_MutexFinalize(Tcl_Mutex *mutex);
/* 393 */
TCLAPI int		Tcl_CreateThread(Tcl_ThreadId *idPtr,
				Tcl_ThreadCreateProc *proc, void *clientData,

				size_t stackSize, int flags);
/* 394 */
TCLAPI size_t		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
				size_t bytesToRead);
/* 395 */
TCLAPI size_t		Tcl_WriteRaw(Tcl_Channel chan, const char *src,
				size_t srcLen);
/* 396 */
TCLAPI Tcl_Channel	Tcl_GetTopChannel(Tcl_Channel chan);
/* 397 */
TCLAPI int		Tcl_ChannelBuffered(Tcl_Channel chan);
/* 398 */
TCLAPI const char *	Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr);
/* 399 */
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161

1162
1163
1164
1165
1166
1167
1168
TCLAPI void		Tcl_SpliceChannel(Tcl_Channel channel);
/* 417 */
TCLAPI void		Tcl_ClearChannelHandlers(Tcl_Channel channel);
/* 418 */
TCLAPI int		Tcl_IsChannelExisting(const char *channelName);
/* 419 */
TCLAPI int		Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
				const Tcl_UniChar *uct,
				unsigned long numChars);
/* 420 */
TCLAPI int		Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
				const Tcl_UniChar *uniPattern, int nocase);
/* Slot 421 is reserved */
/* Slot 422 is reserved */
/* 423 */
TCLAPI void		Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
				int keyType, const Tcl_HashKeyType *typePtr);
/* 424 */
TCLAPI void		Tcl_InitObjHashTable(Tcl_HashTable *tablePtr);
/* 425 */
TCLAPI ClientData	Tcl_CommandTraceInfo(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *procPtr,
				ClientData prevClientData);
/* 426 */
TCLAPI int		Tcl_TraceCommand(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *proc,
				ClientData clientData);
/* 427 */
TCLAPI void		Tcl_UntraceCommand(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *proc,
				ClientData clientData);
/* 428 */
TCLAPI char *		Tcl_AttemptAlloc(unsigned int size);
/* 429 */
TCLAPI char *		Tcl_AttemptDbCkalloc(unsigned int size,
				const char *file, int line);
/* 430 */
TCLAPI char *		Tcl_AttemptRealloc(char *ptr, unsigned int size);
/* 431 */
TCLAPI char *		Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
				const char *file, int line);
/* 432 */
TCLAPI int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);

/* 433 */
TCLAPI Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
TCLAPI Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
/* Slot 435 is reserved */
/* Slot 436 is reserved */







|
<











|


|



|
<



|
<

|

|
|

|

|


|
>







1112
1113
1114
1115
1116
1117
1118
1119

1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138

1139
1140
1141
1142

1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
TCLAPI void		Tcl_SpliceChannel(Tcl_Channel channel);
/* 417 */
TCLAPI void		Tcl_ClearChannelHandlers(Tcl_Channel channel);
/* 418 */
TCLAPI int		Tcl_IsChannelExisting(const char *channelName);
/* 419 */
TCLAPI int		Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
				const Tcl_UniChar *uct, size_t numChars);

/* 420 */
TCLAPI int		Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
				const Tcl_UniChar *uniPattern, int nocase);
/* Slot 421 is reserved */
/* Slot 422 is reserved */
/* 423 */
TCLAPI void		Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
				int keyType, const Tcl_HashKeyType *typePtr);
/* 424 */
TCLAPI void		Tcl_InitObjHashTable(Tcl_HashTable *tablePtr);
/* 425 */
TCLAPI void *		Tcl_CommandTraceInfo(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *procPtr,
				void *prevClientData);
/* 426 */
TCLAPI int		Tcl_TraceCommand(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *proc, void *clientData);

/* 427 */
TCLAPI void		Tcl_UntraceCommand(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *proc, void *clientData);

/* 428 */
TCLAPI void *		Tcl_AttemptAlloc(size_t size);
/* 429 */
TCLAPI void *		Tcl_AttemptDbCkalloc(size_t size, const char *file,
				int line);
/* 430 */
TCLAPI void *		Tcl_AttemptRealloc(void *ptr, size_t size);
/* 431 */
TCLAPI void *		Tcl_AttemptDbCkrealloc(void *ptr, size_t size,
				const char *file, int line);
/* 432 */
TCLAPI int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr,
				size_t length);
/* 433 */
TCLAPI Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
TCLAPI Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
/* Slot 435 is reserved */
/* Slot 436 is reserved */
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
/* 463 */
TCLAPI Tcl_Obj *	Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 464 */
TCLAPI Tcl_Obj *	Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
				Tcl_Obj *const objv[]);
/* 465 */
TCLAPI ClientData	Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
				const Tcl_Filesystem *fsPtr);
/* 466 */
TCLAPI Tcl_Obj *	Tcl_FSGetTranslatedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 467 */
TCLAPI int		Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName);
/* 468 */
TCLAPI Tcl_Obj *	Tcl_FSNewNativePath(
				const Tcl_Filesystem *fromFilesystem,
				ClientData clientData);
/* 469 */
TCLAPI const void *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
/* 470 */
TCLAPI Tcl_Obj *	Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr);
/* 471 */
TCLAPI Tcl_Obj *	Tcl_FSPathSeparator(Tcl_Obj *pathPtr);
/* 472 */
TCLAPI Tcl_Obj *	Tcl_FSListVolumes(void);
/* 473 */
TCLAPI int		Tcl_FSRegister(ClientData clientData,
				const Tcl_Filesystem *fsPtr);
/* 474 */
TCLAPI int		Tcl_FSUnregister(const Tcl_Filesystem *fsPtr);
/* 475 */
TCLAPI ClientData	Tcl_FSData(const Tcl_Filesystem *fsPtr);
/* 476 */
TCLAPI const char *	Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 477 */
TCLAPI const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
/* 478 */
TCLAPI Tcl_PathType	Tcl_FSGetPathType(Tcl_Obj *pathPtr);
/* 479 */
TCLAPI int		Tcl_OutputBuffered(Tcl_Channel chan);
/* 480 */
TCLAPI void		Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr);
/* 481 */
TCLAPI int		Tcl_EvalTokensStandard(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, int count);
/* 482 */
TCLAPI void		Tcl_GetTime(Tcl_Time *timeBuf);
/* 483 */
TCLAPI Tcl_Trace	Tcl_CreateObjTrace(Tcl_Interp *interp, int level,
				int flags, Tcl_CmdObjTraceProc *objProc,
				ClientData clientData,
				Tcl_CmdObjTraceDeleteProc *delProc);
/* 484 */
TCLAPI int		Tcl_GetCommandInfoFromToken(Tcl_Command token,
				Tcl_CmdInfo *infoPtr);
/* 485 */
TCLAPI int		Tcl_SetCommandInfoFromToken(Tcl_Command token,
				const Tcl_CmdInfo *infoPtr);







|









|









|




|













|





|







1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
/* 463 */
TCLAPI Tcl_Obj *	Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 464 */
TCLAPI Tcl_Obj *	Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
				Tcl_Obj *const objv[]);
/* 465 */
TCLAPI void *		Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
				const Tcl_Filesystem *fsPtr);
/* 466 */
TCLAPI Tcl_Obj *	Tcl_FSGetTranslatedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 467 */
TCLAPI int		Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName);
/* 468 */
TCLAPI Tcl_Obj *	Tcl_FSNewNativePath(
				const Tcl_Filesystem *fromFilesystem,
				void *clientData);
/* 469 */
TCLAPI const void *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
/* 470 */
TCLAPI Tcl_Obj *	Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr);
/* 471 */
TCLAPI Tcl_Obj *	Tcl_FSPathSeparator(Tcl_Obj *pathPtr);
/* 472 */
TCLAPI Tcl_Obj *	Tcl_FSListVolumes(void);
/* 473 */
TCLAPI int		Tcl_FSRegister(void *clientData,
				const Tcl_Filesystem *fsPtr);
/* 474 */
TCLAPI int		Tcl_FSUnregister(const Tcl_Filesystem *fsPtr);
/* 475 */
TCLAPI void *		Tcl_FSData(const Tcl_Filesystem *fsPtr);
/* 476 */
TCLAPI const char *	Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 477 */
TCLAPI const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
/* 478 */
TCLAPI Tcl_PathType	Tcl_FSGetPathType(Tcl_Obj *pathPtr);
/* 479 */
TCLAPI int		Tcl_OutputBuffered(Tcl_Channel chan);
/* 480 */
TCLAPI void		Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr);
/* 481 */
TCLAPI int		Tcl_EvalTokensStandard(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, size_t count);
/* 482 */
TCLAPI void		Tcl_GetTime(Tcl_Time *timeBuf);
/* 483 */
TCLAPI Tcl_Trace	Tcl_CreateObjTrace(Tcl_Interp *interp, int level,
				int flags, Tcl_CmdObjTraceProc *objProc,
				void *clientData,
				Tcl_CmdObjTraceDeleteProc *delProc);
/* 484 */
TCLAPI int		Tcl_GetCommandInfoFromToken(Tcl_Command token,
				Tcl_CmdInfo *infoPtr);
/* 485 */
TCLAPI int		Tcl_SetCommandInfoFromToken(Tcl_Command token,
				const Tcl_CmdInfo *infoPtr);
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
/* 505 */
TCLAPI void		Tcl_RegisterConfig(Tcl_Interp *interp,
				const char *pkgName,
				const Tcl_Config *configuration,
				const char *valEncoding);
/* 506 */
TCLAPI Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
				const char *name, ClientData clientData,
				Tcl_NamespaceDeleteProc *deleteProc);
/* 507 */
TCLAPI void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
/* 508 */
TCLAPI int		Tcl_AppendExportList(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 509 */







|







1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
/* 505 */
TCLAPI void		Tcl_RegisterConfig(Tcl_Interp *interp,
				const char *pkgName,
				const Tcl_Config *configuration,
				const char *valEncoding);
/* 506 */
TCLAPI Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
				const char *name, void *clientData,
				Tcl_NamespaceDeleteProc *deleteProc);
/* 507 */
TCLAPI void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
/* 508 */
TCLAPI int		Tcl_AppendExportList(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 509 */
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
TCLAPI int		Tcl_FSEvalFileEx(Tcl_Interp *interp,
				Tcl_Obj *fileName, const char *encodingName);
/* 519 */
TCLAPI Tcl_ExitProc *	Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
/* 520 */
TCLAPI void		Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
				Tcl_LimitHandlerProc *handlerProc,
				ClientData clientData,
				Tcl_LimitHandlerDeleteProc *deleteProc);
/* 521 */
TCLAPI void		Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
				Tcl_LimitHandlerProc *handlerProc,
				ClientData clientData);
/* 522 */
TCLAPI int		Tcl_LimitReady(Tcl_Interp *interp);
/* 523 */
TCLAPI int		Tcl_LimitCheck(Tcl_Interp *interp);
/* 524 */
TCLAPI int		Tcl_LimitExceeded(Tcl_Interp *interp);
/* 525 */







|




|







1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
TCLAPI int		Tcl_FSEvalFileEx(Tcl_Interp *interp,
				Tcl_Obj *fileName, const char *encodingName);
/* 519 */
TCLAPI Tcl_ExitProc *	Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
/* 520 */
TCLAPI void		Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
				Tcl_LimitHandlerProc *handlerProc,
				void *clientData,
				Tcl_LimitHandlerDeleteProc *deleteProc);
/* 521 */
TCLAPI void		Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
				Tcl_LimitHandlerProc *handlerProc,
				void *clientData);
/* 522 */
TCLAPI int		Tcl_LimitReady(Tcl_Interp *interp);
/* 523 */
TCLAPI int		Tcl_LimitCheck(Tcl_Interp *interp);
/* 524 */
TCLAPI int		Tcl_LimitExceeded(Tcl_Interp *interp);
/* 525 */
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
/* 551 */
TCLAPI int		Tcl_GetEnsembleNamespace(Tcl_Interp *interp,
				Tcl_Command token,
				Tcl_Namespace **namespacePtrPtr);
/* 552 */
TCLAPI void		Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
				Tcl_ScaleTimeProc *scaleProc,
				ClientData clientData);
/* 553 */
TCLAPI void		Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
				Tcl_ScaleTimeProc **scaleProc,
				ClientData *clientData);
/* 554 */
TCLAPI Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc(
				const Tcl_ChannelType *chanTypePtr);
/* 555 */
TCLAPI Tcl_Obj *	Tcl_NewBignumObj(mp_int *value);
/* 556 */
TCLAPI Tcl_Obj *	Tcl_DbNewBignumObj(mp_int *value, const char *file,







|



|







1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
/* 551 */
TCLAPI int		Tcl_GetEnsembleNamespace(Tcl_Interp *interp,
				Tcl_Command token,
				Tcl_Namespace **namespacePtrPtr);
/* 552 */
TCLAPI void		Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
				Tcl_ScaleTimeProc *scaleProc,
				void *clientData);
/* 553 */
TCLAPI void		Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
				Tcl_ScaleTimeProc **scaleProc,
				void **clientData);
/* 554 */
TCLAPI Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc(
				const Tcl_ChannelType *chanTypePtr);
/* 555 */
TCLAPI Tcl_Obj *	Tcl_NewBignumObj(mp_int *value);
/* 556 */
TCLAPI Tcl_Obj *	Tcl_DbNewBignumObj(mp_int *value, const char *file,
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
				const char *name, int objc,
				Tcl_Obj *const objv[], void *clientDataPtr);
/* 574 */
TCLAPI void		Tcl_AppendObjToErrorInfo(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 575 */
TCLAPI void		Tcl_AppendLimitedToObj(Tcl_Obj *objPtr,
				const char *bytes, int length, int limit,
				const char *ellipsis);
/* 576 */
TCLAPI Tcl_Obj *	Tcl_Format(Tcl_Interp *interp, const char *format,
				int objc, Tcl_Obj *const objv[]);
/* 577 */
TCLAPI int		Tcl_AppendFormatToObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const char *format,
				int objc, Tcl_Obj *const objv[]);
/* 578 */
TCLAPI Tcl_Obj *	Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 579 */
TCLAPI void		Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
				const char *format, ...) TCL_FORMAT_PRINTF(2, 3);
/* 580 */
TCLAPI int		Tcl_CancelEval(Tcl_Interp *interp,
				Tcl_Obj *resultObjPtr, ClientData clientData,
				int flags);
/* 581 */
TCLAPI int		Tcl_Canceled(Tcl_Interp *interp, int flags);
/* 582 */
TCLAPI int		Tcl_CreatePipe(Tcl_Interp *interp,
				Tcl_Channel *rchan, Tcl_Channel *wchan,
				int flags);
/* 583 */
TCLAPI Tcl_Command	Tcl_NRCreateCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				Tcl_ObjCmdProc *nreProc,
				ClientData clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 584 */
TCLAPI int		Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 585 */
TCLAPI int		Tcl_NREvalObjv(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* 586 */
TCLAPI int		Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd,
				int objc, Tcl_Obj *const objv[], int flags);
/* 587 */
TCLAPI void		Tcl_NRAddCallback(Tcl_Interp *interp,
				Tcl_NRPostProc *postProcPtr,
				ClientData data0, ClientData data1,
				ClientData data2, ClientData data3);
/* 588 */
TCLAPI int		Tcl_NRCallObjProc(Tcl_Interp *interp,
				Tcl_ObjCmdProc *objProc,
				ClientData clientData, int objc,
				Tcl_Obj *const objv[]);
/* 589 */
TCLAPI unsigned		Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr);
/* 590 */
TCLAPI unsigned		Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr);
/* 591 */
TCLAPI unsigned		Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr);
/* 592 */







|
|














|










|
<












|
|
<


|
<
|







1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580

1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594

1595
1596
1597

1598
1599
1600
1601
1602
1603
1604
1605
				const char *name, int objc,
				Tcl_Obj *const objv[], void *clientDataPtr);
/* 574 */
TCLAPI void		Tcl_AppendObjToErrorInfo(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 575 */
TCLAPI void		Tcl_AppendLimitedToObj(Tcl_Obj *objPtr,
				const char *bytes, size_t length,
				size_t limit, const char *ellipsis);
/* 576 */
TCLAPI Tcl_Obj *	Tcl_Format(Tcl_Interp *interp, const char *format,
				int objc, Tcl_Obj *const objv[]);
/* 577 */
TCLAPI int		Tcl_AppendFormatToObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const char *format,
				int objc, Tcl_Obj *const objv[]);
/* 578 */
TCLAPI Tcl_Obj *	Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 579 */
TCLAPI void		Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
				const char *format, ...) TCL_FORMAT_PRINTF(2, 3);
/* 580 */
TCLAPI int		Tcl_CancelEval(Tcl_Interp *interp,
				Tcl_Obj *resultObjPtr, void *clientData,
				int flags);
/* 581 */
TCLAPI int		Tcl_Canceled(Tcl_Interp *interp, int flags);
/* 582 */
TCLAPI int		Tcl_CreatePipe(Tcl_Interp *interp,
				Tcl_Channel *rchan, Tcl_Channel *wchan,
				int flags);
/* 583 */
TCLAPI Tcl_Command	Tcl_NRCreateCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				Tcl_ObjCmdProc *nreProc, void *clientData,

				Tcl_CmdDeleteProc *deleteProc);
/* 584 */
TCLAPI int		Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 585 */
TCLAPI int		Tcl_NREvalObjv(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* 586 */
TCLAPI int		Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd,
				int objc, Tcl_Obj *const objv[], int flags);
/* 587 */
TCLAPI void		Tcl_NRAddCallback(Tcl_Interp *interp,
				Tcl_NRPostProc *postProcPtr, void *data0,
				void *data1, void *data2, void *data3);

/* 588 */
TCLAPI int		Tcl_NRCallObjProc(Tcl_Interp *interp,
				Tcl_ObjCmdProc *objProc, void *clientData,

				int objc, Tcl_Obj *const objv[]);
/* 589 */
TCLAPI unsigned		Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr);
/* 590 */
TCLAPI unsigned		Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr);
/* 591 */
TCLAPI unsigned		Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr);
/* 592 */
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
TCLAPI void		Tcl_BackgroundException(Tcl_Interp *interp, int code);
/* 610 */
TCLAPI int		Tcl_ZlibDeflate(Tcl_Interp *interp, int format,
				Tcl_Obj *data, int level,
				Tcl_Obj *gzipHeaderDictObj);
/* 611 */
TCLAPI int		Tcl_ZlibInflate(Tcl_Interp *interp, int format,
				Tcl_Obj *data, int buffersize,
				Tcl_Obj *gzipHeaderDictObj);
/* 612 */
TCLAPI unsigned int	Tcl_ZlibCRC32(unsigned int crc,
				const unsigned char *buf, int len);
/* 613 */
TCLAPI unsigned int	Tcl_ZlibAdler32(unsigned int adler,
				const unsigned char *buf, int len);
/* 614 */
TCLAPI int		Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode,
				int format, int level, Tcl_Obj *dictObj,
				Tcl_ZlibStream *zshandle);
/* 615 */
TCLAPI Tcl_Obj *	Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle);
/* 616 */
TCLAPI int		Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle);
/* 617 */
TCLAPI int		Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle);
/* 618 */
TCLAPI int		Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle,
				Tcl_Obj *data, int flush);
/* 619 */
TCLAPI int		Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle,
				Tcl_Obj *data, int count);
/* 620 */
TCLAPI int		Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle);
/* 621 */
TCLAPI int		Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle);
/* 622 */
TCLAPI void		Tcl_SetStartupScript(Tcl_Obj *path,
				const char *encoding);







|



|


|















|







1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
TCLAPI void		Tcl_BackgroundException(Tcl_Interp *interp, int code);
/* 610 */
TCLAPI int		Tcl_ZlibDeflate(Tcl_Interp *interp, int format,
				Tcl_Obj *data, int level,
				Tcl_Obj *gzipHeaderDictObj);
/* 611 */
TCLAPI int		Tcl_ZlibInflate(Tcl_Interp *interp, int format,
				Tcl_Obj *data, size_t buffersize,
				Tcl_Obj *gzipHeaderDictObj);
/* 612 */
TCLAPI unsigned int	Tcl_ZlibCRC32(unsigned int crc,
				const unsigned char *buf, size_t len);
/* 613 */
TCLAPI unsigned int	Tcl_ZlibAdler32(unsigned int adler,
				const unsigned char *buf, size_t len);
/* 614 */
TCLAPI int		Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode,
				int format, int level, Tcl_Obj *dictObj,
				Tcl_ZlibStream *zshandle);
/* 615 */
TCLAPI Tcl_Obj *	Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle);
/* 616 */
TCLAPI int		Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle);
/* 617 */
TCLAPI int		Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle);
/* 618 */
TCLAPI int		Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle,
				Tcl_Obj *data, int flush);
/* 619 */
TCLAPI int		Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle,
				Tcl_Obj *data, size_t count);
/* 620 */
TCLAPI int		Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle);
/* 621 */
TCLAPI int		Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle);
/* 622 */
TCLAPI void		Tcl_SetStartupScript(Tcl_Obj *path,
				const char *encoding);
1716
1717
1718
1719
1720
1721
1722
1723













1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
				Tcl_ZlibStream zhandle,
				Tcl_Obj *compressionDictionaryObj);
/* 631 */
TCLAPI Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp,
				const char *service, const char *host,
				unsigned int flags,
				Tcl_TcpAcceptProc *acceptProc,
				ClientData callbackData);














typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
    const struct TclOOStubs *tclOOStubs;
    const struct TclOOIntStubs *tclOOIntStubs;
} TclStubHooks;

typedef struct TclStubs {
    int magic;
    const TclStubHooks *hooks;

    int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
    const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
    TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
    char * (*tcl_Alloc) (unsigned int size); /* 3 */
    void (*tcl_Free) (char *ptr); /* 4 */
    char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */
    char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */
    void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */
    char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved9)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved10)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* MACOSX */
    void (*tcl_SetTimer) (const Tcl_Time *timePtr); /* 11 */
    void (*tcl_Sleep) (int ms); /* 12 */
    int (*tcl_WaitForEvent) (const Tcl_Time *timePtr); /* 13 */
    int (*tcl_AppendAllObjTypes) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 14 */
    void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...); /* 15 */
    void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 16 */
    Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */
    int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 18 */
    void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
    void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
    int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
    void (*reserved22)(void);
    Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */
    Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
    Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
    void (*reserved26)(void);
    Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
    Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */
    Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
    void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
    int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */
    int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */
    unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
    int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
    int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */







|
>
>
>
>
>
>
>
>
>
>
>
>
>
















|
|
|
|
|
|

|





|















|






|




|







1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
				Tcl_ZlibStream zhandle,
				Tcl_Obj *compressionDictionaryObj);
/* 631 */
TCLAPI Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp,
				const char *service, const char *host,
				unsigned int flags,
				Tcl_TcpAcceptProc *acceptProc,
				void *callbackData);
/* 632 */
TCLAPI int		TclZipfs_Mount(Tcl_Interp *interp,
				const char *mountPoint, const char *zipname,
				const char *passwd);
/* 633 */
TCLAPI int		TclZipfs_Unmount(Tcl_Interp *interp,
				const char *mountPoint);
/* 634 */
TCLAPI Tcl_Obj *	TclZipfs_TclLibrary(void);
/* 635 */
TCLAPI int		TclZipfs_MountBuffer(Tcl_Interp *interp,
				const char *mountPoint, unsigned char *data,
				size_t datalen, int copy);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
    const struct TclOOStubs *tclOOStubs;
    const struct TclOOIntStubs *tclOOIntStubs;
} TclStubHooks;

typedef struct TclStubs {
    int magic;
    const TclStubHooks *hooks;

    int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
    const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
    TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
    void * (*tcl_Alloc) (size_t size); /* 3 */
    void (*tcl_Free) (void *ptr); /* 4 */
    void * (*tcl_Realloc) (void *ptr, size_t size); /* 5 */
    void * (*tcl_DbCkalloc) (size_t size, const char *file, int line); /* 6 */
    void (*tcl_DbCkfree) (void *ptr, const char *file, int line); /* 7 */
    void * (*tcl_DbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 8 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved9)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved10)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* MACOSX */
    void (*tcl_SetTimer) (const Tcl_Time *timePtr); /* 11 */
    void (*tcl_Sleep) (int ms); /* 12 */
    int (*tcl_WaitForEvent) (const Tcl_Time *timePtr); /* 13 */
    int (*tcl_AppendAllObjTypes) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 14 */
    void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...); /* 15 */
    void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 16 */
    Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */
    int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 18 */
    void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
    void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
    int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
    void (*reserved22)(void);
    Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, size_t length, const char *file, int line); /* 23 */
    Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
    Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
    void (*reserved26)(void);
    Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
    Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, size_t length, const char *file, int line); /* 28 */
    Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
    void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
    int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */
    int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */
    unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
    int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
    int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
    int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
    int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
    int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
    int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
    int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
    int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
    void (*reserved49)(void);
    Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
    Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
    void (*reserved52)(void);
    Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
    void (*reserved54)(void);
    Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
    Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
    void (*reserved57)(void);
    unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
    void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */
    void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
    void (*reserved61)(void);
    void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
    void (*reserved63)(void);
    void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
    void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
    void (*reserved66)(void);
    void (*reserved67)(void);
    void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
    void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */
    void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
    Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */
    void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */
    int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */
    void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
    int (*tcl_AsyncReady) (void); /* 75 */
    void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
    void (*reserved77)(void);
    int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
    void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
    void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
    int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
    int (*tcl_CommandComplete) (const char *cmd); /* 82 */
    char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */
    int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
    int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */
    int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */
    int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
    Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
    void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
    void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
    Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */
    void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
    void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
    Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
    void (*reserved95)(void);
    Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
    Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
    Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
    Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
    void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
    void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */
    void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */
    int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName); /* 103 */
    int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */
    void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, ClientData clientData); /* 105 */
    void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 106 */
    void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 107 */
    void (*tcl_DeleteHashEntry) (Tcl_HashEntry *entryPtr); /* 108 */
    void (*tcl_DeleteHashTable) (Tcl_HashTable *tablePtr); /* 109 */
    void (*tcl_DeleteInterp) (Tcl_Interp *interp); /* 110 */
    void (*tcl_DetachPids) (int numPids, Tcl_Pid *pidPtr); /* 111 */
    void (*tcl_DeleteTimerHandler) (Tcl_TimerToken token); /* 112 */
    void (*tcl_DeleteTrace) (Tcl_Interp *interp, Tcl_Trace trace); /* 113 */
    void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 114 */
    int (*tcl_DoOneEvent) (int flags); /* 115 */
    void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, ClientData clientData); /* 116 */
    char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, int length); /* 117 */
    char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, const char *element); /* 118 */
    void (*tcl_DStringEndSublist) (Tcl_DString *dsPtr); /* 119 */
    void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */
    void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */
    void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */
    void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */
    void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
    void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
    int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
    const char * (*tcl_ErrnoId) (void); /* 127 */
    const char * (*tcl_ErrnoMsg) (int err); /* 128 */
    void (*reserved129)(void);
    int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
    void (*reserved131)(void);
    void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
    TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
    int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
    int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */
    int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
    int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */
    int (*tcl_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */
    int (*tcl_ExprLong) (Tcl_Interp *interp, const char *expr, long *ptr); /* 139 */
    int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */
    int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
    int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
    void (*tcl_Finalize) (void); /* 143 */
    void (*reserved144)(void);
    Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
    int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
    void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
    int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
    int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
    ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
    Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
    int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
    int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */
    ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
    int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
    const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
    int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
    const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
    int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
    const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
    int (*tcl_GetErrno) (void); /* 161 */
    const char * (*tcl_GetHostName) (void); /* 162 */
    int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */
    Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
    const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
    Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved167)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* MACOSX */
    Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */
    int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
    int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
    int (*tcl_GetServiceMode) (void); /* 171 */
    Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
    Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
    const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
    void (*reserved175)(void);
    const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
    void (*reserved177)(void);
    void (*reserved178)(void);
    int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
    int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
    void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
    int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */
    int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
    int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
    int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
    char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
    int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */
    void (*reserved188)(void);
    Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
    int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
    Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
    char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
    Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
    void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
    Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */
    Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
    Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */
    Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
    Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
    Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */
    void (*tcl_Preserve) (ClientData data); /* 201 */
    void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
    int (*tcl_PutEnv) (const char *assignment); /* 203 */
    const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
    void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
    int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
    void (*tcl_ReapDetachedProcs) (void); /* 207 */
    int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */
    int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */
    void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 210 */
    void (*tcl_RegisterObjType) (const Tcl_ObjType *typePtr); /* 211 */
    Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */
    int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */
    int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */
    void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */
    void (*tcl_Release) (ClientData clientData); /* 216 */
    void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
    int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
    int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
    void (*reserved220)(void);
    int (*tcl_ServiceAll) (void); /* 221 */
    int (*tcl_ServiceEvent) (int flags); /* 222 */
    void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
    void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */
    int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */
    int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */
    void (*tcl_SetErrno) (int err); /* 227 */
    void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
    void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
    void (*reserved230)(void);







|





|

|
|




|
|





|







|
|



|
|


|
|
|
|
|
|


|

|
|

|
|


|
|
|






|

|
|






|







|

















|


|
|













|





|


|
|


















|

|








|
|




|








|
|

|
|



|







1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
    int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
    int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
    int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
    int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
    int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
    int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
    void (*reserved49)(void);
    Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, size_t length); /* 50 */
    Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
    void (*reserved52)(void);
    Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
    void (*reserved54)(void);
    Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
    Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, size_t length); /* 56 */
    void (*reserved57)(void);
    unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, size_t length); /* 58 */
    void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, size_t length); /* 59 */
    void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
    void (*reserved61)(void);
    void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
    void (*reserved63)(void);
    void (*tcl_SetObjLength) (Tcl_Obj *objPtr, size_t length); /* 64 */
    void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 65 */
    void (*reserved66)(void);
    void (*reserved67)(void);
    void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
    void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */
    void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
    Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, void *clientData); /* 71 */
    void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */
    int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */
    void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
    int (*tcl_AsyncReady) (void); /* 75 */
    void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
    void (*reserved77)(void);
    int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
    void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 79 */
    void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, void *clientData); /* 80 */
    int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
    int (*tcl_CommandComplete) (const char *cmd); /* 82 */
    char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */
    size_t (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
    size_t (*tcl_ConvertCountedElement) (const char *src, size_t length, char *dst, int flags); /* 85 */
    int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */
    int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
    Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, void *instanceData, int mask); /* 88 */
    void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, void *clientData); /* 89 */
    void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 90 */
    Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */
    void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 92 */
    void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 93 */
    Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
    void (*reserved95)(void);
    Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
    Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
    Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, void *clientData); /* 98 */
    Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, void *clientData); /* 99 */
    void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
    void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, void *clientData); /* 101 */
    void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 102 */
    int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName); /* 103 */
    int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */
    void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, void *clientData); /* 105 */
    void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 106 */
    void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 107 */
    void (*tcl_DeleteHashEntry) (Tcl_HashEntry *entryPtr); /* 108 */
    void (*tcl_DeleteHashTable) (Tcl_HashTable *tablePtr); /* 109 */
    void (*tcl_DeleteInterp) (Tcl_Interp *interp); /* 110 */
    void (*tcl_DetachPids) (int numPids, Tcl_Pid *pidPtr); /* 111 */
    void (*tcl_DeleteTimerHandler) (Tcl_TimerToken token); /* 112 */
    void (*tcl_DeleteTrace) (Tcl_Interp *interp, Tcl_Trace trace); /* 113 */
    void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 114 */
    int (*tcl_DoOneEvent) (int flags); /* 115 */
    void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, void *clientData); /* 116 */
    char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, size_t length); /* 117 */
    char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, const char *element); /* 118 */
    void (*tcl_DStringEndSublist) (Tcl_DString *dsPtr); /* 119 */
    void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */
    void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */
    void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */
    void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */
    void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, size_t length); /* 124 */
    void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
    int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
    const char * (*tcl_ErrnoId) (void); /* 127 */
    const char * (*tcl_ErrnoMsg) (int err); /* 128 */
    void (*reserved129)(void);
    int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
    void (*reserved131)(void);
    void (*tcl_EventuallyFree) (void *clientData, Tcl_FreeProc *freeProc); /* 132 */
    TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
    int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
    int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */
    int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
    int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */
    int (*tcl_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */
    int (*tcl_ExprLong) (Tcl_Interp *interp, const char *expr, long *ptr); /* 139 */
    int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */
    int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
    int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
    void (*tcl_Finalize) (void); /* 143 */
    void (*reserved144)(void);
    Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
    int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
    void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
    int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
    int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
    void * (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
    Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
    int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
    int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, void **handlePtr); /* 153 */
    void * (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
    int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
    const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
    int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
    const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
    int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
    const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
    int (*tcl_GetErrno) (void); /* 161 */
    const char * (*tcl_GetHostName) (void); /* 162 */
    int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */
    Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
    const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
    Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved167)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */
#endif /* MACOSX */
    Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */
    size_t (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
    size_t (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
    int (*tcl_GetServiceMode) (void); /* 171 */
    Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
    Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
    const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
    void (*reserved175)(void);
    const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
    void (*reserved177)(void);
    void (*reserved178)(void);
    int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
    int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
    void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
    int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */
    int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
    int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
    int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
    char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
    int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */
    void (*reserved188)(void);
    Tcl_Channel (*tcl_MakeFileChannel) (void *handle, int mode); /* 189 */
    int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
    Tcl_Channel (*tcl_MakeTcpClientChannel) (void *tcpSocket); /* 191 */
    char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
    Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
    void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
    Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */
    Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
    Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */
    Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
    Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
    Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 200 */
    void (*tcl_Preserve) (void *data); /* 201 */
    void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
    int (*tcl_PutEnv) (const char *assignment); /* 203 */
    const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
    void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
    size_t (*tcl_Read) (Tcl_Channel chan, char *bufPtr, size_t toRead); /* 206 */
    void (*tcl_ReapDetachedProcs) (void); /* 207 */
    int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */
    int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */
    void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 210 */
    void (*tcl_RegisterObjType) (const Tcl_ObjType *typePtr); /* 211 */
    Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */
    int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */
    int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */
    void (*tcl_RegExpRange) (Tcl_RegExp regexp, size_t index, const char **startPtr, const char **endPtr); /* 215 */
    void (*tcl_Release) (void *clientData); /* 216 */
    void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
    size_t (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
    size_t (*tcl_ScanCountedElement) (const char *src, size_t length, int *flagPtr); /* 219 */
    void (*reserved220)(void);
    int (*tcl_ServiceAll) (void); /* 221 */
    int (*tcl_ServiceEvent) (int flags); /* 222 */
    void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, void *clientData); /* 223 */
    void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */
    int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */
    int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */
    void (*tcl_SetErrno) (int err); /* 227 */
    void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
    void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
    void (*reserved230)(void);
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
    void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
    int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
    void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
    void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
    int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
    void (*reserved246)(void);
    void (*reserved247)(void);
    int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
    char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
    int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */
    void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
    int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
    void (*reserved253)(void);
    int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
    void (*reserved255)(void);
    void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
    void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
    void (*reserved258)(void);
    int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */
    void (*reserved260)(void);
    void (*reserved261)(void);
    ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
    int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */
    void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
    int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
    void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
    void (*reserved267)(void);
    void (*reserved268)(void);
    char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
    const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
    void (*reserved271)(void);
    const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
    void (*reserved273)(void);
    void (*reserved274)(void);
    void (*reserved275)(void);
    void (*reserved276)(void);
    Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
    void (*reserved278)(void);
    void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
    void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
    Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
    int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */
    Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */
    void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */
    void (*reserved285)(void);
    void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */
    Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */
    void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */
    void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */
    void (*reserved290)(void);
    int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */
    int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */
    int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */
    TCL_NORETURN1 void (*tcl_ExitThread) (int status); /* 294 */
    int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */
    char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */
    void (*tcl_FinalizeThread) (void); /* 297 */
    void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */
    void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
    Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
    Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
    const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
    void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
    int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */
    void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
    Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */
    ClientData (*tcl_InitNotifier) (void); /* 307 */
    void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */
    void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */
    void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */
    void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */
    int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */
    int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */
    void (*reserved314)(void);
    void (*reserved315)(void);
    int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */
    Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
    void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
    void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */
    int (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */
    int (*tcl_UniCharToLower) (int ch); /* 321 */
    int (*tcl_UniCharToTitle) (int ch); /* 322 */
    int (*tcl_UniCharToUpper) (int ch); /* 323 */
    int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
    const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
    int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */
    int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
    const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
    const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
    const char * (*tcl_UtfNext) (const char *src); /* 330 */
    const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
    int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
    char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */
    int (*tcl_UtfToLower) (char *src); /* 334 */
    int (*tcl_UtfToTitle) (char *src); /* 335 */
    int (*tcl_UtfToUniChar) (const char *src, Tcl_UniChar *chPtr); /* 336 */
    int (*tcl_UtfToUpper) (char *src); /* 337 */
    int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
    int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
    char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
    void (*reserved341)(void);
    void (*reserved342)(void);
    void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
    void (*tcl_ServiceModeHook) (int mode); /* 344 */
    int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
    int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
    int (*tcl_UniCharIsDigit) (int ch); /* 347 */
    int (*tcl_UniCharIsLower) (int ch); /* 348 */
    int (*tcl_UniCharIsSpace) (int ch); /* 349 */
    int (*tcl_UniCharIsUpper) (int ch); /* 350 */
    int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
    int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */
    int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */
    char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
    Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
    Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
    void (*reserved357)(void);
    void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
    void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
    int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */
    int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
    int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
    int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */
    int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
    char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */
    int (*tcl_Chdir) (const char *dirName); /* 366 */
    int (*tcl_Access) (const char *path, int mode); /* 367 */
    int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */
    int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */
    int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */
    int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */
    int (*tcl_UniCharIsControl) (int ch); /* 372 */
    int (*tcl_UniCharIsGraph) (int ch); /* 373 */
    int (*tcl_UniCharIsPrint) (int ch); /* 374 */
    int (*tcl_UniCharIsPunct) (int ch); /* 375 */
    int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */
    void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */
    Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */
    void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */
    int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
    int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
    void (*reserved382)(void);
    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
    void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */
    int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
    void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */
    Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
    int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
    int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */
    int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */
    void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
    void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
    int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */
    int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */
    int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */
    Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
    int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
    const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
    Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
    Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */







|

|





|





|
|

















|






|
|

|



|
|

|





|
|

|




|
|






|




|
|
|




|
|




|
|



|








|
|
|
|



|
|
|
|
|
|




|
|





|

|
|
|
|

|
|





|


|
|
|







2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
    void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
    int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
    void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
    void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
    int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
    void (*reserved246)(void);
    void (*reserved247)(void);
    int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 248 */
    char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
    size_t (*tcl_Ungets) (Tcl_Channel chan, const char *str, size_t len, int atHead); /* 250 */
    void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
    int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
    void (*reserved253)(void);
    int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
    void (*reserved255)(void);
    void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 256 */
    void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
    void (*reserved258)(void);
    int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */
    void (*reserved260)(void);
    void (*reserved261)(void);
    void * (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, void *prevClientData); /* 262 */
    size_t (*tcl_Write) (Tcl_Channel chan, const char *s, size_t slen); /* 263 */
    void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
    int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
    void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
    void (*reserved267)(void);
    void (*reserved268)(void);
    char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
    const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
    void (*reserved271)(void);
    const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
    void (*reserved273)(void);
    void (*reserved274)(void);
    void (*reserved275)(void);
    void (*reserved276)(void);
    Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
    void (*reserved278)(void);
    void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
    void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
    Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan); /* 281 */
    int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */
    Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */
    void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */
    void (*reserved285)(void);
    void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */
    Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */
    void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 288 */
    void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 289 */
    void (*reserved290)(void);
    int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, size_t numBytes, int flags); /* 291 */
    int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */
    int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */
    TCL_NORETURN1 void (*tcl_ExitThread) (int status); /* 294 */
    int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */
    char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 296 */
    void (*tcl_FinalizeThread) (void); /* 297 */
    void (*tcl_FinalizeNotifier) (void *clientData); /* 298 */
    void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
    Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
    Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
    const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
    void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
    int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, size_t offset, const char *msg, int flags, int *indexPtr); /* 304 */
    void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, size_t size); /* 305 */
    Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */
    void * (*tcl_InitNotifier) (void); /* 307 */
    void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */
    void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */
    void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */
    void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */
    size_t (*tcl_NumUtfChars) (const char *src, size_t length); /* 312 */
    size_t (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, size_t charsToRead, int appendFlag); /* 313 */
    void (*reserved314)(void);
    void (*reserved315)(void);
    int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */
    Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
    void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
    void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */
    int (*tcl_UniCharAtIndex) (const char *src, size_t index); /* 320 */
    int (*tcl_UniCharToLower) (int ch); /* 321 */
    int (*tcl_UniCharToTitle) (int ch); /* 322 */
    int (*tcl_UniCharToUpper) (int ch); /* 323 */
    int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
    const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 325 */
    int (*tcl_UtfCharComplete) (const char *src, size_t length); /* 326 */
    size_t (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
    const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
    const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
    const char * (*tcl_UtfNext) (const char *src); /* 330 */
    const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
    int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
    char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 333 */
    int (*tcl_UtfToLower) (char *src); /* 334 */
    int (*tcl_UtfToTitle) (char *src); /* 335 */
    int (*tcl_UtfToUniChar) (const char *src, Tcl_UniChar *chPtr); /* 336 */
    int (*tcl_UtfToUpper) (char *src); /* 337 */
    size_t (*tcl_WriteChars) (Tcl_Channel chan, const char *src, size_t srcLen); /* 338 */
    size_t (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
    char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
    void (*reserved341)(void);
    void (*reserved342)(void);
    void (*tcl_AlertNotifier) (void *clientData); /* 343 */
    void (*tcl_ServiceModeHook) (int mode); /* 344 */
    int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
    int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
    int (*tcl_UniCharIsDigit) (int ch); /* 347 */
    int (*tcl_UniCharIsLower) (int ch); /* 348 */
    int (*tcl_UniCharIsSpace) (int ch); /* 349 */
    int (*tcl_UniCharIsUpper) (int ch); /* 350 */
    int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
    size_t (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */
    int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 353 */
    char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 354 */
    Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, size_t length, Tcl_DString *dsPtr); /* 355 */
    Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
    void (*reserved357)(void);
    void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
    void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, size_t length); /* 359 */
    int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */
    int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, size_t numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
    int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr); /* 362 */
    int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */
    int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
    char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */
    int (*tcl_Chdir) (const char *dirName); /* 366 */
    int (*tcl_Access) (const char *path, int mode); /* 367 */
    int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */
    int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */
    int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */
    int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */
    int (*tcl_UniCharIsControl) (int ch); /* 372 */
    int (*tcl_UniCharIsGraph) (int ch); /* 373 */
    int (*tcl_UniCharIsPrint) (int ch); /* 374 */
    int (*tcl_UniCharIsPunct) (int ch); /* 375 */
    int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, size_t offset, size_t nmatches, int flags); /* 376 */
    void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */
    Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, size_t numChars); /* 378 */
    void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); /* 379 */
    size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
    int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t index); /* 381 */
    void (*reserved382)(void);
    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 383 */
    void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 384 */
    int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
    void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */
    Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
    int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
    int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */
    int (*tcl_ProcObjCmd) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */
    void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
    void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
    int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, size_t stackSize, int flags); /* 393 */
    size_t (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, size_t bytesToRead); /* 394 */
    size_t (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, size_t srcLen); /* 395 */
    Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
    int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
    const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
    Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
    Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
    int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result); /* 412 */
    int (*tcl_IsChannelShared) (Tcl_Channel channel); /* 413 */
    int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */
    void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */
    void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */
    void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */
    int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */
    int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */
    int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */
    void (*reserved421)(void);
    void (*reserved422)(void);
    void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
    void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
    ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */
    int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */
    void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */
    char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */
    char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */
    char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */
    char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */
    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
    void (*reserved435)(void);
    void (*reserved436)(void);
    Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
    int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
    int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */







|





|
|
|
|
|
|
|
|







2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
    int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result); /* 412 */
    int (*tcl_IsChannelShared) (Tcl_Channel channel); /* 413 */
    int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */
    void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */
    void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */
    void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */
    int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */
    int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 419 */
    int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */
    void (*reserved421)(void);
    void (*reserved422)(void);
    void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
    void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
    void * (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, void *prevClientData); /* 425 */
    int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 426 */
    void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */
    void * (*tcl_AttemptAlloc) (size_t size); /* 428 */
    void * (*tcl_AttemptDbCkalloc) (size_t size, const char *file, int line); /* 429 */
    void * (*tcl_AttemptRealloc) (void *ptr, size_t size); /* 430 */
    void * (*tcl_AttemptDbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 431 */
    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, size_t length); /* 432 */
    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
    void (*reserved435)(void);
    void (*reserved436)(void);
    Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
    int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
    int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
    int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */
    int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */
    Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, int elements); /* 460 */
    Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */
    int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */
    Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */
    Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 464 */
    ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */
    Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */
    int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */
    Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */
    const void * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */
    Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */
    Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */
    Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */
    int (*tcl_FSRegister) (ClientData clientData, const Tcl_Filesystem *fsPtr); /* 473 */
    int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */
    ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */
    const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
    const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
    Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */
    int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
    void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */
    int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 481 */
    void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */
    Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */
    int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */
    int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */
    Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */
    int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 487 */
    Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */
    void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 489 */
    Tcl_StatBuf * (*tcl_AllocStatBuf) (void); /* 490 */







|


|




|

|





|

|







2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
    int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */
    int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */
    Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, int elements); /* 460 */
    Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */
    int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */
    Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */
    Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 464 */
    void * (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */
    Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */
    int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */
    Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, void *clientData); /* 468 */
    const void * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */
    Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */
    Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */
    Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */
    int (*tcl_FSRegister) (void *clientData, const Tcl_Filesystem *fsPtr); /* 473 */
    int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */
    void * (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */
    const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
    const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
    Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */
    int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
    void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */
    int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, size_t count); /* 481 */
    void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */
    Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */
    int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */
    int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */
    Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */
    int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 487 */
    Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */
    void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 489 */
    Tcl_StatBuf * (*tcl_AllocStatBuf) (void); /* 490 */
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
    void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */
    void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */
    int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 501 */
    int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv); /* 502 */
    Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */
    Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line); /* 504 */
    void (*tcl_RegisterConfig) (Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 505 */
    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */
    void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 507 */
    int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 508 */
    int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 509 */
    int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 510 */
    int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 511 */
    Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 512 */
    Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 513 */
    Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 514 */
    Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 515 */
    Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */
    void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */
    int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */
    Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */
    void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */
    void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */
    int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */
    int (*tcl_LimitCheck) (Tcl_Interp *interp); /* 523 */
    int (*tcl_LimitExceeded) (Tcl_Interp *interp); /* 524 */
    void (*tcl_LimitSetCommands) (Tcl_Interp *interp, int commandLimit); /* 525 */
    void (*tcl_LimitSetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 526 */
    void (*tcl_LimitSetGranularity) (Tcl_Interp *interp, int type, int granularity); /* 527 */
    int (*tcl_LimitTypeEnabled) (Tcl_Interp *interp, int type); /* 528 */







|













|
|







2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
    void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */
    void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */
    int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 501 */
    int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv); /* 502 */
    Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */
    Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line); /* 504 */
    void (*tcl_RegisterConfig) (Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 505 */
    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, void *clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */
    void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 507 */
    int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 508 */
    int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 509 */
    int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 510 */
    int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 511 */
    Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 512 */
    Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 513 */
    Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 514 */
    Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 515 */
    Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */
    void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */
    int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */
    Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */
    void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */
    void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData); /* 521 */
    int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */
    int (*tcl_LimitCheck) (Tcl_Interp *interp); /* 523 */
    int (*tcl_LimitExceeded) (Tcl_Interp *interp); /* 524 */
    void (*tcl_LimitSetCommands) (Tcl_Interp *interp, int commandLimit); /* 525 */
    void (*tcl_LimitSetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 526 */
    void (*tcl_LimitSetGranularity) (Tcl_Interp *interp, int type, int granularity); /* 527 */
    int (*tcl_LimitTypeEnabled) (Tcl_Interp *interp, int type); /* 528 */
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
    int (*tcl_SetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList); /* 545 */
    int (*tcl_SetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int flags); /* 546 */
    int (*tcl_GetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr); /* 547 */
    int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 548 */
    int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */
    int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */
    int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */
    void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 552 */
    void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 553 */
    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */
    Tcl_Obj * (*tcl_NewBignumObj) (mp_int *value); /* 555 */
    Tcl_Obj * (*tcl_DbNewBignumObj) (mp_int *value, const char *file, int line); /* 556 */
    void (*tcl_SetBignumObj) (Tcl_Obj *obj, mp_int *value); /* 557 */
    int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 558 */
    int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 559 */
    int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */







|
|







2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
    int (*tcl_SetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList); /* 545 */
    int (*tcl_SetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int flags); /* 546 */
    int (*tcl_GetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr); /* 547 */
    int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 548 */
    int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */
    int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */
    int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */
    void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, void *clientData); /* 552 */
    void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 553 */
    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */
    Tcl_Obj * (*tcl_NewBignumObj) (mp_int *value); /* 555 */
    Tcl_Obj * (*tcl_DbNewBignumObj) (mp_int *value, const char *file, int line); /* 556 */
    void (*tcl_SetBignumObj) (Tcl_Obj *obj, mp_int *value); /* 557 */
    int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 558 */
    int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 559 */
    int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
    int (*tcl_SetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 568 */
    int (*tcl_GetEncodingFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 569 */
    Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */
    int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */
    const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */
    int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 573 */
    void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */
    void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis); /* 575 */
    Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 576 */
    int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */
    Tcl_Obj * (*tcl_ObjPrintf) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 578 */
    void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 579 */
    int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 580 */
    int (*tcl_Canceled) (Tcl_Interp *interp, int flags); /* 581 */
    int (*tcl_CreatePipe) (Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 582 */
    Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */
    int (*tcl_NREvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 584 */
    int (*tcl_NREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 585 */
    int (*tcl_NRCmdSwap) (Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 586 */
    void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 587 */
    int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 588 */
    unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */
    unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */
    unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */
    int (*tcl_GetLinkCountFromStat) (const Tcl_StatBuf *statPtr); /* 592 */
    int (*tcl_GetUserIdFromStat) (const Tcl_StatBuf *statPtr); /* 593 */
    int (*tcl_GetGroupIdFromStat) (const Tcl_StatBuf *statPtr); /* 594 */
    int (*tcl_GetDeviceTypeFromStat) (const Tcl_StatBuf *statPtr); /* 595 */







|




|


|



|
|







2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
    int (*tcl_SetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 568 */
    int (*tcl_GetEncodingFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 569 */
    Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */
    int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */
    const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */
    int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 573 */
    void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */
    void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, size_t length, size_t limit, const char *ellipsis); /* 575 */
    Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 576 */
    int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */
    Tcl_Obj * (*tcl_ObjPrintf) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 578 */
    void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 579 */
    int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, void *clientData, int flags); /* 580 */
    int (*tcl_Canceled) (Tcl_Interp *interp, int flags); /* 581 */
    int (*tcl_CreatePipe) (Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 582 */
    Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */
    int (*tcl_NREvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 584 */
    int (*tcl_NREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 585 */
    int (*tcl_NRCmdSwap) (Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 586 */
    void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, void *data0, void *data1, void *data2, void *data3); /* 587 */
    int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, void *clientData, int objc, Tcl_Obj *const objv[]); /* 588 */
    unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */
    unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */
    unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */
    int (*tcl_GetLinkCountFromStat) (const Tcl_StatBuf *statPtr); /* 592 */
    int (*tcl_GetUserIdFromStat) (const Tcl_StatBuf *statPtr); /* 593 */
    int (*tcl_GetGroupIdFromStat) (const Tcl_StatBuf *statPtr); /* 594 */
    int (*tcl_GetDeviceTypeFromStat) (const Tcl_StatBuf *statPtr); /* 595 */
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392




2393
2394
2395
2396
2397
2398
2399
    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
    int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */
    void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */
    void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp); /* 607 */
    int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */
    void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */
    int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */
    int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */
    unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, int len); /* 612 */
    unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, int len); /* 613 */
    int (*tcl_ZlibStreamInit) (Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 614 */
    Tcl_Obj * (*tcl_ZlibStreamGetCommandName) (Tcl_ZlibStream zshandle); /* 615 */
    int (*tcl_ZlibStreamEof) (Tcl_ZlibStream zshandle); /* 616 */
    int (*tcl_ZlibStreamChecksum) (Tcl_ZlibStream zshandle); /* 617 */
    int (*tcl_ZlibStreamPut) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 618 */
    int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int count); /* 619 */
    int (*tcl_ZlibStreamClose) (Tcl_ZlibStream zshandle); /* 620 */
    int (*tcl_ZlibStreamReset) (Tcl_ZlibStream zshandle); /* 621 */
    void (*tcl_SetStartupScript) (Tcl_Obj *path, const char *encoding); /* 622 */
    Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingPtr); /* 623 */
    int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
    int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
    int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
    int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
    void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
    Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */




} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif







|
|
|





|











|
>
>
>
>







2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
    int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */
    void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */
    void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp); /* 607 */
    int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */
    void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */
    int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */
    int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, size_t buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */
    unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, size_t len); /* 612 */
    unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, size_t len); /* 613 */
    int (*tcl_ZlibStreamInit) (Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 614 */
    Tcl_Obj * (*tcl_ZlibStreamGetCommandName) (Tcl_ZlibStream zshandle); /* 615 */
    int (*tcl_ZlibStreamEof) (Tcl_ZlibStream zshandle); /* 616 */
    int (*tcl_ZlibStreamChecksum) (Tcl_ZlibStream zshandle); /* 617 */
    int (*tcl_ZlibStreamPut) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 618 */
    int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, size_t count); /* 619 */
    int (*tcl_ZlibStreamClose) (Tcl_ZlibStream zshandle); /* 620 */
    int (*tcl_ZlibStreamReset) (Tcl_ZlibStream zshandle); /* 621 */
    void (*tcl_SetStartupScript) (Tcl_Obj *path, const char *encoding); /* 622 */
    Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingPtr); /* 623 */
    int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
    int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
    int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
    int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
    void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
    Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 631 */
    int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
    int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
    Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
    int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
3631
3632
3633
3634
3635
3636
3637








3638
3639
3640
3641
3642
3643
3644
	(tclStubsPtr->tcl_FindSymbol) /* 628 */
#define Tcl_FSUnloadFile \
	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
#define Tcl_ZlibStreamSetCompressionDictionary \
	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
#define Tcl_OpenTcpServerEx \
	(tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */









#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp







>
>
>
>
>
>
>
>







3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
	(tclStubsPtr->tcl_FindSymbol) /* 628 */
#define Tcl_FSUnloadFile \
	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
#define Tcl_ZlibStreamSetCompressionDictionary \
	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
#define Tcl_OpenTcpServerEx \
	(tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */
#define TclZipfs_Mount \
	(tclStubsPtr->tclZipfs_Mount) /* 632 */
#define TclZipfs_Unmount \
	(tclStubsPtr->tclZipfs_Unmount) /* 633 */
#define TclZipfs_TclLibrary \
	(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
#define TclZipfs_MountBuffer \
	(tclStubsPtr->tclZipfs_MountBuffer) /* 635 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp
3655
3656
3657
3658
3659
3660
3661

3662
3663
3664
3665
3666
3667
3668
#   define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
	    (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags))
#endif

#if defined(_WIN32) && defined(UNICODE)
#   define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#   define Tcl_MainEx Tcl_MainExW

#endif

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#define Tcl_PkgPresent(interp, name, version, exact) \
	Tcl_PkgPresentEx(interp, name, version, exact, NULL)







>







3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
#   define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
	    (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags))
#endif

#if defined(_WIN32) && defined(UNICODE)
#   define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#   define Tcl_MainEx Tcl_MainExW
	TCLAPI int		TclZipfs_AppHook(int *argc, wchar_t ***argv);
#endif

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#define Tcl_PkgPresent(interp, name, version, exact) \
	Tcl_PkgPresentEx(interp, name, version, exact, NULL)
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
#define Tcl_SetResult(interp, result, freeProc) \
	do { \
	    char *__result = result; \
	    Tcl_FreeProc *__freeProc = freeProc; \
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
	    if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
		if (__freeProc == TCL_DYNAMIC) { \
		    ckfree(__result); \
		} else { \
		    (*__freeProc)(__result); \
		} \
	    } \
	} while(0)

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)







|







3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
#define Tcl_SetResult(interp, result, freeProc) \
	do { \
	    char *__result = result; \
	    Tcl_FreeProc *__freeProc = freeProc; \
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
	    if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
		if (__freeProc == TCL_DYNAMIC) { \
		    Tcl_Free(__result); \
		} else { \
		    (*__freeProc)(__result); \
		} \
	    } \
	} while(0)

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
3755
3756
3757
3758
3759
3760
3761


















3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777




































3778
	    int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue);
	    if (result == TCL_OK) *ptr = (long)intValue;
	    return result;
	}
#   endif
#endif



















#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (int)(value))
#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (long)(value))
#define Tcl_GetUnicode(objPtr)	Tcl_GetUnicodeFromObj((objPtr), NULL)

/*
 * Deprecated Tcl procedures:
 */

#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)
#define Tcl_GlobalEvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)





































#endif /* _TCLDECLS */







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
	    int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue);
	    if (result == TCL_OK) *ptr = (long)intValue;
	    return result;
	}
#   endif
#endif

#ifdef TCL_MEM_DEBUG
#   undef Tcl_Alloc
#   define Tcl_Alloc(x) \
    (Tcl_DbCkalloc((x), __FILE__, __LINE__))
#   undef Tcl_Free
#   define Tcl_Free(x) \
    Tcl_DbCkfree((x), __FILE__, __LINE__)
#   undef Tcl_Realloc
#   define Tcl_Realloc(x,y) \
    (Tcl_DbCkrealloc((x), (y), __FILE__, __LINE__))
#   undef Tcl_AttemptAlloc
#   define Tcl_AttemptAlloc(x) \
    (Tcl_AttemptDbCkalloc((x), __FILE__, __LINE__))
#   undef Tcl_AttemptRealloc
#   define Tcl_AttemptRealloc(x,y) \
    (Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__))
#endif /* !TCL_MEM_DEBUG */

#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (int)(value))
#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (long)(value))
#define Tcl_GetUnicode(objPtr)	Tcl_GetUnicodeFromObj((objPtr), NULL)

/*
 * Deprecated Tcl procedures:
 */

#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)
#define Tcl_GlobalEvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)

#if defined(TCL_8_COMPAT) && !defined(BUILD_tcl)
#   ifdef USE_TCL_STUBS
#	undef Tcl_Gets
#	undef Tcl_GetsObj
#	undef Tcl_Read
#	undef Tcl_Ungets
#	undef Tcl_Write
#	undef Tcl_ReadChars
#	undef Tcl_WriteChars
#	undef Tcl_WriteObj
#	undef Tcl_ReadRaw
#	undef Tcl_WriteRaw
#	define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_Gets)(chan, dsPtr)+1))-1)
#	define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_GetsObj)(chan, objPtr)+1))-1)
#	define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((tclStubsPtr->tcl_Read)(chan, bufPtr, toRead)+1))-1)
#	define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((tclStubsPtr->tcl_Ungets)(chan, str, len, atHead)+1))-1)
#	define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((tclStubsPtr->tcl_Write)(chan, s, slen)+1))-1)
#	define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1)
#	define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteChars)(chan, src, srcLen)+1))-1)
#	define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteObj)(chan, objPtr)+1))-1)
#	define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1)
#	define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteRaw()(chan, src, srcLen)+1))-1)
#   else
#	define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((Tcl_Gets)(chan, dsPtr)+1))-1)
#	define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((Tcl_GetsObj)(chan, objPtr)+1))-1)
#	define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((Tcl_Read)(chan, bufPtr, toRead)+1))-1)
#	define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((Tcl_Ungets)(chan, str, len, atHead)+1))-1)
#	define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((Tcl_Write)(chan, s, slen)+1))-1)
#	define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((Tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1)
#	define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteChars)(chan, src, srcLen)+1))-1)
#	define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((Tcl_WriteObj)(chan, objPtr)+1))-1)
#	define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((Tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1)
#	define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteRaw()(chan, src, srcLen)+1))-1)
#   endif
#endif

#endif /* _TCLDECLS */
Changes to generic/tclDictObj.c.
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
static int		DictWithCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static void		DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void		FreeDictInternalRep(Tcl_Obj *dictPtr);
static void		InvalidateDictChain(Tcl_Obj *dictObj);
static int		SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfDict(Tcl_Obj *dictPtr);
static Tcl_HashEntry *	AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr);
static inline void	InitChainTable(struct Dict *dict);
static inline void	DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
			    Tcl_Obj *keyPtr, int *newPtr);
static inline int	DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
static Tcl_NRPostProc	FinalizeDictUpdate;
static Tcl_NRPostProc	FinalizeDictWith;







|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
static int		DictWithCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static void		DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void		FreeDictInternalRep(Tcl_Obj *dictPtr);
static void		InvalidateDictChain(Tcl_Obj *dictObj);
static int		SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfDict(Tcl_Obj *dictPtr);
static Tcl_HashEntry *	AllocChainEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static inline void	InitChainTable(struct Dict *dict);
static inline void	DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
			    Tcl_Obj *keyPtr, int *newPtr);
static inline int	DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
static Tcl_NRPostProc	FinalizeDictUpdate;
static Tcl_NRPostProc	FinalizeDictWith;
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
				 * dictionary. Used for doing traversal of the
				 * entries in the order that they are
				 * created. */
    ChainEntry *entryChainTail;	/* Other end of linked list of all entries in
				 * the dictionary. Used for doing traversal of
				 * the entries in the order that they are
				 * created. */
    unsigned int epoch; 	/* Epoch counter */
    size_t refCount;		/* Reference counter (see above) */
    Tcl_Obj *chain;		/* Linked list used for invalidating the
				 * string representations of updated nested
				 * dictionaries. */
} Dict;

/*







|







137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
				 * dictionary. Used for doing traversal of the
				 * entries in the order that they are
				 * created. */
    ChainEntry *entryChainTail;	/* Other end of linked list of all entries in
				 * the dictionary. Used for doing traversal of
				 * the entries in the order that they are
				 * created. */
    size_t epoch;		/* Epoch counter */
    size_t refCount;		/* Reference counter (see above) */
    Tcl_Obj *chain;		/* Linked list used for invalidating the
				 * string representations of updated nested
				 * dictionaries. */
} Dict;

/*
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
 */

static Tcl_HashEntry *
AllocChainEntry(
    Tcl_HashTable *tablePtr,
    void *keyPtr)
{
    Tcl_Obj *objPtr = keyPtr;
    ChainEntry *cPtr;

    cPtr = ckalloc(sizeof(ChainEntry));
    cPtr->entry.key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    Tcl_SetHashValue(&cPtr->entry, NULL);
    cPtr->prevPtr = cPtr->nextPtr = NULL;

    return &cPtr->entry;
}







|


|







225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
 */

static Tcl_HashEntry *
AllocChainEntry(
    Tcl_HashTable *tablePtr,
    void *keyPtr)
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    ChainEntry *cPtr;

    cPtr = Tcl_Alloc(sizeof(ChainEntry));
    cPtr->entry.key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    Tcl_SetHashValue(&cPtr->entry, NULL);
    cPtr->prevPtr = cPtr->nextPtr = NULL;

    return &cPtr->entry;
}
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374

static void
DupDictInternalRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    Dict *oldDict = DICT(srcPtr);
    Dict *newDict = ckalloc(sizeof(Dict));
    ChainEntry *cPtr;

    /*
     * Copy values across from the old hash table.
     */

    InitChainTable(newDict);







|







360
361
362
363
364
365
366
367
368
369
370
371
372
373
374

static void
DupDictInternalRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    Dict *oldDict = DICT(srcPtr);
    Dict *newDict = Tcl_Alloc(sizeof(Dict));
    ChainEntry *cPtr;

    /*
     * Copy values across from the old hash table.
     */

    InitChainTable(newDict);
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
 */

static void
DeleteDict(
    Dict *dict)
{
    DeleteChainTable(dict);
    ckfree(dict);
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfDict --
 *







|







454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
 */

static void
DeleteDict(
    Dict *dict)
{
    DeleteChainTable(dict);
    Tcl_Free(dict);
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfDict --
 *
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530

531
532
533
534
535
536
537
538

539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559

560
561
562
563
564
565

566
567
568
569
570
571
572
573
574
575
576
577
578
579
    Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Dict *dict = DICT(dictPtr);
    ChainEntry *cPtr;
    Tcl_Obj *keyPtr, *valuePtr;
    int i, length, bytesNeeded = 0;
    const char *elem;
    char *dst;

    /*
     * This field is the most useful one in the whole hash structure, and it
     * is not exposed by any API function...
     */

    int numElems = dict->table.numEntries * 2;

    /* Handle empty list case first, simplifies what follows */
    if (numElems == 0) {
	dictPtr->bytes = &tclEmptyString;
	dictPtr->length = 0;
	return;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = ckalloc(numElems);
    }
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	/*
	 * Assume that cPtr is never NULL since we know the number of array
	 * elements already.
	 */

	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);

	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}

	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);

	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    }
    if (bytesNeeded > INT_MAX - numElems + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    dictPtr->length = bytesNeeded - 1;
    dictPtr->bytes = ckalloc(bytesNeeded);
    dst = dictPtr->bytes;
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);

	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);

	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    dictPtr->bytes[dictPtr->length] = '\0';

    if (flagPtr != localFlags) {
	ckfree(flagPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SetDictFromAny --







|








|















|









|
>

<
<
<
<


|
>

<
<
<
<
<
<








|




|
>





|
>






|







488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532




533
534
535
536
537






538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
    Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Dict *dict = DICT(dictPtr);
    ChainEntry *cPtr;
    Tcl_Obj *keyPtr, *valuePtr;
    size_t i, length, bytesNeeded = 0;
    const char *elem;
    char *dst;

    /*
     * This field is the most useful one in the whole hash structure, and it
     * is not exposed by any API function...
     */

    size_t numElems = dict->table.numEntries * 2;

    /* Handle empty list case first, simplifies what follows */
    if (numElems == 0) {
	dictPtr->bytes = &tclEmptyString;
	dictPtr->length = 0;
	return;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = Tcl_Alloc(numElems);
    }
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	/*
	 * Assume that cPtr is never NULL since we know the number of array
	 * elements already.
	 */

	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetString(keyPtr);
	length = keyPtr->length;
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);




	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetString(valuePtr);
	length = valuePtr->length;
	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);






    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    dictPtr->length = bytesNeeded - 1;
    dictPtr->bytes = Tcl_Alloc(bytesNeeded);
    dst = dictPtr->bytes;
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetString(keyPtr);
	length = keyPtr->length;
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetString(valuePtr);
	length = valuePtr->length;
	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    dictPtr->bytes[dictPtr->length] = '\0';

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SetDictFromAny --
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
static int
SetDictFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Tcl_HashEntry *hPtr;
    int isNew;
    Dict *dict = ckalloc(sizeof(Dict));

    InitChainTable(dict);

    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.







|







590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
static int
SetDictFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Tcl_HashEntry *hPtr;
    int isNew;
    Dict *dict = Tcl_Alloc(sizeof(Dict));

    InitChainTable(dict);

    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.
644
645
646
647
648
649
650

651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
	int length;
	const char *nextElem = TclGetStringFromObj(objPtr, &length);
	const char *limit = (nextElem + length);

	while (nextElem < limit) {
	    Tcl_Obj *keyPtr, *valuePtr;
	    const char *elemStart;

	    int elemSize, literal;

	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
		goto errorInFindDictElement;
	    }
	    if (elemStart == limit) {
		break;
	    }
	    if (nextElem == limit) {
		goto missingValue;
	    }

	    if (literal) {
		TclNewStringObj(keyPtr, elemStart, elemSize);
	    } else {
		/* Avoid double copy */
		TclNewObj(keyPtr);
		keyPtr->bytes = ckalloc((unsigned) elemSize + 1);
		keyPtr->length = TclCopyAndCollapse(elemSize, elemStart,
			keyPtr->bytes);
	    }

	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
		TclDecrRefCount(keyPtr);
		goto errorInFindDictElement;
	    }

	    if (literal) {
		TclNewStringObj(valuePtr, elemStart, elemSize);
	    } else {
		/* Avoid double copy */
		TclNewObj(valuePtr);
		valuePtr->bytes = ckalloc((unsigned) elemSize + 1);
		valuePtr->length = TclCopyAndCollapse(elemSize, elemStart,
			valuePtr->bytes);
	    }

	    /* Store key and value in the hash table we're building. */
	    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
	    if (!isNew) {







>
|

















|















|







638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
	int length;
	const char *nextElem = TclGetStringFromObj(objPtr, &length);
	const char *limit = (nextElem + length);

	while (nextElem < limit) {
	    Tcl_Obj *keyPtr, *valuePtr;
	    const char *elemStart;
	    size_t elemSize;
	    int literal;

	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
		goto errorInFindDictElement;
	    }
	    if (elemStart == limit) {
		break;
	    }
	    if (nextElem == limit) {
		goto missingValue;
	    }

	    if (literal) {
		TclNewStringObj(keyPtr, elemStart, elemSize);
	    } else {
		/* Avoid double copy */
		TclNewObj(keyPtr);
		keyPtr->bytes = Tcl_Alloc((unsigned) elemSize + 1);
		keyPtr->length = TclCopyAndCollapse(elemSize, elemStart,
			keyPtr->bytes);
	    }

	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
		TclDecrRefCount(keyPtr);
		goto errorInFindDictElement;
	    }

	    if (literal) {
		TclNewStringObj(valuePtr, elemStart, elemSize);
	    } else {
		/* Avoid double copy */
		TclNewObj(valuePtr);
		valuePtr->bytes = Tcl_Alloc((unsigned) elemSize + 1);
		valuePtr->length = TclCopyAndCollapse(elemSize, elemStart,
			valuePtr->bytes);
	    }

	    /* Store key and value in the hash table we're building. */
	    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
	    if (!isNew) {
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing value to go with key", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
    }
  errorInFindDictElement:
    DeleteChainTable(dict);
    ckfree(dict);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTraceDictPath --







|







714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing value to go with key", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
    }
  errorInFindDictElement:
    DeleteChainTable(dict);
    Tcl_Free(dict);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTraceDictPath --
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
#else /* !TCL_MEM_DEBUG */

    Tcl_Obj *dictPtr;
    Dict *dict;

    TclNewObj(dictPtr);
    TclInvalidateStringRep(dictPtr);
    dict = ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DICT(dictPtr) = dict;
    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
    dictPtr->typePtr = &tclDictType;







|







1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
#else /* !TCL_MEM_DEBUG */

    Tcl_Obj *dictPtr;
    Dict *dict;

    TclNewObj(dictPtr);
    TclInvalidateStringRep(dictPtr);
    dict = Tcl_Alloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DICT(dictPtr) = dict;
    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
    dictPtr->typePtr = &tclDictType;
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
{
#ifdef TCL_MEM_DEBUG
    Tcl_Obj *dictPtr;
    Dict *dict;

    TclDbNewObj(dictPtr, file, line);
    TclInvalidateStringRep(dictPtr);
    dict = ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DICT(dictPtr) = dict;
    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
    dictPtr->typePtr = &tclDictType;







|







1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
{
#ifdef TCL_MEM_DEBUG
    Tcl_Obj *dictPtr;
    Dict *dict;

    TclDbNewObj(dictPtr, file, line);
    TclInvalidateStringRep(dictPtr);
    dict = Tcl_Alloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DICT(dictPtr) = dict;
    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
    dictPtr->typePtr = &tclDictType;
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
	return TCL_ERROR;
    }
    dict = DICT(dictPtr);

    statsStr = Tcl_HashStats(&dict->table);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
    ckfree(statsStr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DictIncrCmd --







|







2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
	return TCL_ERROR;
    }
    dict = DICT(dictPtr);

    statsStr = Tcl_HashStats(&dict->table);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
    Tcl_Free(statsStr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DictIncrCmd --
Changes to generic/tclDisassemble.c.
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
    numCmds = codePtr->numCommands;

    /*
     * Print header lines describing the ByteCode.
     */

    Tcl_AppendPrintfToObj(bufferObj,
	    "ByteCode %p, refCt %" TCL_LL_MODIFIER "d, epoch %" TCL_LL_MODIFIER "d, interp %p (epoch %" TCL_LL_MODIFIER "d)\n",
	    codePtr, (Tcl_WideUInt)codePtr->refCount, (Tcl_WideUInt)codePtr->compileEpoch, iPtr,
		(Tcl_WideUInt)iPtr->compileEpoch);
    Tcl_AppendToObj(bufferObj, "  Source ", -1);
    PrintSourceToObj(bufferObj, codePtr->source,
	    TclMin(codePtr->numSrcBytes, 55));
    GetLocationInformation(codePtr->procPtr, &fileObj, &line);
    if (line > -1 && fileObj != NULL) {
	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
		Tcl_GetString(fileObj), line);







|
<
|







263
264
265
266
267
268
269
270

271
272
273
274
275
276
277
278
    numCmds = codePtr->numCommands;

    /*
     * Print header lines describing the ByteCode.
     */

    Tcl_AppendPrintfToObj(bufferObj,
	    "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,
	    TclMin(codePtr->numSrcBytes, 55));
    GetLocationInformation(codePtr->procPtr, &fileObj, &line);
    if (line > -1 && fileObj != NULL) {
	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
		Tcl_GetString(fileObj), line);
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
     */

    if (codePtr->procPtr != NULL) {
	Proc *procPtr = codePtr->procPtr;
	int numCompiledLocals = procPtr->numCompiledLocals;

	Tcl_AppendPrintfToObj(bufferObj,
		"  Proc %p, refCt %" TCL_LL_MODIFIER "d, args %d, compiled locals %d\n",
		procPtr, (Tcl_WideUInt)procPtr->refCount, procPtr->numArgs,
		numCompiledLocals);
	if (numCompiledLocals > 0) {
	    CompiledLocal *localPtr = procPtr->firstLocalPtr;

	    for (i = 0;  i < numCompiledLocals;  i++) {
		Tcl_AppendPrintfToObj(bufferObj,
			"      slot %d%s%s%s%s%s%s", i,







|
|







307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
     */

    if (codePtr->procPtr != NULL) {
	Proc *procPtr = codePtr->procPtr;
	int numCompiledLocals = procPtr->numCompiledLocals;

	Tcl_AppendPrintfToObj(bufferObj,
		"  Proc %p, refCt %" TCL_Z_MODIFIER "u, args %d, compiled locals %d\n",
		procPtr, procPtr->refCount, procPtr->numArgs,
		numCompiledLocals);
	if (numCompiledLocals > 0) {
	    CompiledLocal *localPtr = procPtr->firstLocalPtr;

	    for (i = 0;  i < numCompiledLocals;  i++) {
		Tcl_AppendPrintfToObj(bufferObj,
			"      slot %d%s%s%s%s%s%s", i,
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
UpdateStringOfInstName(
    Tcl_Obj *objPtr)
{
    size_t len, inst = (size_t)objPtr->internalRep.wideValue;
    char *s, buf[TCL_INTEGER_SPACE + 5];

    if (inst >= LAST_INST_OPCODE) {
        sprintf(buf, "inst_%" TCL_Z_MODIFIER "d", inst);
        s = buf;
    } else {
        s = (char *) tclInstructionTable[inst].name;
    }
    len = strlen(s);
    /* assert (len < UINT_MAX) */
    objPtr->bytes = ckalloc(len + 1);
    memcpy(objPtr->bytes, s, len + 1);
    objPtr->length = len;
}

/*
 *----------------------------------------------------------------------
 *







|






|







816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
UpdateStringOfInstName(
    Tcl_Obj *objPtr)
{
    size_t len, inst = (size_t)objPtr->internalRep.wideValue;
    char *s, buf[TCL_INTEGER_SPACE + 5];

    if (inst >= LAST_INST_OPCODE) {
        sprintf(buf, "inst_%" TCL_Z_MODIFIER "u", inst);
        s = buf;
    } else {
        s = (char *) tclInstructionTable[inst].name;
    }
    len = strlen(s);
    /* assert (len < UINT_MAX) */
    objPtr->bytes = Tcl_Alloc(len + 1);
    memcpy(objPtr->bytes, s, len + 1);
    objPtr->length = len;
}

/*
 *----------------------------------------------------------------------
 *
Changes to generic/tclEncoding.c.
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
    /*
     * 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
     * table encoding or some of the escape encodings crash! Hence the ugly
     * code to duplicate the structure of a table encoding here.
     */

    dataPtr = ckalloc(sizeof(TableEncodingData));
    memset(dataPtr, 0, sizeof(TableEncodingData));
    dataPtr->fallback = '?';

    size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
    dataPtr->toUnicode = ckalloc(size);
    memset(dataPtr->toUnicode, 0, size);
    dataPtr->fromUnicode = ckalloc(size);
    memset(dataPtr->fromUnicode, 0, size);

    dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256);
    dataPtr->fromUnicode[0] = (unsigned short *) (dataPtr->fromUnicode + 256);
    for (i=1 ; i<256 ; i++) {
	dataPtr->toUnicode[i] = emptyPage;
	dataPtr->fromUnicode[i] = emptyPage;







|




|

|







590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
    /*
     * 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
     * table encoding or some of the escape encodings crash! Hence the ugly
     * code to duplicate the structure of a table encoding here.
     */

    dataPtr = Tcl_Alloc(sizeof(TableEncodingData));
    memset(dataPtr, 0, sizeof(TableEncodingData));
    dataPtr->fallback = '?';

    size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
    dataPtr->toUnicode = Tcl_Alloc(size);
    memset(dataPtr->toUnicode, 0, size);
    dataPtr->fromUnicode = Tcl_Alloc(size);
    memset(dataPtr->fromUnicode, 0, size);

    dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256);
    dataPtr->fromUnicode[0] = (unsigned short *) (dataPtr->fromUnicode + 256);
    for (i=1 ; i<256 ; i++) {
	dataPtr->toUnicode[i] = emptyPage;
	dataPtr->fromUnicode[i] = emptyPage;
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
	if (encodingPtr->freeProc != NULL) {
	    encodingPtr->freeProc(encodingPtr->clientData);
	}
	if (encodingPtr->hPtr != NULL) {
	    Tcl_DeleteHashEntry(encodingPtr->hPtr);
	}
	if (encodingPtr->name) {
	    ckfree(encodingPtr->name);
	}
	ckfree(encodingPtr);
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncodingName --







|

|







786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
	if (encodingPtr->freeProc != NULL) {
	    encodingPtr->freeProc(encodingPtr->clientData);
	}
	if (encodingPtr->hPtr != NULL) {
	    Tcl_DeleteHashEntry(encodingPtr->hPtr);
	}
	if (encodingPtr->name) {
	    Tcl_Free(encodingPtr->name);
	}
	Tcl_Free(encodingPtr);
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncodingName --
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
 */

Tcl_Encoding
Tcl_CreateEncoding(
    const Tcl_EncodingType *typePtr)
				/* The encoding type. */
{
    Encoding *encodingPtr = ckalloc(sizeof(Encoding));
    encodingPtr->name		= NULL;
    encodingPtr->toUtfProc	= typePtr->toUtfProc;
    encodingPtr->fromUtfProc	= typePtr->fromUtfProc;
    encodingPtr->freeProc	= typePtr->freeProc;
    encodingPtr->nullSize	= typePtr->nullSize;
    encodingPtr->clientData	= typePtr->clientData;
    if (typePtr->nullSize == 1) {







|







976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
 */

Tcl_Encoding
Tcl_CreateEncoding(
    const Tcl_EncodingType *typePtr)
				/* The encoding type. */
{
    Encoding *encodingPtr = Tcl_Alloc(sizeof(Encoding));
    encodingPtr->name		= NULL;
    encodingPtr->toUtfProc	= typePtr->toUtfProc;
    encodingPtr->fromUtfProc	= typePtr->fromUtfProc;
    encodingPtr->freeProc	= typePtr->freeProc;
    encodingPtr->nullSize	= typePtr->nullSize;
    encodingPtr->clientData	= typePtr->clientData;
    if (typePtr->nullSize == 1) {
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
	 * reference goes away.
	 */

	Encoding *replaceMe = Tcl_GetHashValue(hPtr);
	replaceMe->hPtr = NULL;
    }

    name = ckalloc(strlen(typePtr->encodingName) + 1);
    encodingPtr->name		= strcpy(name, typePtr->encodingName);
    encodingPtr->hPtr		= hPtr;
    Tcl_SetHashValue(hPtr, encodingPtr);

    Tcl_MutexUnlock(&encodingMutex);
  }
    return (Tcl_Encoding) encodingPtr;







|







1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
	 * reference goes away.
	 */

	Encoding *replaceMe = Tcl_GetHashValue(hPtr);
	replaceMe->hPtr = NULL;
    }

    name = Tcl_Alloc(strlen(typePtr->encodingName) + 1);
    encodingPtr->name		= strcpy(name, typePtr->encodingName);
    encodingPtr->hPtr		= hPtr;
    Tcl_SetHashValue(hPtr, encodingPtr);

    Tcl_MutexUnlock(&encodingMutex);
  }
    return (Tcl_Encoding) encodingPtr;
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059

1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
 */

char *
Tcl_ExternalToUtfDString(
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    int srcLen,			/* Source string length in bytes, or < 0 for
				 * encoding-specific string length. */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;


    Tcl_DStringInit(dstPtr);
    dst = Tcl_DStringValue(dstPtr);
    dstLen = dstPtr->spaceAvl - 1;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen < 0) {
	srcLen = encodingPtr->lengthProc(src);
    }

    flags = TCL_ENCODING_START | TCL_ENCODING_END;

    while (1) {
	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,







|







|
>












|







1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
 */

char *
Tcl_ExternalToUtfDString(
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    size_t srcLen,		/* Source string length in bytes, or -1 for
				 * encoding-specific string length. */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int flags, result, soFar, srcRead, dstWrote, dstChars;
    size_t dstLen;

    Tcl_DStringInit(dstPtr);
    dst = Tcl_DStringValue(dstPtr);
    dstLen = dstPtr->spaceAvl - 1;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_AUTO_LENGTH) {
	srcLen = encodingPtr->lengthProc(src);
    }

    flags = TCL_ENCODING_START | TCL_ENCODING_END;

    while (1) {
	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141

int
Tcl_ExternalToUtf(
    Tcl_Interp *interp,		/* Interp for error return, if not NULL. */
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    int srcLen,			/* Source string length in bytes, or < 0 for
				 * encoding-specific string length. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were







|
|








|







1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142

int
Tcl_ExternalToUtf(
    Tcl_Interp *interp,		/* Interp for error return, if not NULL. */
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    size_t srcLen,		/* Source string length in bytes, or -1
				 * for encoding-specific string length. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    size_t dstLen,		/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen < 0) {
	srcLen = encodingPtr->lengthProc(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcReadPtr == NULL) {







|







1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_AUTO_LENGTH) {
	srcLen = encodingPtr->lengthProc(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcReadPtr == NULL) {
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249

1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
 */

char *
Tcl_UtfToExternalDString(
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes, or < 0 for
				 * strlen(). */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;


    Tcl_DStringInit(dstPtr);
    dst = Tcl_DStringValue(dstPtr);
    dstLen = dstPtr->spaceAvl - 1;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen < 0) {
	srcLen = strlen(src);
    }
    flags = TCL_ENCODING_START | TCL_ENCODING_END;
    while (1) {
	result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
		srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
		&dstChars);







|







|
>












|







1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
 */

char *
Tcl_UtfToExternalDString(
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    size_t srcLen,		/* Source string length in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int flags, result, soFar, srcRead, dstWrote, dstChars;
    size_t dstLen;

    Tcl_DStringInit(dstPtr);
    dst = Tcl_DStringValue(dstPtr);
    dstLen = dstPtr->spaceAvl - 1;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_AUTO_LENGTH) {
	srcLen = strlen(src);
    }
    flags = TCL_ENCODING_START | TCL_ENCODING_END;
    while (1) {
	result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
		srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
		&dstChars);
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333

int
Tcl_UtfToExternal(
    Tcl_Interp *interp,		/* Interp for error return, if not NULL. */
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes, or < 0 for
				 * strlen(). */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string
				 * is stored. */
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were







|
|








|







1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335

int
Tcl_UtfToExternal(
    Tcl_Interp *interp,		/* Interp for error return, if not NULL. */
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    size_t srcLen,		/* Source string length in bytes, or -1
				 * for strlen(). */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string
				 * is stored. */
    size_t dstLen,		/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen < 0) {
	srcLen = strlen(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcReadPtr == NULL) {







|







1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_AUTO_LENGTH) {
	srcLen = strlen(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcReadPtr == NULL) {
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
    }

    memset(used, 0, sizeof(used));

#undef PAGESIZE
#define PAGESIZE    (256 * sizeof(unsigned short))

    dataPtr = ckalloc(sizeof(TableEncodingData));
    memset(dataPtr, 0, sizeof(TableEncodingData));

    dataPtr->fallback = fallback;

    /*
     * Read the table that maps characters to Unicode. Performs a single
     * malloc to get the memory for the array and all the pages needed by the
     * array.
     */

    size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
    dataPtr->toUnicode = ckalloc(size);
    memset(dataPtr->toUnicode, 0, size);
    pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    for (i = 0; i < numPages; i++) {
	int ch;







|











|







1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
    }

    memset(used, 0, sizeof(used));

#undef PAGESIZE
#define PAGESIZE    (256 * sizeof(unsigned short))

    dataPtr = Tcl_Alloc(sizeof(TableEncodingData));
    memset(dataPtr, 0, sizeof(TableEncodingData));

    dataPtr->fallback = fallback;

    /*
     * Read the table that maps characters to Unicode. Performs a single
     * malloc to get the memory for the array and all the pages needed by the
     * array.
     */

    size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
    dataPtr->toUnicode = Tcl_Alloc(size);
    memset(dataPtr->toUnicode, 0, size);
    pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    for (i = 0; i < numPages; i++) {
	int ch;
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
    numPages = 0;
    for (hi = 0; hi < 256; hi++) {
	if (used[hi]) {
	    numPages++;
	}
    }
    size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
    dataPtr->fromUnicode = ckalloc(size);
    memset(dataPtr->fromUnicode, 0, size);
    pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256);

    for (hi = 0; hi < 256; hi++) {
	if (dataPtr->toUnicode[hi] == NULL) {
	    dataPtr->toUnicode[hi] = emptyPage;
	    continue;







|







1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
    numPages = 0;
    for (hi = 0; hi < 256; hi++) {
	if (used[hi]) {
	    numPages++;
	}
    }
    size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
    dataPtr->fromUnicode = Tcl_Alloc(size);
    memset(dataPtr->fromUnicode, 0, size);
    pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256);

    for (hi = 0; hi < 256; hi++) {
	if (dataPtr->toUnicode[hi] == NULL) {
	    dataPtr->toUnicode[hi] = emptyPage;
	    continue;
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
    }

    /*
     * Read lines from the encoding until EOF.
     */

    for (TclDStringClear(&lineString);
	    (len = Tcl_Gets(chan, &lineString)) >= 0;
	    TclDStringClear(&lineString)) {
	const unsigned char *p;
	int to, from;

	/*
	 * Skip short lines.
	 */







|







1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
    }

    /*
     * Read lines from the encoding until EOF.
     */

    for (TclDStringClear(&lineString);
	    (len = Tcl_Gets(chan, &lineString)) != -1;
	    TclDStringClear(&lineString)) {
	const unsigned char *p;
	int to, from;

	/*
	 * Skip short lines.
	 */
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
    while (1) {
	int argc;
	const char **argv;
	char *line;
	Tcl_DString lineString;

	Tcl_DStringInit(&lineString);
	if (Tcl_Gets(chan, &lineString) < 0) {
	    break;
	}
	line = Tcl_DStringValue(&lineString);
	if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
	    Tcl_DStringFree(&lineString);
	    continue;
	}







|







1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
    while (1) {
	int argc;
	const char **argv;
	char *line;
	Tcl_DString lineString;

	Tcl_DStringInit(&lineString);
	if (Tcl_Gets(chan, &lineString) == TCL_IO_FAILURE) {
	    break;
	}
	line = Tcl_DStringValue(&lineString);
	if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
	    Tcl_DStringFree(&lineString);
	    continue;
	}
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
		   Tcl_FreeEncoding((Tcl_Encoding) e);
		   e = NULL;
		}
		est.encodingPtr = e;
		Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
	    }
	}
	ckfree(argv);
	Tcl_DStringFree(&lineString);
    }

    size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
	    + Tcl_DStringLength(&escapeData);
    dataPtr = ckalloc(size);
    dataPtr->initLen = strlen(init);
    memcpy(dataPtr->init, init, (unsigned) dataPtr->initLen + 1);
    dataPtr->finalLen = strlen(final);
    memcpy(dataPtr->final, final, (unsigned) dataPtr->finalLen + 1);
    dataPtr->numSubTables =
	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
	    (size_t) Tcl_DStringLength(&escapeData));
    Tcl_DStringFree(&escapeData);

    memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));
    for (i = 0; i < dataPtr->numSubTables; i++) {
	dataPtr->prefixBytes[UCHAR(dataPtr->subTables[i].sequence[0])] = 1;
    }
    if (dataPtr->init[0] != '\0') {







|





|







|







1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
		   Tcl_FreeEncoding((Tcl_Encoding) e);
		   e = NULL;
		}
		est.encodingPtr = e;
		Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
	    }
	}
	Tcl_Free(argv);
	Tcl_DStringFree(&lineString);
    }

    size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
	    + Tcl_DStringLength(&escapeData);
    dataPtr = Tcl_Alloc(size);
    dataPtr->initLen = strlen(init);
    memcpy(dataPtr->init, init, (unsigned) dataPtr->initLen + 1);
    dataPtr->finalLen = strlen(final);
    memcpy(dataPtr->final, final, (unsigned) dataPtr->finalLen + 1);
    dataPtr->numSubTables =
	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
	    Tcl_DStringLength(&escapeData));
    Tcl_DStringFree(&escapeData);

    memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));
    for (i = 0; i < dataPtr->numSubTables; i++) {
	dataPtr->prefixBytes[UCHAR(dataPtr->subTables[i].sequence[0])] = 1;
    }
    if (dataPtr->init[0] != '\0') {
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
{
    TableEncodingData *dataPtr = clientData;

    /*
     * Make sure we aren't freeing twice on shutdown. [Bug 219314]
     */

    ckfree(dataPtr->toUnicode);
    dataPtr->toUnicode = NULL;
    ckfree(dataPtr->fromUnicode);
    dataPtr->fromUnicode = NULL;
    ckfree(dataPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * EscapeToUtfProc --
 *







|

|

|







2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
{
    TableEncodingData *dataPtr = clientData;

    /*
     * Make sure we aren't freeing twice on shutdown. [Bug 219314]
     */

    Tcl_Free(dataPtr->toUnicode);
    dataPtr->toUnicode = NULL;
    Tcl_Free(dataPtr->fromUnicode);
    dataPtr->fromUnicode = NULL;
    Tcl_Free(dataPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * EscapeToUtfProc --
 *
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
	subTablePtr = dataPtr->subTables;
	for (i = 0; i < dataPtr->numSubTables; i++) {
	    FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
	    subTablePtr->encodingPtr = NULL;
	    subTablePtr++;
	}
    }
    ckfree(dataPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * GetTableEncoding --
 *







|







3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
	subTablePtr = dataPtr->subTables;
	for (i = 0; i < dataPtr->numSubTables; i++) {
	    FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
	    subTablePtr->encodingPtr = NULL;
	    subTablePtr++;
	}
    }
    Tcl_Free(dataPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * GetTableEncoding --
 *
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
    *encodingPtr = libraryPath.encoding;
    if (*encodingPtr) {
	((Encoding *)(*encodingPtr))->refCount++;
    }
    bytes = TclGetString(searchPathObj);

    *lengthPtr = searchPathObj->length;
    *valuePtr = ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, bytes, *lengthPtr + 1);
    Tcl_DecrRefCount(searchPathObj);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|











3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
    *encodingPtr = libraryPath.encoding;
    if (*encodingPtr) {
	((Encoding *)(*encodingPtr))->refCount++;
    }
    bytes = TclGetString(searchPathObj);

    *lengthPtr = searchPathObj->length;
    *valuePtr = Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, bytes, *lengthPtr + 1);
    Tcl_DecrRefCount(searchPathObj);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclEnsemble.c.
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 * Declarations for functions local to this file:
 */

static inline Tcl_Obj *	NewNsObj(Tcl_Namespace *namespacePtr);
static inline int	EnsembleUnknownCallback(Tcl_Interp *interp,
			    EnsembleConfig *ensemblePtr, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);
static int		NsEnsembleImplementationCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NsEnsembleImplementationCmdNR(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static void		BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
static int		NsEnsembleStringOrder(const void *strPtr1,
			    const void *strPtr2);
static void		DeleteEnsembleConfig(ClientData clientData);
static void		MakeCachedEnsembleCommand(Tcl_Obj *objPtr,







<
<







17
18
19
20
21
22
23


24
25
26
27
28
29
30
 * Declarations for functions local to this file:
 */

static inline Tcl_Obj *	NewNsObj(Tcl_Namespace *namespacePtr);
static inline int	EnsembleUnknownCallback(Tcl_Interp *interp,
			    EnsembleConfig *ensemblePtr, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);


static int		NsEnsembleImplementationCmdNR(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static void		BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
static int		NsEnsembleStringOrder(const void *strPtr1,
			    const void *strPtr2);
static void		DeleteEnsembleConfig(ClientData clientData);
static void		MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
				/* Name of the namespace for the ensemble. */
    int flags)
{
    Namespace *nsPtr = (Namespace *) ensembleNsPtr;
    EnsembleConfig *ensemblePtr;
    Tcl_Command token;

    ensemblePtr = ckalloc(sizeof(EnsembleConfig));
    token = TclNRCreateCommandInNs(interp, name,
	    (Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
	    NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
    if (token == NULL) {
	ckfree(ensemblePtr);
	return NULL;
    }

    ensemblePtr->nsPtr = nsPtr;
    ensemblePtr->epoch = 0;
    Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS);
    ensemblePtr->subcommandArrayPtr = NULL;







|

|


|







656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
				/* Name of the namespace for the ensemble. */
    int flags)
{
    Namespace *nsPtr = (Namespace *) ensembleNsPtr;
    EnsembleConfig *ensemblePtr;
    Tcl_Command token;

    ensemblePtr = Tcl_Alloc(sizeof(EnsembleConfig));
    token = TclNRCreateCommandInNs(interp, name,
	    (Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd,
	    NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
    if (token == NULL) {
	Tcl_Free(ensemblePtr);
	return NULL;
    }

    ensemblePtr->nsPtr = nsPtr;
    ensemblePtr->epoch = 0;
    Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS);
    ensemblePtr->subcommandArrayPtr = NULL;
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
    Tcl_Command token,
    Tcl_Obj *subcmdList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (subcmdList != NULL) {
	int length;







|







762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
    Tcl_Command token,
    Tcl_Obj *subcmdList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (subcmdList != NULL) {
	int length;
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
    Tcl_Obj *paramList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;
    int length;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (paramList == NULL) {
	length = 0;







|







838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
    Tcl_Obj *paramList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;
    int length;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (paramList == NULL) {
	length = 0;
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
    Tcl_Command token,
    Tcl_Obj *mapDict)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldDict;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (mapDict != NULL) {
	int size, done;







|







914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
    Tcl_Command token,
    Tcl_Obj *mapDict)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldDict;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (mapDict != NULL) {
	int size, done;
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
    Tcl_Command token,
    Tcl_Obj *unknownList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (unknownList != NULL) {
	int length;







|







1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
    Tcl_Command token,
    Tcl_Obj *unknownList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (unknownList != NULL) {
	int length;
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
    Tcl_Command token,
    int flags)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    int wasCompiled;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;







|







1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
    Tcl_Command token,
    int flags)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    int wasCompiled;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **subcmdListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }







|







1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **subcmdListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **paramListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }







|







1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **paramListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **mapDictPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }







|







1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **mapDictPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **unknownListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }







|







1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **unknownListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
    Tcl_Interp *interp,
    Tcl_Command token,
    int *flagsPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }







|







1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
    Tcl_Interp *interp,
    Tcl_Command token,
    int *flagsPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Namespace **namespacePtrPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }







|







1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Namespace **namespacePtrPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429

1430
1431
1432
1433
1434
1435
1436

    cmdPtr = (Command *)
	    Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
    if (cmdPtr == NULL) {
	return NULL;
    }

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	/*
	 * Reuse existing infrastructure for following import link chains
	 * rather than duplicating it.
	 */

	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);

	if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){

	    if (flags & TCL_LEAVE_ERR_MSG) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"\"%s\" is not an ensemble command",
			TclGetString(cmdNameObj)));
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
			TclGetString(cmdNameObj), NULL);
	    }







|







|
>







1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435

    cmdPtr = (Command *)
	    Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
    if (cmdPtr == NULL) {
	return NULL;
    }

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	/*
	 * Reuse existing infrastructure for following import link chains
	 * rather than duplicating it.
	 */

	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);

	if (cmdPtr == NULL
		|| cmdPtr->objProc != TclEnsembleImplementationCmd) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"\"%s\" is not an ensemble command",
			TclGetString(cmdNameObj)));
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
			TclGetString(cmdNameObj), NULL);
	    }
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478

int
Tcl_IsEnsemble(
    Tcl_Command token)
{
    Command *cmdPtr = (Command *) token;

    if (cmdPtr->objProc == NsEnsembleImplementationCmd) {
	return 1;
    }
    cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
    if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
	return 0;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------







|



|







1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477

int
Tcl_IsEnsemble(
    Tcl_Command token)
{
    Command *cmdPtr = (Command *) token;

    if (cmdPtr->objProc == TclEnsembleImplementationCmd) {
	return 1;
    }
    cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
    if (cmdPtr == NULL || cmdPtr->objProc != TclEnsembleImplementationCmd) {
	return 0;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
	}
	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
    }

    Tcl_DStringFree(&buf);
    Tcl_DStringFree(&hiddenBuf);
    if (nameParts != NULL) {
	ckfree(nameParts);
    }
    return ensemble;
}

/*
 *----------------------------------------------------------------------
 *
 * NsEnsembleImplementationCmd --
 *
 *	Implements an ensemble of commands (being those exported by a
 *	namespace other than the global namespace) as a command with the same
 *	(short) name as the namespace in the parent namespace.
 *
 * Results:
 *	A standard Tcl result code. Will be TCL_ERROR if the command is not an
 *	unambiguous prefix of any command exported by the ensemble's
 *	namespace.
 *
 * Side effects:
 *	Depends on the command within the namespace that gets executed. If the
 *	ensemble itself returns TCL_ERROR, a descriptive error message will be
 *	placed in the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

static int
NsEnsembleImplementationCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return Tcl_NRCallObjProc(interp, NsEnsembleImplementationCmdNR,
	    clientData, objc, objv);







|







|


















|
|







1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
	}
	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
    }

    Tcl_DStringFree(&buf);
    Tcl_DStringFree(&hiddenBuf);
    if (nameParts != NULL) {
	Tcl_Free(nameParts);
    }
    return ensemble;
}

/*
 *----------------------------------------------------------------------
 *
 * TclEnsembleImplementationCmd --
 *
 *	Implements an ensemble of commands (being those exported by a
 *	namespace other than the global namespace) as a command with the same
 *	(short) name as the namespace in the parent namespace.
 *
 * Results:
 *	A standard Tcl result code. Will be TCL_ERROR if the command is not an
 *	unambiguous prefix of any command exported by the ensemble's
 *	namespace.
 *
 * Side effects:
 *	Depends on the command within the namespace that gets executed. If the
 *	ensemble itself returns TCL_ERROR, a descriptive error message will be
 *	placed in the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

int
TclEnsembleImplementationCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return Tcl_NRCallObjProc(interp, NsEnsembleImplementationCmdNR,
	    clientData, objc, objv);
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
				 * subcommand. */
    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
				 * specified but not yet cached command
				 * names. */
    int reparseCount = 0;	/* Number of reparses. */
    Tcl_Obj *errorObj;		/* Used for building error messages. */
    Tcl_Obj *subObj;
    int subIdx;

    /*
     * Must recheck objc, since numParameters might have changed. Cf. test
     * namespace-53.9.
     */

  restartEnsembleParse:
    subIdx = 1 + ensemblePtr->numParameters;
    if (objc < subIdx + 1) {
	/*
	 * We don't have a subcommand argument. Make error message.
	 */

	Tcl_DString buf;	/* Message being built */

	Tcl_DStringInit(&buf);







|








|







1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
				 * subcommand. */
    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
				 * specified but not yet cached command
				 * names. */
    int reparseCount = 0;	/* Number of reparses. */
    Tcl_Obj *errorObj;		/* Used for building error messages. */
    Tcl_Obj *subObj;
    size_t subIdx;

    /*
     * Must recheck objc, since numParameters might have changed. Cf. test
     * namespace-53.9.
     */

  restartEnsembleParse:
    subIdx = 1 + ensemblePtr->numParameters;
    if ((size_t)objc < subIdx + 1) {
	/*
	 * We don't have a subcommand argument. Make error message.
	 */

	Tcl_DString buf;	/* Message being built */

	Tcl_DStringInit(&buf);
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800

1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
	 * matches.
	 */

	const char *subcmdName; /* Name of the subcommand, or unique prefix of
				 * it (will be an error for a non-unique
				 * prefix). */
	char *fullName = NULL;	/* Full name of the subcommand. */
	int stringLength, i;
	int tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = TclGetStringFromObj(subObj, &stringLength);

	for (i=0 ; i<tableLength ; i++) {
	    register int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    (unsigned) stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
		    /*
		     * Since there's never the exact-match case to worry about
		     * (hash search filters this), getting here indicates that
		     * our subcommand is an ambiguous prefix of (at least) two







|
|


|
>



|







1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
	 * matches.
	 */

	const char *subcmdName; /* Name of the subcommand, or unique prefix of
				 * it (will be an error for a non-unique
				 * prefix). */
	char *fullName = NULL;	/* Full name of the subcommand. */
	size_t stringLength, i;
	size_t tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = TclGetString(subObj);
	stringLength = subObj->length;
	for (i=0 ; i<tableLength ; i++) {
	    register int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
		    /*
		     * Since there's never the exact-match case to worry about
		     * (hash search filters this), getting here indicates that
		     * our subcommand is an ambiguous prefix of (at least) two
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(subObj));
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
    } else {
	int i;

	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
	    Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
	    Tcl_AppendToObj(errorObj, ", ", 2);
	}
	Tcl_AppendPrintfToObj(errorObj, "or %s",
		ensemblePtr->subcommandArrayPtr[i]);







|







1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(subObj));
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
    } else {
	size_t i;

	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
	    Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
	    Tcl_AppendToObj(errorObj, ", ", 2);
	}
	Tcl_AppendPrintfToObj(errorObj, "or %s",
		ensemblePtr->subcommandArrayPtr[i]);
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
 *
 *----------------------------------------------------------------------
 */

int
TclInitRewriteEnsemble(
    Tcl_Interp *interp,
    int numRemoved,
    int numInserted,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;

    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);

    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
	iPtr->ensembleRewrite.numInsertedObjs = numInserted;
    } else {
	int numIns = iPtr->ensembleRewrite.numInsertedObjs;

	if (numIns < numRemoved) {
	    iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
	    iPtr->ensembleRewrite.numInsertedObjs = numInserted;
	} else {
	    iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
	}







|
|











|







1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
 *
 *----------------------------------------------------------------------
 */

int
TclInitRewriteEnsemble(
    Tcl_Interp *interp,
    size_t numRemoved,
    size_t numInserted,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;

    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);

    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
	iPtr->ensembleRewrite.numInsertedObjs = numInserted;
    } else {
	size_t numIns = iPtr->ensembleRewrite.numInsertedObjs;

	if (numIns < numRemoved) {
	    iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
	    iPtr->ensembleRewrite.numInsertedObjs = numInserted;
	} else {
	    iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
	}
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
FreeER(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **tmp = (Tcl_Obj **)data[0];

    ckfree(tmp[2]);
    ckfree(tmp);
    return result;
}

void
TclSpellFix(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    int objc,
    int badIdx,
    Tcl_Obj *bad,
    Tcl_Obj *fix)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *const *search;
    Tcl_Obj **store;
    int idx;
    int size;

    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }








|
|








|






|
|







2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
FreeER(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **tmp = (Tcl_Obj **)data[0];

    Tcl_Free(tmp[2]);
    Tcl_Free(tmp);
    return result;
}

void
TclSpellFix(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    int objc,
    size_t badIdx,
    Tcl_Obj *bad,
    Tcl_Obj *fix)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *const *search;
    Tcl_Obj **store;
    size_t idx;
    size_t size;

    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }

2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
	}
    }

    search = iPtr->ensembleRewrite.sourceObjs;
    if (search[0] == NULL) {
	store = (Tcl_Obj **) search[2];
    } else {
	Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));

	tmp[0] = NULL;
	tmp[1] = (Tcl_Obj *) iPtr->ensembleRewrite.sourceObjs;
	tmp[2] = (Tcl_Obj *) ckalloc(size * sizeof(Tcl_Obj *));
	memcpy(tmp[2], tmp[1], size * sizeof(Tcl_Obj *));

	iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
	TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
	store = (Tcl_Obj **)tmp[2];
    }








|



|







2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
	}
    }

    search = iPtr->ensembleRewrite.sourceObjs;
    if (search[0] == NULL) {
	store = (Tcl_Obj **) search[2];
    } else {
	Tcl_Obj **tmp = Tcl_Alloc(3 * sizeof(Tcl_Obj *));

	tmp[0] = NULL;
	tmp[1] = (Tcl_Obj *) iPtr->ensembleRewrite.sourceObjs;
	tmp[2] = (Tcl_Obj *) Tcl_Alloc(size * sizeof(Tcl_Obj *));
	memcpy(tmp[2], tmp[1], size * sizeof(Tcl_Obj *));

	iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
	TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
	store = (Tcl_Obj **)tmp[2];
    }

2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
    } else {
	/*
	 * Kill the old internal rep, and replace it with a brand new one of
	 * our own.
	 */

	TclFreeIntRep(objPtr);
	ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
	objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
	objPtr->typePtr = &ensembleCmdType;
    }

    /*
     * Populate the internal rep.
     */







|







2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
    } else {
	/*
	 * Kill the old internal rep, and replace it with a brand new one of
	 * our own.
	 */

	TclFreeIntRep(objPtr);
	ensembleCmd = Tcl_Alloc(sizeof(EnsembleCmdRep));
	objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
	objPtr->typePtr = &ensembleCmdType;
    }

    /*
     * Populate the internal rep.
     */
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
        Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search);

        while (hPtr != NULL) {
            Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
            Tcl_DecrRefCount(prefixObj);
            hPtr = Tcl_NextHashEntry(&search);
        }
        ckfree((char *) ensemblePtr->subcommandArrayPtr);
    }
    Tcl_DeleteHashTable(hash);
}

static void
DeleteEnsembleConfig(
    ClientData clientData)







|







2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
        Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search);

        while (hPtr != NULL) {
            Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
            Tcl_DecrRefCount(prefixObj);
            hPtr = Tcl_NextHashEntry(&search);
        }
        Tcl_Free(ensemblePtr->subcommandArrayPtr);
    }
    Tcl_DeleteHashTable(hash);
}

static void
DeleteEnsembleConfig(
    ClientData clientData)
2539
2540
2541
2542
2543
2544
2545

2546
2547
2548
2549
2550
2551
2552
2553
static void
BuildEnsembleConfig(
    EnsembleConfig *ensemblePtr)
{
    Tcl_HashSearch search;	/* Used for scanning the set of commands in
				 * the namespace that backs up this
				 * ensemble. */

    int i, j, isNew;
    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
    Tcl_Obj *subList = ensemblePtr->subcmdList;

    ClearTable(ensemblePtr);
    Tcl_InitHashTable(hash, TCL_STRING_KEYS);







>
|







2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
static void
BuildEnsembleConfig(
    EnsembleConfig *ensemblePtr)
{
    Tcl_HashSearch search;	/* Used for scanning the set of commands in
				 * the namespace that backs up this
				 * ensemble. */
    size_t i, j;
    int isNew;
    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
    Tcl_Obj *subList = ensemblePtr->subcmdList;

    ClearTable(ensemblePtr);
    Tcl_InitHashTable(hash, TCL_STRING_KEYS);
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
        Tcl_ListObjGetElements(NULL, subList, &subc, &subv);
        if (subList == mapDict) {
            /*
             * Strange case where explicit list of subcommands is same value
             * as the dict mapping to targets.
             */

            for (i = 0; i < subc; i += 2) {
                name = TclGetString(subv[i]);
                hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
                if (!isNew) {
                    cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
                    Tcl_DecrRefCount(cmdObj);
                }
                Tcl_SetHashValue(hPtr, subv[i+1]);







|







2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
        Tcl_ListObjGetElements(NULL, subList, &subc, &subv);
        if (subList == mapDict) {
            /*
             * Strange case where explicit list of subcommands is same value
             * as the dict mapping to targets.
             */

            for (i = 0; i < (size_t)subc; i += 2) {
                name = TclGetString(subv[i]);
                hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
                if (!isNew) {
                    cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
                    Tcl_DecrRefCount(cmdObj);
                }
                Tcl_SetHashValue(hPtr, subv[i+1]);
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
                }
            }
        } else {
            /*
	     * Usual case where we can freely act on the list and dict.
	     */

            for (i = 0; i < subc; i++) {
                name = TclGetString(subv[i]);
                hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
                if (!isNew) {
                    continue;
                }

                /*







|







2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
                }
            }
        } else {
            /*
	     * Usual case where we can freely act on the list and dict.
	     */

            for (i = 0; i < (size_t)subc; i++) {
                name = TclGetString(subv[i]);
                hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
                if (!isNew) {
                    continue;
                }

                /*
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
     *
     * We do this by filling an array with the names (we use the hash keys
     * directly to save a copy, since any time we change the array we change
     * the hash too, and vice versa) and running quicksort over the array.
     */

    ensemblePtr->subcommandArrayPtr =
	    ckalloc(sizeof(char *) * hash->numEntries);

    /*
     * Fill array from both ends as this makes us less likely to end up with
     * performance problems in qsort(), which is good. Note that doing this
     * makes this code much more opaque, but the naive alternatve:
     *
     * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ;







|







2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
     *
     * We do this by filling an array with the names (we use the hash keys
     * directly to save a copy, since any time we change the array we change
     * the hash too, and vice versa) and running quicksort over the array.
     */

    ensemblePtr->subcommandArrayPtr =
	    Tcl_Alloc(sizeof(char *) * hash->numEntries);

    /*
     * Fill array from both ends as this makes us less likely to end up with
     * performance problems in qsort(), which is good. Note that doing this
     * makes this code much more opaque, but the naive alternatve:
     *
     * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ;
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
	if (hPtr == NULL) {
	    break;
	}
	ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }
    if (hash->numEntries > 1) {
	qsort(ensemblePtr->subcommandArrayPtr, (unsigned) hash->numEntries,
		sizeof(char *), NsEnsembleStringOrder);
    }
}

/*
 *----------------------------------------------------------------------
 *







|







2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
	if (hPtr == NULL) {
	    break;
	}
	ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }
    if (hash->numEntries > 1) {
	qsort(ensemblePtr->subcommandArrayPtr, hash->numEntries,
		sizeof(char *), NsEnsembleStringOrder);
    }
}

/*
 *----------------------------------------------------------------------
 *
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
{
    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;

    TclCleanupCommandMacro(ensembleCmd->token);
    if (ensembleCmd->fix) {
	Tcl_DecrRefCount(ensembleCmd->fix);
    }
    ckfree(ensembleCmd);
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupEnsembleCmdRep --







|







2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
{
    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;

    TclCleanupCommandMacro(ensembleCmd->token);
    if (ensembleCmd->fix) {
	Tcl_DecrRefCount(ensembleCmd->fix);
    }
    Tcl_Free(ensembleCmd);
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupEnsembleCmdRep --
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842

static void
DupEnsembleCmdRep(
    Tcl_Obj *objPtr,
    Tcl_Obj *copyPtr)
{
    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
    EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));

    copyPtr->typePtr = &ensembleCmdType;
    copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
    ensembleCopy->epoch = ensembleCmd->epoch;
    ensembleCopy->token = ensembleCmd->token;
    ensembleCopy->token->refCount++;
    ensembleCopy->fix = ensembleCmd->fix;







|







2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843

static void
DupEnsembleCmdRep(
    Tcl_Obj *objPtr,
    Tcl_Obj *copyPtr)
{
    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
    EnsembleCmdRep *ensembleCopy = Tcl_Alloc(sizeof(EnsembleCmdRep));

    copyPtr->typePtr = &ensembleCmdType;
    copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
    ensembleCopy->epoch = ensembleCmd->epoch;
    ensembleCopy->token = ensembleCmd->token;
    ensembleCopy->token->refCount++;
    ensembleCopy->fix = ensembleCmd->fix;
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160

    /*
     * Throw out any line information generated by the failed compile attempt.
     */

    while (mapPtr->nuloc - 1 > eclIndex) {
        mapPtr->nuloc--;
        ckfree(mapPtr->loc[mapPtr->nuloc].line);
        mapPtr->loc[mapPtr->nuloc].line = NULL;
    }

    /*
     * Reset the index of next command.  Toss out any from failed nested
     * partial compiles.
     */







|







3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161

    /*
     * Throw out any line information generated by the failed compile attempt.
     */

    while (mapPtr->nuloc - 1 > eclIndex) {
        mapPtr->nuloc--;
        Tcl_Free(mapPtr->loc[mapPtr->nuloc].line);
        mapPtr->loc[mapPtr->nuloc].line = NULL;
    }

    /*
     * Reset the index of next command.  Toss out any from failed nested
     * partial compiles.
     */
Changes to generic/tclEnv.c.
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 */

#include "tclInt.h"

TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ. */

static struct {
    int cacheSize;		/* Number of env strings in cache. */
    char **cache;		/* Array containing all of the environment
				 * strings that Tcl has allocated. */
#ifndef USE_PUTENV
    char **ourEnviron;		/* Cache of the array that we allocate. We
				 * need to track this in case another
				 * subsystem swaps around the environ array
				 * like we do. */
    int ourEnvironSize;		/* Non-zero means that the environ array was
				 * malloced and has this many total entries
				 * allocated to it (not all may be in use at
				 * once). Zero means that the environment
				 * array is in its original static state. */
#endif
} env;








|







|







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 */

#include "tclInt.h"

TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ. */

static struct {
    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
    char **ourEnviron;		/* Cache of the array that we allocate. We
				 * need to track this in case another
				 * subsystem swaps around the environ array
				 * like we do. */
    size_t ourEnvironSize;	/* Non-zero means that the environ array was
				 * malloced and has this many total entries
				 * allocated to it (not all may be in use at
				 * once). Zero means that the environment
				 * array is in its original static state. */
#endif
} env;

200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
TclSetEnv(
    const char *name,		/* Name of variable whose value is to be set
				 * (UTF-8). */
    const char *value)		/* New value for variable (UTF-8). */
{
    Tcl_DString envString;
    unsigned nameLength, valueLength;
    int index, length;
    char *p, *oldValue;
    const char *p2;

    /*
     * Figure out where the entry is going to go. If the name doesn't already
     * exist, enlarge the array if necessary to make room. If the name exists,
     * free its old entry.
     */

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);

    if (index == -1) {
#ifndef USE_PUTENV
	/*
	 * We need to handle the case where the environment may be changed
	 * outside our control. ourEnvironSize is only valid if the current
	 * environment is the one we allocated. [Bug 979640]
	 */

	if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
	    char **newEnviron = ckalloc((length + 5) * sizeof(char *));

	    memcpy(newEnviron, environ, length * sizeof(char *));
	    if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
		ckfree(env.ourEnviron);
	    }
	    environ = env.ourEnviron = newEnviron;
	    env.ourEnvironSize = length + 5;
	}
	index = length;
	environ[index + 1] = NULL;
#endif /* USE_PUTENV */







|












|








|



|







200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
TclSetEnv(
    const char *name,		/* Name of variable whose value is to be set
				 * (UTF-8). */
    const char *value)		/* New value for variable (UTF-8). */
{
    Tcl_DString envString;
    unsigned nameLength, valueLength;
    size_t index, length;
    char *p, *oldValue;
    const char *p2;

    /*
     * Figure out where the entry is going to go. If the name doesn't already
     * exist, enlarge the array if necessary to make room. If the name exists,
     * free its old entry.
     */

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);

    if (index == TCL_AUTO_LENGTH) {
#ifndef USE_PUTENV
	/*
	 * We need to handle the case where the environment may be changed
	 * outside our control. ourEnvironSize is only valid if the current
	 * environment is the one we allocated. [Bug 979640]
	 */

	if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
	    char **newEnviron = Tcl_Alloc((length + 5) * sizeof(char *));

	    memcpy(newEnviron, environ, length * sizeof(char *));
	    if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
		Tcl_Free(env.ourEnviron);
	    }
	    environ = env.ourEnviron = newEnviron;
	    env.ourEnvironSize = length + 5;
	}
	index = length;
	environ[index + 1] = NULL;
#endif /* USE_PUTENV */
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
    /*
     * Create a new entry. Build a complete UTF string that contains a
     * "name=value" pattern. Then convert the string to the native encoding,
     * and set the environ array value.
     */

    valueLength = strlen(value);
    p = ckalloc(nameLength + valueLength + 2);
    memcpy(p, name, nameLength);
    p[nameLength] = '=';
    memcpy(p+nameLength+1, value, valueLength+1);
    p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);

    /*
     * Copy the native string to heap memory.
     */

    p = ckrealloc(p, Tcl_DStringLength(&envString) + 1);
    memcpy(p, p2, (unsigned) Tcl_DStringLength(&envString) + 1);
    Tcl_DStringFree(&envString);

#ifdef USE_PUTENV
    /*
     * Update the system environment.
     */

    putenv(p);
    index = TclpFindVariable(name, &length);
#else
    environ[index] = p;
#endif /* USE_PUTENV */

    /*
     * Watch out for versions of putenv that copy the string (e.g. VC++). In
     * this case we need to free the string immediately. Otherwise update the
     * string in the cache.
     */

    if ((index != -1) && (environ[index] == p)) {
	ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

	ckfree(p);
#endif /* HAVE_PUTENV_THAT_COPIES */
    }

    Tcl_MutexUnlock(&envMutex);

    if (!strcmp(name, "HOME")) {
	/*







|









|




















|







|







266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
    /*
     * Create a new entry. Build a complete UTF string that contains a
     * "name=value" pattern. Then convert the string to the native encoding,
     * and set the environ array value.
     */

    valueLength = strlen(value);
    p = Tcl_Alloc(nameLength + valueLength + 2);
    memcpy(p, name, nameLength);
    p[nameLength] = '=';
    memcpy(p+nameLength+1, value, valueLength+1);
    p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);

    /*
     * Copy the native string to heap memory.
     */

    p = Tcl_Realloc(p, Tcl_DStringLength(&envString) + 1);
    memcpy(p, p2, (unsigned) Tcl_DStringLength(&envString) + 1);
    Tcl_DStringFree(&envString);

#ifdef USE_PUTENV
    /*
     * Update the system environment.
     */

    putenv(p);
    index = TclpFindVariable(name, &length);
#else
    environ[index] = p;
#endif /* USE_PUTENV */

    /*
     * Watch out for versions of putenv that copy the string (e.g. VC++). In
     * this case we need to free the string immediately. Otherwise update the
     * string in the cache.
     */

    if ((index != TCL_AUTO_LENGTH) && (environ[index] == p)) {
	ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

	Tcl_Free(p);
#endif /* HAVE_PUTENV_THAT_COPIES */
    }

    Tcl_MutexUnlock(&envMutex);

    if (!strcmp(name, "HOME")) {
	/*
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
 */

void
TclUnsetEnv(
    const char *name)		/* Name of variable to remove (UTF-8). */
{
    char *oldValue;
    int length;
    int index;
#ifdef USE_PUTENV_FOR_UNSET
    Tcl_DString envString;
    char *string;
#else
    char **envPtr;
#endif /* USE_PUTENV_FOR_UNSET */

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);

    /*
     * First make sure that the environment variable exists to avoid doing
     * needless work and to avoid recursion on the unset.
     */

    if (index == -1) {
	Tcl_MutexUnlock(&envMutex);
	return;
    }

    /*
     * Remember the old value so we can free it if Tcl created the string.
     */







|
<















|







397
398
399
400
401
402
403
404

405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
 */

void
TclUnsetEnv(
    const char *name)		/* Name of variable to remove (UTF-8). */
{
    char *oldValue;
    size_t length, index;

#ifdef USE_PUTENV_FOR_UNSET
    Tcl_DString envString;
    char *string;
#else
    char **envPtr;
#endif /* USE_PUTENV_FOR_UNSET */

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);

    /*
     * First make sure that the environment variable exists to avoid doing
     * needless work and to avoid recursion on the unset.
     */

    if (index == TCL_AUTO_LENGTH) {
	Tcl_MutexUnlock(&envMutex);
	return;
    }

    /*
     * Remember the old value so we can free it if Tcl created the string.
     */
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
#ifdef USE_PUTENV_FOR_UNSET
    /*
     * For those platforms that support putenv to unset, Linux indicates
     * that no = should be included, and Windows requires it.
     */

#if defined(_WIN32)
    string = ckalloc(length + 2);
    memcpy(string, name, (size_t) length);
    string[length] = '=';
    string[length+1] = '\0';
#else
    string = ckalloc(length + 1);
    memcpy(string, name, (size_t) length);
    string[length] = '\0';
#endif /* _WIN32 */

    Tcl_UtfToExternalDString(NULL, string, -1, &envString);
    string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
    memcpy(string, Tcl_DStringValue(&envString),
	    (unsigned) Tcl_DStringLength(&envString)+1);
    Tcl_DStringFree(&envString);

    putenv(string);

    /*
     * Watch out for versions of putenv that copy the string (e.g. VC++). In
     * this case we need to free the string immediately. Otherwise update the
     * string in the cache.
     */

    if (environ[index] == string) {
	ReplaceString(oldValue, string);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

	ckfree(string);
#endif /* HAVE_PUTENV_THAT_COPIES */
    }
#else /* !USE_PUTENV_FOR_UNSET */
    for (envPtr = environ+index+1; ; envPtr++) {
	envPtr[-1] = *envPtr;
	if (*envPtr == NULL) {
	    break;







|




|





|




















|







436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
#ifdef USE_PUTENV_FOR_UNSET
    /*
     * For those platforms that support putenv to unset, Linux indicates
     * that no = should be included, and Windows requires it.
     */

#if defined(_WIN32)
    string = Tcl_Alloc(length + 2);
    memcpy(string, name, (size_t) length);
    string[length] = '=';
    string[length+1] = '\0';
#else
    string = Tcl_Alloc(length + 1);
    memcpy(string, name, (size_t) length);
    string[length] = '\0';
#endif /* _WIN32 */

    Tcl_UtfToExternalDString(NULL, string, -1, &envString);
    string = Tcl_Realloc(string, Tcl_DStringLength(&envString) + 1);
    memcpy(string, Tcl_DStringValue(&envString),
	    (unsigned) Tcl_DStringLength(&envString)+1);
    Tcl_DStringFree(&envString);

    putenv(string);

    /*
     * Watch out for versions of putenv that copy the string (e.g. VC++). In
     * this case we need to free the string immediately. Otherwise update the
     * string in the cache.
     */

    if (environ[index] == string) {
	ReplaceString(oldValue, string);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

	Tcl_Free(string);
#endif /* HAVE_PUTENV_THAT_COPIES */
    }
#else /* !USE_PUTENV_FOR_UNSET */
    for (envPtr = environ+index+1; ; envPtr++) {
	envPtr[-1] = *envPtr;
	if (*envPtr == NULL) {
	    break;
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
TclGetEnv(
    const char *name,		/* Name of environment variable to find
				 * (UTF-8). */
    Tcl_DString *valuePtr)	/* Uninitialized or free DString in which the
				 * value of the environment variable is
				 * stored. */
{
    int length, index;
    const char *result;

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);
    result = NULL;
    if (index != -1) {
	Tcl_DString envStr;

	result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
	result += length;
	if (*result == '=') {
	    result++;
	    Tcl_DStringInit(valuePtr);







|





|







512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
TclGetEnv(
    const char *name,		/* Name of environment variable to find
				 * (UTF-8). */
    Tcl_DString *valuePtr)	/* Uninitialized or free DString in which the
				 * value of the environment variable is
				 * stored. */
{
    size_t length, index;
    const char *result;

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);
    result = NULL;
    if (index != TCL_AUTO_LENGTH) {
	Tcl_DString envStr;

	result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
	result += length;
	if (*result == '=') {
	    result++;
	    Tcl_DStringInit(valuePtr);
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
 */

static void
ReplaceString(
    const char *oldStr,		/* Old environment string. */
    char *newStr)		/* New environment string. */
{
    int i;

    /*
     * Check to see if the old value was allocated by Tcl. If so, it needs to
     * be deallocated to avoid memory leaks. Note that this algorithm is O(n),
     * not O(1). This will result in n-squared behavior if lots of environment
     * changes are being made.
     */

    for (i = 0; i < env.cacheSize; i++) {
	if (env.cache[i]==oldStr || env.cache[i]==NULL) {
	    break;
	}
    }
    if (i < env.cacheSize) {
	/*
	 * Replace or delete the old value.
	 */

	if (env.cache[i]) {
	    ckfree(env.cache[i]);
	}

	if (newStr) {
	    env.cache[i] = newStr;
	} else {
	    for (; i < env.cacheSize-1; i++) {
		env.cache[i] = env.cache[i+1];
	    }
	    env.cache[env.cacheSize-1] = NULL;
	}
    } else {
	/*
	 * We need to grow the cache in order to hold the new string.
	 */

	const int growth = 5;

	env.cache = ckrealloc(env.cache,
		(env.cacheSize + growth) * sizeof(char *));
	env.cache[env.cacheSize] = newStr;
	(void) memset(env.cache+env.cacheSize+1, 0,
		(size_t) (growth-1) * sizeof(char *));
	env.cacheSize += growth;
    }
}







|



















|

















|







645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
 */

static void
ReplaceString(
    const char *oldStr,		/* Old environment string. */
    char *newStr)		/* New environment string. */
{
    size_t i;

    /*
     * Check to see if the old value was allocated by Tcl. If so, it needs to
     * be deallocated to avoid memory leaks. Note that this algorithm is O(n),
     * not O(1). This will result in n-squared behavior if lots of environment
     * changes are being made.
     */

    for (i = 0; i < env.cacheSize; i++) {
	if (env.cache[i]==oldStr || env.cache[i]==NULL) {
	    break;
	}
    }
    if (i < env.cacheSize) {
	/*
	 * Replace or delete the old value.
	 */

	if (env.cache[i]) {
	    Tcl_Free(env.cache[i]);
	}

	if (newStr) {
	    env.cache[i] = newStr;
	} else {
	    for (; i < env.cacheSize-1; i++) {
		env.cache[i] = env.cache[i+1];
	    }
	    env.cache[env.cacheSize-1] = NULL;
	}
    } else {
	/*
	 * We need to grow the cache in order to hold the new string.
	 */

	const int growth = 5;

	env.cache = Tcl_Realloc(env.cache,
		(env.cacheSize + growth) * sizeof(char *));
	env.cache[env.cacheSize] = newStr;
	(void) memset(env.cache+env.cacheSize+1, 0,
		(size_t) (growth-1) * sizeof(char *));
	env.cacheSize += growth;
    }
}
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
     * free all strings in the cache.
     */

    if (env.cache) {
#ifdef PURIFY
	int i;
	for (i = 0; i < env.cacheSize; i++) {
	    ckfree(env.cache[i]);
	}
#endif
	ckfree(env.cache);
	env.cache = NULL;
	env.cacheSize = 0;
#ifndef USE_PUTENV
	if ((env.ourEnviron != NULL)) {
	    ckfree(env.ourEnviron);
	    env.ourEnviron = NULL;
	}
	env.ourEnvironSize = 0;
#endif
    }
}








|


|




|







726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
     * free all strings in the cache.
     */

    if (env.cache) {
#ifdef PURIFY
	int i;
	for (i = 0; i < env.cacheSize; i++) {
	    Tcl_Free(env.cache[i]);
	}
#endif
	Tcl_Free(env.cache);
	env.cache = NULL;
	env.cacheSize = 0;
#ifndef USE_PUTENV
	if ((env.ourEnviron != NULL)) {
	    Tcl_Free(env.ourEnviron);
	    env.ourEnviron = NULL;
	}
	env.ourEnvironSize = 0;
#endif
    }
}

Changes to generic/tclEvent.c.
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
    BgError *errPtr;
    ErrAssocData *assocPtr;

    if (code == TCL_OK) {
	return;
    }

    errPtr = ckalloc(sizeof(BgError));
    errPtr->errorMsg = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(errPtr->errorMsg);
    errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
    Tcl_IncrRefCount(errPtr->returnOpts);
    errPtr->nextPtr = NULL;

    (void) TclGetBgErrorHandler(interp);







|







156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
    BgError *errPtr;
    ErrAssocData *assocPtr;

    if (code == TCL_OK) {
	return;
    }

    errPtr = Tcl_Alloc(sizeof(BgError));
    errPtr->errorMsg = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(errPtr->errorMsg);
    errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
    Tcl_IncrRefCount(errPtr->returnOpts);
    errPtr->nextPtr = NULL;

    (void) TclGetBgErrorHandler(interp);
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
	 */

	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);

	errPtr = assocPtr->firstBgPtr;

	Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
	tempObjv = ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
	memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
	tempObjv[prefixObjc] = errPtr->errorMsg;
	tempObjv[prefixObjc+1] = errPtr->returnOpts;
	Tcl_AllowExceptions(interp);
	code = Tcl_EvalObjv(interp, prefixObjc+2, tempObjv, TCL_EVAL_GLOBAL);

	/*
	 * Discard the command and the information about the error report.
	 */

	Tcl_DecrRefCount(copyObj);
	Tcl_DecrRefCount(errPtr->errorMsg);
	Tcl_DecrRefCount(errPtr->returnOpts);
	assocPtr->firstBgPtr = errPtr->nextPtr;
	ckfree(errPtr);
	ckfree(tempObjv);

	if (code == TCL_BREAK) {
	    /*
	     * Break means cancel any remaining error reports for this
	     * interpreter.
	     */

	    while (assocPtr->firstBgPtr != NULL) {
		errPtr = assocPtr->firstBgPtr;
		assocPtr->firstBgPtr = errPtr->nextPtr;
		Tcl_DecrRefCount(errPtr->errorMsg);
		Tcl_DecrRefCount(errPtr->returnOpts);
		ckfree(errPtr);
	    }
	} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);

	    if (errChannel != NULL) {
		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
		Tcl_Obj *keyPtr, *valuePtr = NULL;







|














|
|












|







223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
	 */

	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);

	errPtr = assocPtr->firstBgPtr;

	Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
	tempObjv = Tcl_Alloc((prefixObjc+2) * sizeof(Tcl_Obj *));
	memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
	tempObjv[prefixObjc] = errPtr->errorMsg;
	tempObjv[prefixObjc+1] = errPtr->returnOpts;
	Tcl_AllowExceptions(interp);
	code = Tcl_EvalObjv(interp, prefixObjc+2, tempObjv, TCL_EVAL_GLOBAL);

	/*
	 * Discard the command and the information about the error report.
	 */

	Tcl_DecrRefCount(copyObj);
	Tcl_DecrRefCount(errPtr->errorMsg);
	Tcl_DecrRefCount(errPtr->returnOpts);
	assocPtr->firstBgPtr = errPtr->nextPtr;
	Tcl_Free(errPtr);
	Tcl_Free(tempObjv);

	if (code == TCL_BREAK) {
	    /*
	     * Break means cancel any remaining error reports for this
	     * interpreter.
	     */

	    while (assocPtr->firstBgPtr != NULL) {
		errPtr = assocPtr->firstBgPtr;
		assocPtr->firstBgPtr = errPtr->nextPtr;
		Tcl_DecrRefCount(errPtr->errorMsg);
		Tcl_DecrRefCount(errPtr->returnOpts);
		Tcl_Free(errPtr);
	    }
	} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);

	    if (errChannel != NULL) {
		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
		Tcl_Obj *keyPtr, *valuePtr = NULL;
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
	Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
    }
    if (assocPtr == NULL) {
	/*
	 * First access: initialize.
	 */

	assocPtr = ckalloc(sizeof(ErrAssocData));
	assocPtr->interp = interp;
	assocPtr->cmdPrefix = NULL;
	assocPtr->firstBgPtr = NULL;
	assocPtr->lastBgPtr = NULL;
	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr);
    }
    if (assocPtr->cmdPrefix) {







|







521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
	Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
    }
    if (assocPtr == NULL) {
	/*
	 * First access: initialize.
	 */

	assocPtr = Tcl_Alloc(sizeof(ErrAssocData));
	assocPtr->interp = interp;
	assocPtr->cmdPrefix = NULL;
	assocPtr->firstBgPtr = NULL;
	assocPtr->lastBgPtr = NULL;
	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr);
    }
    if (assocPtr->cmdPrefix) {
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
    BgError *errPtr;

    while (assocPtr->firstBgPtr != NULL) {
	errPtr = assocPtr->firstBgPtr;
	assocPtr->firstBgPtr = errPtr->nextPtr;
	Tcl_DecrRefCount(errPtr->errorMsg);
	Tcl_DecrRefCount(errPtr->returnOpts);
	ckfree(errPtr);
    }
    Tcl_CancelIdleCall(HandleBgErrors, assocPtr);
    Tcl_DecrRefCount(assocPtr->cmdPrefix);
    Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC);
}

/*







|







600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
    BgError *errPtr;

    while (assocPtr->firstBgPtr != NULL) {
	errPtr = assocPtr->firstBgPtr;
	assocPtr->firstBgPtr = errPtr->nextPtr;
	Tcl_DecrRefCount(errPtr->errorMsg);
	Tcl_DecrRefCount(errPtr->returnOpts);
	Tcl_Free(errPtr);
    }
    Tcl_CancelIdleCall(HandleBgErrors, assocPtr);
    Tcl_DecrRefCount(assocPtr->cmdPrefix);
    Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC);
}

/*
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
 */

void
Tcl_CreateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstExitPtr;
    firstExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);







|







630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
 */

void
Tcl_CreateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = Tcl_Alloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstExitPtr;
    firstExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
 */

void
TclCreateLateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstLateExitPtr;
    firstLateExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);







|







663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
 */

void
TclCreateLateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = Tcl_Alloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstLateExitPtr;
    firstLateExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    ckfree(exitPtr);
	    break;
	}
    }
    Tcl_MutexUnlock(&exitMutex);
    return;
}








|







708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    Tcl_Free(exitPtr);
	    break;
	}
    }
    Tcl_MutexUnlock(&exitMutex);
    return;
}

751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		firstLateExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    ckfree(exitPtr);
	    break;
	}
    }
    Tcl_MutexUnlock(&exitMutex);
    return;
}








|







751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		firstLateExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    Tcl_Free(exitPtr);
	    break;
	}
    }
    Tcl_MutexUnlock(&exitMutex);
    return;
}

785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
Tcl_CreateThreadExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    exitPtr = ckalloc(sizeof(ExitHandler));
    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    exitPtr->nextPtr = tsdPtr->firstExitPtr;
    tsdPtr->firstExitPtr = exitPtr;
}

/*







|







785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
Tcl_CreateThreadExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    exitPtr = Tcl_Alloc(sizeof(ExitHandler));
    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    exitPtr->nextPtr = tsdPtr->firstExitPtr;
    tsdPtr->firstExitPtr = exitPtr;
}

/*
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		tsdPtr->firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    ckfree(exitPtr);
	    return;
	}
    }
}

/*
 *----------------------------------------------------------------------







|







827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		tsdPtr->firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    Tcl_Free(exitPtr);
	    return;
	}
    }
}

/*
 *----------------------------------------------------------------------
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
	 * callback. This protects us against double-freeing if the callback
	 * should call Tcl_DeleteExitHandler on itself.
	 */

	firstExitPtr = exitPtr->nextPtr;
	Tcl_MutexUnlock(&exitMutex);
	exitPtr->proc(exitPtr->clientData);
	ckfree(exitPtr);
	Tcl_MutexLock(&exitMutex);
    }
    firstExitPtr = NULL;
    Tcl_MutexUnlock(&exitMutex);
}









|







905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
	 * callback. This protects us against double-freeing if the callback
	 * should call Tcl_DeleteExitHandler on itself.
	 */

	firstExitPtr = exitPtr->nextPtr;
	Tcl_MutexUnlock(&exitMutex);
	exitPtr->proc(exitPtr->clientData);
	Tcl_Free(exitPtr);
	Tcl_MutexLock(&exitMutex);
    }
    firstExitPtr = NULL;
    Tcl_MutexUnlock(&exitMutex);
}


1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
	 * callback. This protects us against double-freeing if the callback
	 * should call Tcl_DeleteLateExitHandler on itself.
	 */

	firstLateExitPtr = exitPtr->nextPtr;
	Tcl_MutexUnlock(&exitMutex);
	exitPtr->proc(exitPtr->clientData);
	ckfree(exitPtr);
	Tcl_MutexLock(&exitMutex);
    }
    firstLateExitPtr = NULL;
    Tcl_MutexUnlock(&exitMutex);

    /*
     * Now finalize the Tcl execution environment. Note that this must be done







|







1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
	 * callback. This protects us against double-freeing if the callback
	 * should call Tcl_DeleteLateExitHandler on itself.
	 */

	firstLateExitPtr = exitPtr->nextPtr;
	Tcl_MutexUnlock(&exitMutex);
	exitPtr->proc(exitPtr->clientData);
	Tcl_Free(exitPtr);
	Tcl_MutexLock(&exitMutex);
    }
    firstLateExitPtr = NULL;
    Tcl_MutexUnlock(&exitMutex);

    /*
     * Now finalize the Tcl execution environment. Note that this must be done
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
     * original state.
     */

    TclFinalizeLoad();
    TclResetFilesystem();

    /*
     * At this point, there should no longer be any ckalloc'ed memory.
     */

    TclFinalizeMemorySubsystem();

  alreadyFinalized:
    TclFinalizeLock();
}







|







1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
     * original state.
     */

    TclFinalizeLoad();
    TclResetFilesystem();

    /*
     * At this point, there should no longer be any Tcl_Alloc'ed memory.
     */

    TclFinalizeMemorySubsystem();

  alreadyFinalized:
    TclFinalizeLock();
}
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
	     * Be careful to remove the handler from the list before invoking
	     * its callback. This protects us against double-freeing if the
	     * callback should call Tcl_DeleteThreadExitHandler on itself.
	     */

	    tsdPtr->firstExitPtr = exitPtr->nextPtr;
	    exitPtr->proc(exitPtr->clientData);
	    ckfree(exitPtr);
	}
	TclFinalizeIOSubsystem();
	TclFinalizeNotifier();
	TclFinalizeAsync();
	TclFinalizeThreadObjects();
    }








|







1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
	     * Be careful to remove the handler from the list before invoking
	     * its callback. This protects us against double-freeing if the
	     * callback should call Tcl_DeleteThreadExitHandler on itself.
	     */

	    tsdPtr->firstExitPtr = exitPtr->nextPtr;
	    exitPtr->proc(exitPtr->clientData);
	    Tcl_Free(exitPtr);
	}
	TclFinalizeIOSubsystem();
	TclFinalizeNotifier();
	TclFinalizeAsync();
	TclFinalizeThreadObjects();
    }

1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
{
    ThreadClientData *cdPtr = clientData;
    ClientData threadClientData;
    Tcl_ThreadCreateProc *threadProc;

    threadProc = cdPtr->proc;
    threadClientData = cdPtr->clientData;
    ckfree(clientData);		/* Allocated in Tcl_CreateThread() */

    threadProc(threadClientData);

    TCL_THREAD_CREATE_RETURN;
}
#endif








|







1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
{
    ThreadClientData *cdPtr = clientData;
    ClientData threadClientData;
    Tcl_ThreadCreateProc *threadProc;

    threadProc = cdPtr->proc;
    threadClientData = cdPtr->clientData;
    Tcl_Free(clientData);		/* Allocated in Tcl_CreateThread() */

    threadProc(threadClientData);

    TCL_THREAD_CREATE_RETURN;
}
#endif

1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
 */

int
Tcl_CreateThread(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
    int result;

    cdPtr->proc = proc;
    cdPtr->clientData = clientData;
    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
    if (result != TCL_OK) {
	ckfree(cdPtr);
    }
    return result;
#else
    return TCL_ERROR;
#endif /* TCL_THREADS */
}








|




|






|







1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
 */

int
Tcl_CreateThread(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    size_t stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    ThreadClientData *cdPtr = Tcl_Alloc(sizeof(ThreadClientData));
    int result;

    cdPtr->proc = proc;
    cdPtr->clientData = clientData;
    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
    if (result != TCL_OK) {
	Tcl_Free(cdPtr);
    }
    return result;
#else
    return TCL_ERROR;
#endif /* TCL_THREADS */
}

Changes to generic/tclExecute.c.
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
 *
 * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			ClientData *ptrPtr, int *tPtr);
 */

#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
    (((objPtr)->typePtr == &tclIntType)					\
	?	(*(tPtr) = TCL_NUMBER_WIDE,				\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
    ((objPtr)->typePtr == &tclDoubleType)				\
	?	(((TclIsNaN((objPtr)->internalRep.doubleValue))		\
		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
		*(ptrPtr) = (ClientData)				\







|







438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
 *
 * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			ClientData *ptrPtr, int *tPtr);
 */

#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
    (((objPtr)->typePtr == &tclIntType)					\
	?	(*(tPtr) = TCL_NUMBER_INT,				\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
    ((objPtr)->typePtr == &tclDoubleType)				\
	?	(((TclIsNaN((objPtr)->internalRep.doubleValue))		\
		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
		*(ptrPtr) = (ClientData)				\
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedUnaryMathOp(int opcode,
			    Tcl_Obj *valuePtr);
static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
			    int searchMode, ByteCode *codePtr);
static const char *	GetSrcInfoForPc(const unsigned char *pc,
			    ByteCode *codePtr, int *lengthPtr,
			    const unsigned char **pcBeg, int *cmdIdxPtr);
static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
			    int move);
static void		IllegalExprOperandType(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj *opndPtr);
static void		InitByteCodeExecution(Tcl_Interp *interp);
static inline int	wordSkip(void *ptr);







|







621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedUnaryMathOp(int opcode,
			    Tcl_Obj *valuePtr);
static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
			    int searchMode, ByteCode *codePtr);
static const char *	GetSrcInfoForPc(const unsigned char *pc,
			    ByteCode *codePtr, size_t *lengthPtr,
			    const unsigned char **pcBeg, int *cmdIdxPtr);
static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
			    int move);
static void		IllegalExprOperandType(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj *opndPtr);
static void		InitByteCodeExecution(Tcl_Interp *interp);
static inline int	wordSkip(void *ptr);
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
    /*
     * First kill the search, and then release the reference to the dictionary
     * that we were holding.
     */

    searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
    Tcl_DictObjDone(searchPtr);
    ckfree(searchPtr);

    dictPtr = objPtr->internalRep.twoPtrValue.ptr2;
    TclDecrRefCount(dictPtr);

    objPtr->typePtr = NULL;
}








|







694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
    /*
     * First kill the search, and then release the reference to the dictionary
     * that we were holding.
     */

    searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
    Tcl_DictObjDone(searchPtr);
    Tcl_Free(searchPtr);

    dictPtr = objPtr->internalRep.twoPtrValue.ptr2;
    TclDecrRefCount(dictPtr);

    objPtr->typePtr = NULL;
}

766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
 *----------------------------------------------------------------------
 */

ExecEnv *
TclCreateExecEnv(
    Tcl_Interp *interp,		/* Interpreter for which the execution
				 * environment is being created. */
    int size)			/* The initial stack size, in number of words
				 * [sizeof(Tcl_Obj*)] */
{
    ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
    ExecStack *esPtr = ckalloc(sizeof(ExecStack)
	    + (size_t) (size-1) * sizeof(Tcl_Obj *));

    eePtr->execStackPtr = esPtr;
    TclNewIntObj(eePtr->constants[0], 0);
    Tcl_IncrRefCount(eePtr->constants[0]);
    TclNewIntObj(eePtr->constants[1], 1);
    Tcl_IncrRefCount(eePtr->constants[1]);







|


|
|







766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
 *----------------------------------------------------------------------
 */

ExecEnv *
TclCreateExecEnv(
    Tcl_Interp *interp,		/* Interpreter for which the execution
				 * environment is being created. */
    size_t size)			/* The initial stack size, in number of words
				 * [sizeof(Tcl_Obj*)] */
{
    ExecEnv *eePtr = Tcl_Alloc(sizeof(ExecEnv));
    ExecStack *esPtr = Tcl_Alloc(sizeof(ExecStack)
	    + (size_t) (size-1) * sizeof(Tcl_Obj *));

    eePtr->execStackPtr = esPtr;
    TclNewIntObj(eePtr->constants[0], 0);
    Tcl_IncrRefCount(eePtr->constants[0]);
    TclNewIntObj(eePtr->constants[1], 1);
    Tcl_IncrRefCount(eePtr->constants[1]);
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844

    if (esPtr->prevPtr) {
	esPtr->prevPtr->nextPtr = esPtr->nextPtr;
    }
    if (esPtr->nextPtr) {
	esPtr->nextPtr->prevPtr = esPtr->prevPtr;
    }
    ckfree(esPtr);
}

void
TclDeleteExecEnv(
    ExecEnv *eePtr)		/* Execution environment to free. */
{
    ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;







|







830
831
832
833
834
835
836
837
838
839
840
841
842
843
844

    if (esPtr->prevPtr) {
	esPtr->prevPtr->nextPtr = esPtr->nextPtr;
    }
    if (esPtr->nextPtr) {
	esPtr->nextPtr->prevPtr = esPtr->prevPtr;
    }
    Tcl_Free(esPtr);
}

void
TclDeleteExecEnv(
    ExecEnv *eePtr)		/* Execution environment to free. */
{
    ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
    TclDecrRefCount(eePtr->constants[1]);
    if (eePtr->callbackPtr && !cachedInExit) {
	Tcl_Panic("Deleting execEnv with pending TEOV callbacks!");
    }
    if (eePtr->corPtr && !cachedInExit) {
	Tcl_Panic("Deleting execEnv with existing coroutine");
    }
    ckfree(eePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeExecution --
 *







|







862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
    TclDecrRefCount(eePtr->constants[1]);
    if (eePtr->callbackPtr && !cachedInExit) {
	Tcl_Panic("Deleting execEnv with pending TEOV callbacks!");
    }
    if (eePtr->corPtr && !cachedInExit) {
	Tcl_Panic("Deleting execEnv with existing coroutine");
    }
    Tcl_Free(eePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeExecution --
 *
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
#else
    newElems = needed;
#endif

    newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);

    oldPtr = esPtr;
    esPtr = ckalloc(newBytes);

    oldPtr->nextPtr = esPtr;
    esPtr->prevPtr = oldPtr;
    esPtr->nextPtr = NULL;
    esPtr->endPtr = &esPtr->stackWords[newElems-1];

  newStackReady:







|







1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
#else
    newElems = needed;
#endif

    newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);

    oldPtr = esPtr;
    esPtr = Tcl_Alloc(newBytes);

    oldPtr->nextPtr = esPtr;
    esPtr->prevPtr = oldPtr;
    esPtr->nextPtr = NULL;
    esPtr->endPtr = &esPtr->stackWords[newElems-1];

  newStackReady:
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr, *marker;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	ckfree(freePtr);
	return;
    }

    /*
     * Rewind the stack to the previous marker position. The current marker,
     * as set in the last call to GrowEvaluationStack, contains a pointer to
     * the previous marker.







|







1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr, *marker;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	Tcl_Free(freePtr);
	return;
    }

    /*
     * Rewind the stack to the previous marker position. The current marker,
     * as set in the last call to GrowEvaluationStack, contains a pointer to
     * the previous marker.
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
	eePtr->execStackPtr = esPtr;
    }
}

void *
TclStackAlloc(
    Tcl_Interp *interp,
    int numBytes)
{
    Interp *iPtr = (Interp *) interp;
    int numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return (void *) ckalloc(numBytes);
    }
    numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
    return (void *) StackAllocWords(interp, numWords);
}

void *
TclStackRealloc(
    Tcl_Interp *interp,
    void *ptr,
    int numBytes)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr;
    int numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return (void *) ckrealloc((char *) ptr, numBytes);
    }

    eePtr = iPtr->execEnvPtr;
    esPtr = eePtr->execStackPtr;
    markerPtr = esPtr->markerPtr;

    if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) {







|





|









|








|







1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
	eePtr->execStackPtr = esPtr;
    }
}

void *
TclStackAlloc(
    Tcl_Interp *interp,
    size_t numBytes)
{
    Interp *iPtr = (Interp *) interp;
    int numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return (void *) Tcl_Alloc(numBytes);
    }
    numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
    return (void *) StackAllocWords(interp, numWords);
}

void *
TclStackRealloc(
    Tcl_Interp *interp,
    void *ptr,
    size_t numBytes)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr;
    int numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return (void *) Tcl_Realloc((char *) ptr, numBytes);
    }

    eePtr = iPtr->execEnvPtr;
    esPtr = eePtr->execStackPtr;
    markerPtr = esPtr->markerPtr;

    if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) {
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
 *--------------------------------------------------------------
 */

int
Tcl_ExprObj(
    Tcl_Interp *interp,		/* Context in which to evaluate the
				 * expression. */
    register Tcl_Obj *objPtr,	/* Points to Tcl object containing expression
				 * to evaluate. */
    Tcl_Obj **resultPtrPtr)	/* Where the Tcl_Obj* that is the expression
				 * result is stored if no errors occur. */
{
    NRE_callback *rootPtr = TOP_CB(interp);
    Tcl_Obj *resultPtr;








|







1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
 *--------------------------------------------------------------
 */

int
Tcl_ExprObj(
    Tcl_Interp *interp,		/* Context in which to evaluate the
				 * expression. */
    Tcl_Obj *objPtr,		/* Points to Tcl object containing expression
				 * to evaluate. */
    Tcl_Obj **resultPtrPtr)	/* Where the Tcl_Obj* that is the expression
				 * result is stored if no errors occur. */
{
    NRE_callback *rootPtr = TOP_CB(interp);
    Tcl_Obj *resultPtr;

1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
CompileExprObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Interp *iPtr = (Interp *) interp;
    CompileEnv compEnv;		/* Compilation environment structure allocated
				 * in frame. */
    register ByteCode *codePtr = NULL;
				/* Tcl Internal type of bytecode. Initialized
				 * to avoid compiler warning. */

    /*
     * Get the expression ByteCode from the object. If it exists, make sure it
     * is valid in the current context.
     */







|







1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
CompileExprObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Interp *iPtr = (Interp *) interp;
    CompileEnv compEnv;		/* Compilation environment structure allocated
				 * in frame. */
    ByteCode *codePtr = NULL;
				/* Tcl Internal type of bytecode. Initialized
				 * to avoid compiler warning. */

    /*
     * Get the expression ByteCode from the object. If it exists, make sure it
     * is valid in the current context.
     */
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
ByteCode *
TclCompileObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    const CmdFrame *invoker,
    int word)
{
    register Interp *iPtr = (Interp *) interp;
    register ByteCode *codePtr;	/* Tcl Internal type of bytecode. */
    Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;

    /*
     * If the object is not already of tclByteCodeType, compile it (and reset
     * the compilation flags in the interpreter; this should be done after any
     * compilation). Otherwise, check that it is "fresh" enough.
     */







|
|







1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
ByteCode *
TclCompileObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    const CmdFrame *invoker,
    int word)
{
    Interp *iPtr = (Interp *) interp;
    ByteCode *codePtr;	/* Tcl Internal type of bytecode. */
    Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;

    /*
     * If the object is not already of tclByteCodeType, compile it (and reset
     * the compilation flags in the interpreter; this should be done after any
     * compilation). Otherwise, check that it is "fresh" enough.
     */
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
	    CACHE_STACK_INFO();
	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG
	/* FIXME: What is the right thing to trace? */
	{
	    register int i;

	    TRACE(("%d [", opnd));
	    for (i=opnd-1 ; i>=0 ; i--) {
		TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i))));
		if (i > 0) {
		    TRACE_APPEND((" "));
		}







|







2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
	    CACHE_STACK_INFO();
	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG
	/* FIXME: What is the right thing to trace? */
	{
	    int i;

	    TRACE(("%d [", opnd));
	    for (i=opnd-1 ; i>=0 ; i--) {
		TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i))));
		if (i > 0) {
		    TRACE_APPEND((" "));
		}
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
    case INST_EXPAND_START:
	/*
	 * Push an element to the auxObjList. This records the current
	 * stack depth - i.e., the point in the stack where the expanded
	 * command starts.
	 *
	 * Use a Tcl_Obj as linked list element; slight mem waste, but faster
	 * allocation than ckalloc. This also abuses the Tcl_Obj structure, as
	 * we do not define a special tclObjType for it. It is not dangerous
	 * as the obj is never passed anywhere, so that all manipulations are
	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);







|







2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
    case INST_EXPAND_START:
	/*
	 * Push an element to the auxObjList. This records the current
	 * stack depth - i.e., the point in the stack where the expanded
	 * command starts.
	 *
	 * Use a Tcl_Obj as linked list element; slight mem waste, but faster
	 * allocation than Tcl_Alloc. This also abuses the Tcl_Obj structure, as
	 * we do not define a special tclObjType for it. It is not dangerous
	 * as the obj is never passed anywhere, so that all manipulations are
	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487

	if (TclIsVarDirectModifyable(varPtr)) {
	    ClientData ptr;
	    int type;

	    objPtr = varPtr->value.objPtr;
	    if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
		if (type == TCL_NUMBER_WIDE) {
		    Tcl_WideInt augend = *((const Tcl_WideInt *)ptr);
		    Tcl_WideInt sum = augend + increment;

		    /*
		     * Overflow when (augend and sum have different sign) and
		     * (augend and increment have the same sign). This is
		     * encapsulated in the Overflowing macro.







|







3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487

	if (TclIsVarDirectModifyable(varPtr)) {
	    ClientData ptr;
	    int type;

	    objPtr = varPtr->value.objPtr;
	    if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
		if (type == TCL_NUMBER_INT) {
		    Tcl_WideInt augend = *((const Tcl_WideInt *)ptr);
		    Tcl_WideInt sum = augend + increment;

		    /*
		     * Overflow when (augend and sum have different sign) and
		     * (augend and increment have the same sign). This is
		     * encapsulated in the Overflowing macro.
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
			 * We know the sum value is outside the long range;
			 * use macro form that doesn't range test again.
			 */

			TclSetIntObj(objPtr, w+increment);
		    }
		    goto doneIncr;
		}	/* end if (type == TCL_NUMBER_WIDE) */
	    }
	    if (Tcl_IsShared(objPtr)) {
		objPtr->refCount--;	/* We know it's shared */
		objResultPtr = Tcl_DuplicateObj(objPtr);
		Tcl_IncrRefCount(objResultPtr);
		varPtr->value.objPtr = objResultPtr;
	    } else {







|







3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
			 * We know the sum value is outside the long range;
			 * use macro form that doesn't range test again.
			 */

			TclSetIntObj(objPtr, w+increment);
		    }
		    goto doneIncr;
		}	/* end if (type == TCL_NUMBER_INT) */
	    }
	    if (Tcl_IsShared(objPtr)) {
		objPtr->refCount--;	/* We know it's shared */
		objResultPtr = Tcl_DuplicateObj(objPtr);
		Tcl_IncrRefCount(objResultPtr);
		varPtr->value.objPtr = objResultPtr;
	    } else {
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
			"variable isn't array", opnd);
		DECACHE_STACK_INFO();
		Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    TclSetVarArray(varPtr);
	    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
	    TclInitVarHashTable(varPtr->value.tablePtr,
		    TclGetVarNsPtr(varPtr));
#ifdef TCL_COMPILE_DEBUG
	    TRACE_APPEND(("done\n"));
	} else {
	    TRACE_APPEND(("nothing to do\n"));
#endif
	}
	NEXT_INST_V(pcAdjustment, cleanup, 0);







|
<
<
<







3900
3901
3902
3903
3904
3905
3906
3907



3908
3909
3910
3911
3912
3913
3914
			"variable isn't array", opnd);
		DECACHE_STACK_INFO();
		Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    TclInitArrayVar(varPtr);



#ifdef TCL_COMPILE_DEBUG
	    TRACE_APPEND(("done\n"));
	} else {
	    TRACE_APPEND(("nothing to do\n"));
#endif
	}
	NEXT_INST_V(pcAdjustment, cleanup, 0);
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
    }
    case INST_INFO_LEVEL_NUM:
	TclNewIntObj(objResultPtr, iPtr->varFramePtr->level);
	TRACE_WITH_OBJ(("=> "), objResultPtr);
	NEXT_INST_F(1, 0, 1);
    case INST_INFO_LEVEL_ARGS: {
	int level;
	register CallFrame *framePtr = iPtr->varFramePtr;
	register CallFrame *rootFramePtr = iPtr->rootFramePtr;

	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
	if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (level <= 0) {







|
|







4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
    }
    case INST_INFO_LEVEL_NUM:
	TclNewIntObj(objResultPtr, iPtr->varFramePtr->level);
	TRACE_WITH_OBJ(("=> "), objResultPtr);
	NEXT_INST_F(1, 0, 1);
    case INST_INFO_LEVEL_ARGS: {
	int level;
	CallFrame *framePtr = iPtr->varFramePtr;
	CallFrame *rootFramePtr = iPtr->rootFramePtr;

	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
	if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (level <= 0) {
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
		|| contextPtr->callPtr->flags & FILTER_HANDLING) {
	    oPtr->flags |= FILTER_HANDLING;
	} else {
	    oPtr->flags &= ~FILTER_HANDLING;
	}

	{
	    register Method *const mPtr =
		    contextPtr->callPtr->chain[newDepth].mPtr;

	    return mPtr->typePtr->callProc(mPtr->clientData, interp,
		    (Tcl_ObjectContext) contextPtr, opnd, objv);
	}

    case INST_TCLOO_IS_OBJECT:







|







4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
		|| contextPtr->callPtr->flags & FILTER_HANDLING) {
	    oPtr->flags |= FILTER_HANDLING;
	} else {
	    oPtr->flags &= ~FILTER_HANDLING;
	}

	{
	    Method *const mPtr =
		    contextPtr->callPtr->chain[newDepth].mPtr;

	    return mPtr->typePtr->callProc(mPtr->clientData, interp,
		    (Tcl_ObjectContext) contextPtr, opnd, objv);
	}

    case INST_TCLOO_IS_OBJECT:
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564

	/*
	 * Extract the desired list element.
	 */

	if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
		&& (value2Ptr->typePtr != &tclListType)
		&& (TclGetIntForIndexM(NULL , value2Ptr, objc-1,
			&index) == TCL_OK)) {
	    TclDecrRefCount(value2Ptr);
	    tosPtr--;
	    pcAdjustment = 1;
	    goto lindexFastPath;
	}








|







4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561

	/*
	 * Extract the desired list element.
	 */

	if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
		&& (value2Ptr->typePtr != &tclListType)
		&& (TclGetIntForIndexM(NULL, value2Ptr, objc-1,
			&index) == TCL_OK)) {
	    TclDecrRefCount(value2Ptr);
	    tosPtr--;
	    pcAdjustment = 1;
	    goto lindexFastPath;
	}

4794
4795
4796
4797
4798
4799
4800
4801

4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819

4820
4821
4822
4823
4824
4825
4826
	NEXT_INST_F(9, 1, 1);

    case INST_LIST_IN:
    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	s1 = TclGetStringFromObj(valuePtr, &s1len);

	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	match = 0;
	if (length > 0) {
	    int i = 0;
	    Tcl_Obj *o;

	    /*
	     * An empty list doesn't match anything.
	     */

	    do {
		Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
		if (o != NULL) {
		    s2 = TclGetStringFromObj(o, &s2len);

		} else {
		    s2 = "";
		    s2len = 0;
		}
		if (s1len == s2len) {
		    match = (memcmp(s1, s2, s1len) == 0);
		}







|
>

















|
>







4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
	NEXT_INST_F(9, 1, 1);

    case INST_LIST_IN:
    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	s1 = TclGetString(valuePtr);
	s1len = valuePtr->length;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	match = 0;
	if (length > 0) {
	    int i = 0;
	    Tcl_Obj *o;

	    /*
	     * An empty list doesn't match anything.
	     */

	    do {
		Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
		if (o != NULL) {
		    s2 = TclGetString(o);
		    s2len = o->length;
		} else {
		    s2 = "";
		    s2len = 0;
		}
		if (s1len == s2len) {
		    match = (memcmp(s1, s2, s1len) == 0);
		}
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
	}

	if ((index < 0) || (index >= length)) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
	} else if (valuePtr->bytes && length == valuePtr->length) {
	    objResultPtr = Tcl_NewStringObj((const char *)
		    valuePtr->bytes+index, 1);
	} else {
	    char buf[4];
	    int ch = Tcl_GetUniChar(valuePtr, index);

	    /*







|







4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
	}

	if ((index < 0) || (index >= length)) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
	} else if (valuePtr->bytes && (size_t)length == valuePtr->length) {
	    objResultPtr = Tcl_NewStringObj((const char *)
		    valuePtr->bytes+index, 1);
	} else {
	    char buf[4];
	    int ch = Tcl_GetUniChar(valuePtr, index);

	    /*
5290
5291
5292
5293
5294
5295
5296

5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328

	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
	    match = TclUniCharMatch(ustring1, length, ustring2, length2,
		    nocase);
	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
	    unsigned char *bytes1, *bytes2;


	    bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length);
	    bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);
	    match = TclByteArrayMatch(bytes1, length, bytes2, length2, 0);
	} else {
	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
		    TclGetString(value2Ptr), nocase);
	}

	/*
	 * Reuse value2Ptr object already on stack if possible. Adjustment is
	 * 2 due to the nocase byte
	 */

	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

	JUMP_PEEPHOLE_F(match, 2, 2);

    {
	const char *string1, *string2;
	int trim1, trim2;

    case INST_STR_TRIM_LEFT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &length);
	trim1 = TclTrimLeft(string1, length, string2, length2);







>

|
|
|




















|







5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328

	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
	    match = TclUniCharMatch(ustring1, length, ustring2, length2,
		    nocase);
	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
	    unsigned char *bytes1, *bytes2;
	    size_t wlen1, wlen2;

	    bytes1 = TclGetByteArrayFromObj(valuePtr, &wlen1);
	    bytes2 = TclGetByteArrayFromObj(value2Ptr, &wlen2);
	    match = TclByteArrayMatch(bytes1, wlen1, bytes2, wlen2, 0);
	} else {
	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
		    TclGetString(value2Ptr), nocase);
	}

	/*
	 * Reuse value2Ptr object already on stack if possible. Adjustment is
	 * 2 due to the nocase byte
	 */

	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

	JUMP_PEEPHOLE_F(match, 2, 2);

    {
	const char *string1, *string2;
	size_t trim1, trim2;

    case INST_STR_TRIM_LEFT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &length);
	trim1 = TclTrimLeft(string1, length, string2, length2);
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
	ClientData ptr1, ptr2;
	int type1, type2;
	Tcl_WideInt w1, w2, wResult;

    case INST_NUM_TYPE:
	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
	    type1 = 0;
	} else if (type1 == TCL_NUMBER_WIDE) {
	    /* value is between LLONG_MIN and LLONG_MAX */
	    /* [string is integer] is -UINT_MAX to UINT_MAX range */
	    /* [string is wideinteger] is -ULLONG_MAX to ULLONG_MAX range */
	    int i;

	    if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
		type1 = TCL_NUMBER_LONG;
	    }
	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the LLONG_MIN to LLONG_MAX range */
	    /* [string is wideinteger] is -ULLONG_MAX to ULLONG_MAX range */
	    Tcl_WideInt w;

	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
		type1 = TCL_NUMBER_WIDE;
	    }
	}
	TclNewIntObj(objResultPtr, type1);
	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
	NEXT_INST_F(1, 1, 1);

    case INST_EQ:







<
<
<
<
<
<
<
<
<

|
|



|







5420
5421
5422
5423
5424
5425
5426









5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
	ClientData ptr1, ptr2;
	int type1, type2;
	Tcl_WideInt w1, w2, wResult;

    case INST_NUM_TYPE:
	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
	    type1 = 0;









	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
	    /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
	    Tcl_WideInt w;

	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
		type1 = TCL_NUMBER_INT;
	    }
	}
	TclNewIntObj(objResultPtr, type1);
	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
	NEXT_INST_F(1, 1, 1);

    case INST_EQ:
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
	    iResult = (*pc == INST_NEQ);
	    goto foundResult;
	}
	if (valuePtr == value2Ptr) {
	    compare = MP_EQ;
	    goto convertComparison;
	}
	if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	    w2 = *((const Tcl_WideInt *)ptr2);
	    compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
	} else {
	    compare = TclCompareTwoNumbers(valuePtr, value2Ptr);
	}








|







5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
	    iResult = (*pc == INST_NEQ);
	    goto foundResult;
	}
	if (valuePtr == value2Ptr) {
	    compare = MP_EQ;
	    goto convertComparison;
	}
	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	    w2 = *((const Tcl_WideInt *)ptr2);
	    compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
	} else {
	    compare = TclCompareTwoNumbers(valuePtr, value2Ptr);
	}

5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
	    goto gotError;
	}

	/*
	 * Check for common, simple case.
	 */

	if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	    w2 = *((const Tcl_WideInt *)ptr2);

	    switch (*pc) {
	    case INST_MOD:
		if (w2 == 0) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),







|







5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
	    goto gotError;
	}

	/*
	 * Check for common, simple case.
	 */

	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	    w2 = *((const Tcl_WideInt *)ptr2);

	    switch (*pc) {
	    case INST_MOD:
		if (w2 == 0) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
#endif

	/*
	 * Handle (long,long) arithmetic as best we can without going out to
	 * an external function.
	 */

	if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	    w2 = *((const Tcl_WideInt *)ptr2);

	    switch (*pc) {
	    case INST_ADD:
		wResult = w1 + w2;
		/*







|







5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
#endif

	/*
	 * Handle (long,long) arithmetic as best we can without going out to
	 * an external function.
	 */

	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	    w2 = *((const Tcl_WideInt *)ptr2);

	    switch (*pc) {
	    case INST_ADD:
		wResult = w1 + w2;
		/*
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
		NEXT_INST_F(1, 1, 0);

	    case INST_DIV:
		if (w2 == 0) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n",
			    O2S(valuePtr), O2S(value2Ptr)));
		    goto divideByZero;
		} else if ((w1 == LLONG_MIN) && (w2 == -1)) {
		    /*
		     * Can't represent (-LLONG_MIN) as a Tcl_WideInt.
		     */

		    goto overflow;
		}
		wResult = w1 / w2;

		/*







|

|







5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
		NEXT_INST_F(1, 1, 0);

	    case INST_DIV:
		if (w2 == 0) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n",
			    O2S(valuePtr), O2S(value2Ptr)));
		    goto divideByZero;
		} else if ((w1 == WIDE_MIN) && (w2 == -1)) {
		    /*
		     * Can't represent (-WIDE_MIN) as a Tcl_WideInt.
		     */

		    goto overflow;
		}
		wResult = w1 / w2;

		/*
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
	    TRACE_APPEND(("ERROR: illegal type %s\n",
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	if (type1 == TCL_NUMBER_WIDE) {
	    w1 = *((const Tcl_WideInt *) ptr1);
	    if (Tcl_IsShared(valuePtr)) {
		TclNewIntObj(objResultPtr, ~w1);
		TRACE_APPEND(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 1, 1);
	    }
	    TclSetIntObj(valuePtr, ~w1);







|







5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
	    TRACE_APPEND(("ERROR: illegal type %s\n",
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	if (type1 == TCL_NUMBER_INT) {
	    w1 = *((const Tcl_WideInt *) ptr1);
	    if (Tcl_IsShared(valuePtr)) {
		TclNewIntObj(objResultPtr, ~w1);
		TRACE_APPEND(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 1, 1);
	    }
	    TclSetIntObj(valuePtr, ~w1);
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
	    goto gotError;
	}
	switch (type1) {
	case TCL_NUMBER_NAN:
	    /* -NaN => NaN */
	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	case TCL_NUMBER_WIDE:
	    w1 = *((const Tcl_WideInt *) ptr1);
	    if (w1 != LLONG_MIN) {
		if (Tcl_IsShared(valuePtr)) {
		    TclNewIntObj(objResultPtr, -w1);
		    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 1, 1);
		}
		TclSetIntObj(valuePtr, -w1);
		TRACE_APPEND(("%s\n", O2S(valuePtr)));







|

|







5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
	    goto gotError;
	}
	switch (type1) {
	case TCL_NUMBER_NAN:
	    /* -NaN => NaN */
	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	case TCL_NUMBER_INT:
	    w1 = *((const Tcl_WideInt *) ptr1);
	    if (w1 != WIDE_MIN) {
		if (Tcl_IsShared(valuePtr)) {
		    TclNewIntObj(objResultPtr, -w1);
		    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 1, 1);
		}
		TclSetIntObj(valuePtr, -w1);
		TRACE_APPEND(("%s\n", O2S(valuePtr)));
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
	    goto gotError;
	}
	TRACE_APPEND(("OK\n"));
	NEXT_INST_F(1, 1, 0);

    case INST_DICT_GET:
    case INST_DICT_EXISTS: {
	register Tcl_Interp *interp2 = interp;
	register int found;

	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = OBJ_AT_DEPTH(opnd);
	if (*pc == INST_DICT_EXISTS) {
	    interp2 = NULL;
	}







|
|







6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
	    goto gotError;
	}
	TRACE_APPEND(("OK\n"));
	NEXT_INST_F(1, 1, 0);

    case INST_DICT_GET:
    case INST_DICT_EXISTS: {
	Tcl_Interp *interp2 = interp;
	int found;

	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = OBJ_AT_DEPTH(opnd);
	if (*pc == INST_DICT_EXISTS) {
	    interp2 = NULL;
	}
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(5, 2, 1);

    case INST_DICT_FIRST:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = POP_OBJECT();
	searchPtr = ckalloc(sizeof(Tcl_DictSearch));
	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
		&valuePtr, &done) != TCL_OK) {

	    /*
	     * dictPtr is no longer on the stack, and we're not
	     * moving it into the intrep of an iterator.  We need
	     * to drop the refcount [Tcl Bug 9b352768e6].
	     */

	    Tcl_DecrRefCount(dictPtr);
	    ckfree(searchPtr);
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TclNewObj(statePtr);
	statePtr->typePtr = &dictIteratorType;
	statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
	statePtr->internalRep.twoPtrValue.ptr2 = dictPtr;







|










|







6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(5, 2, 1);

    case INST_DICT_FIRST:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = POP_OBJECT();
	searchPtr = Tcl_Alloc(sizeof(Tcl_DictSearch));
	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
		&valuePtr, &done) != TCL_OK) {

	    /*
	     * dictPtr is no longer on the stack, and we're not
	     * moving it into the intrep of an iterator.  We need
	     * to drop the refcount [Tcl Bug 9b352768e6].
	     */

	    Tcl_DecrRefCount(dictPtr);
	    Tcl_Free(searchPtr);
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TclNewObj(statePtr);
	statePtr->typePtr = &dictIteratorType;
	statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
	statePtr->internalRep.twoPtrValue.ptr2 = dictPtr;
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
	}
	Tcl_IncrRefCount(dictPtr);
	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
		&keyPtrPtr) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (length != duiPtr->length) {
	    Tcl_Panic("dictUpdateStart argument length mismatch");
	}
	for (i=0 ; i<length ; i++) {
	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
		    &valuePtr) != TCL_OK) {
		TRACE_ERROR(interp);
		Tcl_DecrRefCount(dictPtr);







|







6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
	}
	Tcl_IncrRefCount(dictPtr);
	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
		&keyPtrPtr) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if ((unsigned int)length != duiPtr->length) {
	    Tcl_Panic("dictUpdateStart argument length mismatch");
	}
	for (i=0 ; i<length ; i++) {
	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
		    &valuePtr) != TCL_OK) {
		TRACE_ERROR(interp);
		Tcl_DecrRefCount(dictPtr);
7170
7171
7172
7173
7174
7175
7176

7177
7178
7179
7180
7181
7182
7183
7184
7185
7186
7187
7188

    checkForCatch:
	if (iPtr->execEnvPtr->rewind) {
	    goto abnormalReturn;
	}
	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	    const unsigned char *pcBeg;


	    bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL);
	    DECACHE_STACK_INFO();
	    TclLogCommandInfo(interp, codePtr->source, bytes,
		    bytes ? length : 0, pcBeg, tosPtr);
	    CACHE_STACK_INFO();
	}
	iPtr->flags &= ~ERR_ALREADY_LOGGED;

	/*
	 * Clear all expansions that may have started after the last
	 * INST_BEGIN_CATCH.







>

|


|







7161
7162
7163
7164
7165
7166
7167
7168
7169
7170
7171
7172
7173
7174
7175
7176
7177
7178
7179
7180

    checkForCatch:
	if (iPtr->execEnvPtr->rewind) {
	    goto abnormalReturn;
	}
	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	    const unsigned char *pcBeg;
	    size_t xxx1length;

	    bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, &pcBeg, NULL);
	    DECACHE_STACK_INFO();
	    TclLogCommandInfo(interp, codePtr->source, bytes,
		    bytes ? xxx1length : 0, pcBeg, tosPtr);
	    CACHE_STACK_INFO();
	}
	iPtr->flags &= ~ERR_ALREADY_LOGGED;

	/*
	 * Clear all expansions that may have started after the last
	 * INST_BEGIN_CATCH.
7336
7337
7338
7339
7340
7341
7342

7343
7344
7345
7346
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367
7368
7369

     * case INST_START_CMD:
     */

	instStartCmdFailed:
	{
	    const char *bytes;


	    checkInterp = 1;
	    length = 0;

	    /*
	     * We used to switch to direct eval; for NRE-awareness we now
	     * compile and eval the command so that this evaluation does not
	     * add a new TEBC instance. [Bug 2910748]
	     */

	    if (TclInterpReady(interp) == TCL_ERROR) {
		goto gotError;
	    }

	    codePtr->flags |= TCL_BYTECODE_RECOMPILE;
	    bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL);
	    opnd = TclGetUInt4AtPtr(pc+1);
	    pc += (opnd-1);
	    assert(bytes);
	    PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
	    goto instEvalStk;
	}
}

#undef codePtr
#undef iPtr
#undef bcFramePtr







>


|












|



|







7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344
7345
7346
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362

     * case INST_START_CMD:
     */

	instStartCmdFailed:
	{
	    const char *bytes;
	    size_t xxx1length;

	    checkInterp = 1;
	    xxx1length = 0;

	    /*
	     * We used to switch to direct eval; for NRE-awareness we now
	     * compile and eval the command so that this evaluation does not
	     * add a new TEBC instance. [Bug 2910748]
	     */

	    if (TclInterpReady(interp) == TCL_ERROR) {
		goto gotError;
	    }

	    codePtr->flags |= TCL_BYTECODE_RECOMPILE;
	    bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, NULL, NULL);
	    opnd = TclGetUInt4AtPtr(pc+1);
	    pc += (opnd-1);
	    assert(bytes);
	    PUSH_OBJECT(Tcl_NewStringObj(bytes, xxx1length));
	    goto instEvalStk;
	}
}

#undef codePtr
#undef iPtr
#undef bcFramePtr
7495
7496
7497
7498
7499
7500
7501
7502
7503
7504
7505
7506
7507
7508
7509
7510
7511
7512
7513
7514
7515
7516
7517
7518
7519
7520
7521
7522
    (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);

    switch (opcode) {
    case INST_MOD:
	/* TODO: Attempts to re-use unshared operands on stack */

	w2 = 0;			/* silence gcc warning */
	if (type2 == TCL_NUMBER_WIDE) {
	    w2 = *((const Tcl_WideInt *)ptr2);
	    if (w2 == 0) {
		return DIVIDED_BY_ZERO;
	    }
	    if ((w2 == 1) || (w2 == -1)) {
		/*
		 * Div. by |1| always yields remainder of 0.
		 */

		return constants[0];
	    }
	}
	if (type1 == TCL_NUMBER_WIDE) {
	    w1 = *((const Tcl_WideInt *)ptr1);

	    if (w1 == 0) {
		/*
		 * 0 % (non-zero) always yields remainder of 0.
		 */








|












|







7488
7489
7490
7491
7492
7493
7494
7495
7496
7497
7498
7499
7500
7501
7502
7503
7504
7505
7506
7507
7508
7509
7510
7511
7512
7513
7514
7515
    (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);

    switch (opcode) {
    case INST_MOD:
	/* TODO: Attempts to re-use unshared operands on stack */

	w2 = 0;			/* silence gcc warning */
	if (type2 == TCL_NUMBER_INT) {
	    w2 = *((const Tcl_WideInt *)ptr2);
	    if (w2 == 0) {
		return DIVIDED_BY_ZERO;
	    }
	    if ((w2 == 1) || (w2 == -1)) {
		/*
		 * Div. by |1| always yields remainder of 0.
		 */

		return constants[0];
	    }
	}
	if (type1 == TCL_NUMBER_INT) {
	    w1 = *((const Tcl_WideInt *)ptr1);

	    if (w1 == 0) {
		/*
		 * 0 % (non-zero) always yields remainder of 0.
		 */

7586
7587
7588
7589
7590
7591
7592
7593
7594
7595
7596
7597
7598
7599
7600
    case INST_LSHIFT:
    case INST_RSHIFT: {
	/*
	 * Reject negative shift argument.
	 */

	switch (type2) {
	case TCL_NUMBER_WIDE:
	    invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
	    break;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    invalid = mp_isneg(&big2);
	    mp_clear(&big2);
	    break;







|







7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
7589
7590
7591
7592
7593
    case INST_LSHIFT:
    case INST_RSHIFT: {
	/*
	 * Reject negative shift argument.
	 */

	switch (type2) {
	case TCL_NUMBER_INT:
	    invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
	    break;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    invalid = mp_isneg(&big2);
	    mp_clear(&big2);
	    break;
7608
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
7627
7628
7629
7630
7631
7632
7633
7634
7635
	    return GENERAL_ARITHMETIC_ERROR;
	}

	/*
	 * Zero shifted any number of bits is still zero.
	 */

	if ((type1==TCL_NUMBER_WIDE) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) {
	    return constants[0];
	}

	if (opcode == INST_LSHIFT) {
	    /*
	     * Large left shifts create integer overflow.
	     *
	     * BEWARE! Can't use Tcl_GetIntFromObj() here because that
	     * converts values in the (unsigned) range to their signed int
	     * counterparts, leading to incorrect results.
	     */

	    if ((type2 != TCL_NUMBER_WIDE)
		    || (*((const Tcl_WideInt *)ptr2) > INT_MAX)) {
		/*
		 * Technically, we could hold the value (1 << (INT_MAX+1)) in
		 * an mp_int, but since we're using mp_mul_2d() to do the
		 * work, and it takes only an int argument, that's a good
		 * place to draw the line.
		 */







|












|







7601
7602
7603
7604
7605
7606
7607
7608
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
7627
7628
	    return GENERAL_ARITHMETIC_ERROR;
	}

	/*
	 * Zero shifted any number of bits is still zero.
	 */

	if ((type1==TCL_NUMBER_INT) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) {
	    return constants[0];
	}

	if (opcode == INST_LSHIFT) {
	    /*
	     * Large left shifts create integer overflow.
	     *
	     * BEWARE! Can't use Tcl_GetIntFromObj() here because that
	     * converts values in the (unsigned) range to their signed int
	     * counterparts, leading to incorrect results.
	     */

	    if ((type2 != TCL_NUMBER_INT)
		    || (*((const Tcl_WideInt *)ptr2) > INT_MAX)) {
		/*
		 * Technically, we could hold the value (1 << (INT_MAX+1)) in
		 * an mp_int, but since we're using mp_mul_2d() to do the
		 * work, and it takes only an int argument, that's a good
		 * place to draw the line.
		 */
7654
7655
7656
7657
7658
7659
7660
7661
7662
7663
7664
7665
7666
7667
7668
7669
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
		}
	    }
	} else {
	    /*
	     * Quickly force large right shifts to 0 or -1.
	     */

	    if ((type2 != TCL_NUMBER_WIDE)
		    || (*(const Tcl_WideInt *)ptr2 > INT_MAX)) {
		/*
		 * Again, technically, the value to be shifted could be an
		 * mp_int so huge that a right shift by (INT_MAX+1) bits could
		 * not take us to the result of 0 or -1, but since we're using
		 * mp_div_2d to do the work, and it takes only an int
		 * argument, we draw the line there.
		 */

		switch (type1) {
		case TCL_NUMBER_WIDE:
		    zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
		    break;
		case TCL_NUMBER_BIG:
		    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
		    zero = (!mp_isneg(&big1));
		    mp_clear(&big1);
		    break;







|










|







7647
7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
7661
7662
7663
7664
7665
7666
7667
7668
7669
7670
7671
7672
		}
	    }
	} else {
	    /*
	     * Quickly force large right shifts to 0 or -1.
	     */

	    if ((type2 != TCL_NUMBER_INT)
		    || (*(const Tcl_WideInt *)ptr2 > INT_MAX)) {
		/*
		 * Again, technically, the value to be shifted could be an
		 * mp_int so huge that a right shift by (INT_MAX+1) bits could
		 * not take us to the result of 0 or -1, but since we're using
		 * mp_div_2d to do the work, and it takes only an int
		 * argument, we draw the line there.
		 */

		switch (type1) {
		case TCL_NUMBER_INT:
		    zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
		    break;
		case TCL_NUMBER_BIG:
		    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
		    zero = (!mp_isneg(&big1));
		    mp_clear(&big1);
		    break;
7688
7689
7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
	    }
	    shift = (int)(*(const Tcl_WideInt *)ptr2);

	    /*
	     * Handle shifts within the native wide range.
	     */

	    if (type1 == TCL_NUMBER_WIDE) {
		w1 = *(const Tcl_WideInt *)ptr1;
		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
		    if (w1 >= (Tcl_WideInt)0) {
			return constants[0];
		    }
		    WIDE_RESULT(-1);
		}







|







7681
7682
7683
7684
7685
7686
7687
7688
7689
7690
7691
7692
7693
7694
7695
	    }
	    shift = (int)(*(const Tcl_WideInt *)ptr2);

	    /*
	     * Handle shifts within the native wide range.
	     */

	    if (type1 == TCL_NUMBER_INT) {
		w1 = *(const Tcl_WideInt *)ptr1;
		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
		    if (w1 >= (Tcl_WideInt)0) {
			return constants[0];
		    }
		    WIDE_RESULT(-1);
		}
7865
7866
7867
7868
7869
7870
7871
7872
7873
7874
7875
7876
7877
7878
7879
	    }

	    mp_clear(&big1);
	    mp_clear(&big2);
	    BIG_RESULT(&bigResult);
	}

	if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);

	    switch (opcode) {
	    case INST_BITAND:
		wResult = w1 & w2;
		break;







|







7858
7859
7860
7861
7862
7863
7864
7865
7866
7867
7868
7869
7870
7871
7872
	    }

	    mp_clear(&big1);
	    mp_clear(&big2);
	    BIG_RESULT(&bigResult);
	}

	if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT)) {
	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);

	    switch (opcode) {
	    case INST_BITAND:
		wResult = w1 & w2;
		break;
7919
7920
7921
7922
7923
7924
7925
7926
7927
7928
7929
7930
7931
7932
7933
7934
7935
7936
7937
7938
7939
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949
7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960
7961
7962
7963
7964
7965
7966
7967
7968
7969
	    if (d1==0.0 && d2<0.0) {
		return EXPONENT_OF_ZERO;
	    }
	    dResult = pow(d1, d2);
	    goto doubleResult;
	}
	w2 = 0;
	if (type2 == TCL_NUMBER_WIDE) {
	    w2 = *((const Tcl_WideInt *) ptr2);
	    if (w2 == 0) {
		/*
		 * Anything to the zero power is 1.
		 */

		return constants[1];
	    } else if (w2 == 1) {
		/*
		 * Anything to the first power is itself
		 */

		return NULL;
	    }
	}

	switch (type2) {
	case TCL_NUMBER_WIDE:
	    w2 = *((const Tcl_WideInt *)ptr2);
	    negativeExponent = (w2 < 0);
	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
	    break;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    negativeExponent = mp_isneg(&big2);
	    mp_mod_2d(&big2, 1, &big2);
	    oddExponent = !mp_iszero(&big2);
	    mp_clear(&big2);
	    break;
	}

	if (type1 == TCL_NUMBER_WIDE) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	}
	if (negativeExponent) {
	    if (type1 == TCL_NUMBER_WIDE) {
		switch (w1) {
		case 0:
		    /*
		     * Zero to a negative power is div by zero error.
		     */

		    return EXPONENT_OF_ZERO;







|

















|













|



|







7912
7913
7914
7915
7916
7917
7918
7919
7920
7921
7922
7923
7924
7925
7926
7927
7928
7929
7930
7931
7932
7933
7934
7935
7936
7937
7938
7939
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949
7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960
7961
7962
	    if (d1==0.0 && d2<0.0) {
		return EXPONENT_OF_ZERO;
	    }
	    dResult = pow(d1, d2);
	    goto doubleResult;
	}
	w2 = 0;
	if (type2 == TCL_NUMBER_INT) {
	    w2 = *((const Tcl_WideInt *) ptr2);
	    if (w2 == 0) {
		/*
		 * Anything to the zero power is 1.
		 */

		return constants[1];
	    } else if (w2 == 1) {
		/*
		 * Anything to the first power is itself
		 */

		return NULL;
	    }
	}

	switch (type2) {
	case TCL_NUMBER_INT:
	    w2 = *((const Tcl_WideInt *)ptr2);
	    negativeExponent = (w2 < 0);
	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
	    break;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    negativeExponent = mp_isneg(&big2);
	    mp_mod_2d(&big2, 1, &big2);
	    oddExponent = !mp_iszero(&big2);
	    mp_clear(&big2);
	    break;
	}

	if (type1 == TCL_NUMBER_INT) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	}
	if (negativeExponent) {
	    if (type1 == TCL_NUMBER_INT) {
		switch (w1) {
		case 0:
		    /*
		     * Zero to a negative power is div by zero error.
		     */

		    return EXPONENT_OF_ZERO;
7985
7986
7987
7988
7989
7990
7991
7992
7993
7994
7995
7996
7997
7998
7999
	     * Integers with magnitude greater than 1 raise to a negative
	     * power yield the answer zero (see TIP 123).
	     */

	    return constants[0];
	}

	if (type1 == TCL_NUMBER_WIDE) {
	    switch (w1) {
	    case 0:
		/*
		 * Zero to a positive power is zero.
		 */

		return constants[0];







|







7978
7979
7980
7981
7982
7983
7984
7985
7986
7987
7988
7989
7990
7991
7992
	     * Integers with magnitude greater than 1 raise to a negative
	     * power yield the answer zero (see TIP 123).
	     */

	    return constants[0];
	}

	if (type1 == TCL_NUMBER_INT) {
	    switch (w1) {
	    case 0:
		/*
		 * Zero to a positive power is zero.
		 */

		return constants[0];
8012
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022
8023
8024
8025
8026
8027
8028
8029
8030
8031
8032
8033
8034
8035
8036
	}

	/*
	 * We refuse to accept exponent arguments that exceed one mp_digit
	 * which means the max exponent value is 2**28-1 = 0x0fffffff =
	 * 268435455, which fits into a signed 32 bit int which is within the
	 * range of the long int type. This means any numeric Tcl_Obj value
	 * not using TCL_NUMBER_WIDE type must hold a value larger than we
	 * accept.
	 */

	if (type2 != TCL_NUMBER_WIDE) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}

	if (type1 == TCL_NUMBER_WIDE) {
	    if (w1 == 2) {
		/*
		 * Reduce small powers of 2 to shifts.
		 */

		if ((Tcl_WideUInt) w2 < (Tcl_WideUInt) CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
		    WIDE_RESULT(((Tcl_WideInt) 1) << (int)w2);







|



|





|







8005
8006
8007
8008
8009
8010
8011
8012
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022
8023
8024
8025
8026
8027
8028
8029
	}

	/*
	 * We refuse to accept exponent arguments that exceed one mp_digit
	 * which means the max exponent value is 2**28-1 = 0x0fffffff =
	 * 268435455, which fits into a signed 32 bit int which is within the
	 * range of the long int type. This means any numeric Tcl_Obj value
	 * not using TCL_NUMBER_INT type must hold a value larger than we
	 * accept.
	 */

	if (type2 != TCL_NUMBER_INT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}

	if (type1 == TCL_NUMBER_INT) {
	    if (w1 == 2) {
		/*
		 * Reduce small powers of 2 to shifts.
		 */

		if ((Tcl_WideUInt) w2 < (Tcl_WideUInt) CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
		    WIDE_RESULT(((Tcl_WideInt) 1) << (int)w2);
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
8057
8058
8059
8060

		if ((Tcl_WideUInt)w2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
		    WIDE_RESULT(signum * (((Tcl_WideInt) 1) << (int) w2));
		}
		goto overflowExpon;
	    }
	}
	if (type1 == TCL_NUMBER_WIDE) {
	    w1 = *((const Tcl_WideInt *) ptr1);
	} else {
	    goto overflowExpon;
	}
	if (w2 - 2 < (long)MaxBase64Size
		&& w1 <=  MaxBase64[w2 - 2]
		&& w1 >= -MaxBase64[w2 - 2]) {







|







8039
8040
8041
8042
8043
8044
8045
8046
8047
8048
8049
8050
8051
8052
8053

		if ((Tcl_WideUInt)w2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
		    WIDE_RESULT(signum * (((Tcl_WideInt) 1) << (int) w2));
		}
		goto overflowExpon;
	    }
	}
	if (type1 == TCL_NUMBER_INT) {
	    w1 = *((const Tcl_WideInt *) ptr1);
	} else {
	    goto overflowExpon;
	}
	if (w2 - 2 < (long)MaxBase64Size
		&& w1 <=  MaxBase64[w2 - 2]
		&& w1 >= -MaxBase64[w2 - 2]) {
8246
8247
8248
8249
8250
8251
8252
8253
8254
8255
8256
8257
8258
8259
8260
8261
8262
8263
8264
8265
8266
8267
8268
8269
8270
8271
8272
8273
8274
	if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);

	    switch (opcode) {
	    case INST_ADD:
		wResult = w1 + w2;
		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
		{
		    /*
		     * Check for overflow.
		     */

		    if (Overflowing(w1, w2, wResult)) {
			goto overflowBasic;
		    }
		}
		break;

	    case INST_SUB:
		wResult = w1 - w2;
		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
		{
		    /*
		     * Must check for overflow. The macro tests for overflows
		     * in sums by looking at the sign bits. As we have a
		     * subtraction here, we are adding -w2. As -w2 could in
		     * turn overflow, we test with ~w2 instead: it has the
		     * opposite sign bit to w2 so it does the job. Note that







|













|







8239
8240
8241
8242
8243
8244
8245
8246
8247
8248
8249
8250
8251
8252
8253
8254
8255
8256
8257
8258
8259
8260
8261
8262
8263
8264
8265
8266
8267
	if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);

	    switch (opcode) {
	    case INST_ADD:
		wResult = w1 + w2;
		if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
		{
		    /*
		     * Check for overflow.
		     */

		    if (Overflowing(w1, w2, wResult)) {
			goto overflowBasic;
		    }
		}
		break;

	    case INST_SUB:
		wResult = w1 - w2;
		if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
		{
		    /*
		     * Must check for overflow. The macro tests for overflows
		     * in sums by looking at the sign bits. As we have a
		     * subtraction here, we are adding -w2. As -w2 could in
		     * turn overflow, we test with ~w2 instead: it has the
		     * opposite sign bit to w2 so it does the job. Note that
8292
8293
8294
8295
8296
8297
8298
8299
8300
8301
8302
8303
8304
8305
8306
8307
8308
8309

	    case INST_DIV:
		if (w2 == 0) {
		    return DIVIDED_BY_ZERO;
		}

		/*
		 * Need a bignum to represent (LLONG_MIN / -1)
		 */

		if ((w1 == LLONG_MIN) && (w2 == -1)) {
		    goto overflowBasic;
		}
		wResult = w1 / w2;

		/*
		 * Force Tcl's integer division rules.
		 * TODO: examine for logic simplification







|


|







8285
8286
8287
8288
8289
8290
8291
8292
8293
8294
8295
8296
8297
8298
8299
8300
8301
8302

	    case INST_DIV:
		if (w2 == 0) {
		    return DIVIDED_BY_ZERO;
		}

		/*
		 * Need a bignum to represent (WIDE_MIN / -1)
		 */

		if ((w1 == WIDE_MIN) && (w2 == -1)) {
		    goto overflowBasic;
		}
		wResult = w1 / w2;

		/*
		 * Force Tcl's integer division rules.
		 * TODO: examine for logic simplification
8383
8384
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396
8397
8398
8399
8400
8401
8402
8403
8404
8405
8406
8407
8408
8409
8410
8411
8412
    mp_int big;
    Tcl_Obj *objResultPtr;

    (void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);

    switch (opcode) {
    case INST_BITNOT:
	if (type == TCL_NUMBER_WIDE) {
	    w = *((const Tcl_WideInt *) ptr);
	    WIDE_RESULT(~w);
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
	/* ~a = - a - 1 */
	mp_neg(&big, &big);
	mp_sub_d(&big, 1, &big);
	BIG_RESULT(&big);
    case INST_UMINUS:
	switch (type) {
	case TCL_NUMBER_DOUBLE:
	    DOUBLE_RESULT(-(*((const double *) ptr)));
	case TCL_NUMBER_WIDE:
	    w = *((const Tcl_WideInt *) ptr);
	    if (w != LLONG_MIN) {
		WIDE_RESULT(-w);
	    }
	    TclInitBignumFromWideInt(&big, w);
	    break;
	default:
	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
	}







|












|

|







8376
8377
8378
8379
8380
8381
8382
8383
8384
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396
8397
8398
8399
8400
8401
8402
8403
8404
8405
    mp_int big;
    Tcl_Obj *objResultPtr;

    (void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);

    switch (opcode) {
    case INST_BITNOT:
	if (type == TCL_NUMBER_INT) {
	    w = *((const Tcl_WideInt *) ptr);
	    WIDE_RESULT(~w);
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
	/* ~a = - a - 1 */
	mp_neg(&big, &big);
	mp_sub_d(&big, 1, &big);
	BIG_RESULT(&big);
    case INST_UMINUS:
	switch (type) {
	case TCL_NUMBER_DOUBLE:
	    DOUBLE_RESULT(-(*((const double *) ptr)));
	case TCL_NUMBER_INT:
	    w = *((const Tcl_WideInt *) ptr);
	    if (w != WIDE_MIN) {
		WIDE_RESULT(-w);
	    }
	    TclInitBignumFromWideInt(&big, w);
	    break;
	default:
	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
	}
8450
8451
8452
8453
8454
8455
8456
8457
8458
8459
8460
8461
8462
8463
8464
8465
8466
8467
    double d1, d2, tmp;
    Tcl_WideInt w1, w2;

    (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
    (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);

    switch (type1) {
    case TCL_NUMBER_WIDE:
	w1 = *((const Tcl_WideInt *)ptr1);
	switch (type2) {
	case TCL_NUMBER_WIDE:
	    w2 = *((const Tcl_WideInt *)ptr2);
	wideCompare:
	    return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	    d1 = (double) w1;








|


|







8443
8444
8445
8446
8447
8448
8449
8450
8451
8452
8453
8454
8455
8456
8457
8458
8459
8460
    double d1, d2, tmp;
    Tcl_WideInt w1, w2;

    (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
    (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);

    switch (type1) {
    case TCL_NUMBER_INT:
	w1 = *((const Tcl_WideInt *)ptr1);
	switch (type2) {
	case TCL_NUMBER_INT:
	    w2 = *((const Tcl_WideInt *)ptr2);
	wideCompare:
	    return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	    d1 = (double) w1;

8484
8485
8486
8487
8488
8489
8490
8491
8492
8493
8494
8495
8496
8497
8498
8499
8500
8501
	     *	  expr 20000000000000003 < 20000000000000004.0
	     * right. Converting the first argument to double will yield two
	     * double values that are equivalent within double precision.
	     * Converting the double to an integer gets done exactly, then
	     * integer comparison can tell the difference.
	     */

	    if (d2 < (double)LLONG_MIN) {
		return MP_GT;
	    }
	    if (d2 > (double)LLONG_MAX) {
		return MP_LT;
	    }
	    w2 = (Tcl_WideInt) d2;
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if (mp_isneg(&big2)) {







|


|







8477
8478
8479
8480
8481
8482
8483
8484
8485
8486
8487
8488
8489
8490
8491
8492
8493
8494
	     *	  expr 20000000000000003 < 20000000000000004.0
	     * right. Converting the first argument to double will yield two
	     * double values that are equivalent within double precision.
	     * Converting the double to an integer gets done exactly, then
	     * integer comparison can tell the difference.
	     */

	    if (d2 < (double)WIDE_MIN) {
		return MP_GT;
	    }
	    if (d2 > (double)WIDE_MAX) {
		return MP_LT;
	    }
	    w2 = (Tcl_WideInt) d2;
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if (mp_isneg(&big2)) {
8510
8511
8512
8513
8514
8515
8516
8517
8518
8519
8520
8521
8522
8523
8524
8525
8526
8527
8528
8529
8530
8531
8532
8533
8534
8535
8536
8537
8538
8539
8540
8541
8542
8543
8544
    case TCL_NUMBER_DOUBLE:
	d1 = *((const double *)ptr1);
	switch (type2) {
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	doubleCompare:
	    return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
	case TCL_NUMBER_WIDE:
	    w2 = *((const Tcl_WideInt *)ptr2);
	    d2 = (double) w2;
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
		    || w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
		goto doubleCompare;
	    }
	    if (d1 < (double)LLONG_MIN) {
		return MP_LT;
	    }
	    if (d1 > (double)LLONG_MAX) {
		return MP_GT;
	    }
	    w1 = (Tcl_WideInt) d1;
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    if (TclIsInfinite(d1)) {
		return (d1 > 0.0) ? MP_GT : MP_LT;
	    }
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if ((d1 < (double)LLONG_MAX) && (d1 > (double)LLONG_MIN)) {
		if (mp_isneg(&big2)) {
		    compare = MP_GT;
		} else {
		    compare = MP_LT;
		}
		mp_clear(&big2);
		return compare;







|






|


|









|







8503
8504
8505
8506
8507
8508
8509
8510
8511
8512
8513
8514
8515
8516
8517
8518
8519
8520
8521
8522
8523
8524
8525
8526
8527
8528
8529
8530
8531
8532
8533
8534
8535
8536
8537
    case TCL_NUMBER_DOUBLE:
	d1 = *((const double *)ptr1);
	switch (type2) {
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	doubleCompare:
	    return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
	case TCL_NUMBER_INT:
	    w2 = *((const Tcl_WideInt *)ptr2);
	    d2 = (double) w2;
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
		    || w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
		goto doubleCompare;
	    }
	    if (d1 < (double)WIDE_MIN) {
		return MP_LT;
	    }
	    if (d1 > (double)WIDE_MAX) {
		return MP_GT;
	    }
	    w1 = (Tcl_WideInt) d1;
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    if (TclIsInfinite(d1)) {
		return (d1 > 0.0) ? MP_GT : MP_LT;
	    }
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) {
		if (mp_isneg(&big2)) {
		    compare = MP_GT;
		} else {
		    compare = MP_LT;
		}
		mp_clear(&big2);
		return compare;
8552
8553
8554
8555
8556
8557
8558
8559
8560
8561
8562
8563
8564
8565
8566
8567
8568
8569
8570
8571
8572
8573
8574
8575
8576
8577
	    Tcl_InitBignumFromDouble(NULL, d1, &big1);
	    goto bigCompare;
	}

    case TCL_NUMBER_BIG:
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	switch (type2) {
	case TCL_NUMBER_WIDE:
	    compare = mp_cmp_d(&big1, 0);
	    mp_clear(&big1);
	    return compare;
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	    if (TclIsInfinite(d2)) {
		compare = (d2 > 0.0) ? MP_LT : MP_GT;
		mp_clear(&big1);
		return compare;
	    }
	    if ((d2 < (double)LLONG_MAX) && (d2 > (double)LLONG_MIN)) {
		compare = mp_cmp_d(&big1, 0);
		mp_clear(&big1);
		return compare;
	    }
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
		    && modf(d2, &tmp) != 0.0) {
		d1 = TclBignumToDouble(&big1);







|










|







8545
8546
8547
8548
8549
8550
8551
8552
8553
8554
8555
8556
8557
8558
8559
8560
8561
8562
8563
8564
8565
8566
8567
8568
8569
8570
	    Tcl_InitBignumFromDouble(NULL, d1, &big1);
	    goto bigCompare;
	}

    case TCL_NUMBER_BIG:
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	switch (type2) {
	case TCL_NUMBER_INT:
	    compare = mp_cmp_d(&big1, 0);
	    mp_clear(&big1);
	    return compare;
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	    if (TclIsInfinite(d2)) {
		compare = (d2 > 0.0) ? MP_LT : MP_GT;
		mp_clear(&big1);
		return compare;
	    }
	    if ((d2 < (double)WIDE_MAX) && (d2 > (double)WIDE_MIN)) {
		compare = mp_cmp_d(&big1, 0);
		mp_clear(&big1);
		return compare;
	    }
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
		    && modf(d2, &tmp) != 0.0) {
		d1 = TclBignumToDouble(&big1);
8611
8612
8613
8614
8615
8616
8617
8618
8619
8620
8621
8622
8623
8624
8625
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
PrintByteCodeInfo(
    register ByteCode *codePtr)	/* The bytecode whose summary is printed to
				 * stdout. */
{
    Proc *procPtr = codePtr->procPtr;
    Interp *iPtr = (Interp *) *codePtr->interpHandle;

    fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n",
	    codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr,







|







8604
8605
8606
8607
8608
8609
8610
8611
8612
8613
8614
8615
8616
8617
8618
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
PrintByteCodeInfo(
    ByteCode *codePtr)	/* The bytecode whose summary is printed to
				 * stdout. */
{
    Proc *procPtr = codePtr->procPtr;
    Interp *iPtr = (Interp *) *codePtr->interpHandle;

    fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n",
	    codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr,
8645
8646
8647
8648
8649
8650
8651
8652
8653
8654
8655
8656
8657
8658
8659
	    (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
	    (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
	    (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */
    if (procPtr != NULL) {
	fprintf(stdout,
		"  Proc 0x%p, refCt %zd, args %d, compiled locals %d\n",
		procPtr, procPtr->refCount, procPtr->numArgs,
		procPtr->numCompiledLocals);
    }
}
#endif /* TCL_COMPILE_DEBUG */

/*







|







8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649
8650
8651
8652
	    (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
	    (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
	    (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */
    if (procPtr != NULL) {
	fprintf(stdout,
		"  Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %d, compiled locals %d\n",
		procPtr, procPtr->refCount, procPtr->numArgs,
		procPtr->numCompiledLocals);
    }
}
#endif /* TCL_COMPILE_DEBUG */

/*
8674
8675
8676
8677
8678
8679
8680
8681
8682
8683
8684
8685
8686
8687
8688
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_COMPILE_DEBUG
static void
ValidatePcAndStackTop(
    register ByteCode *codePtr,	/* The bytecode whose summary is printed to
				 * stdout. */
    const unsigned char *pc,	/* Points to first byte of a bytecode
				 * instruction. The program counter. */
    int stackTop,		/* Current stack top. Must be between
				 * stackLowerBound and stackUpperBound
				 * (inclusive). */
    int checkStack)		/* 0 if the stack depth check should be







|







8667
8668
8669
8670
8671
8672
8673
8674
8675
8676
8677
8678
8679
8680
8681
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_COMPILE_DEBUG
static void
ValidatePcAndStackTop(
    ByteCode *codePtr,	/* The bytecode whose summary is printed to
				 * stdout. */
    const unsigned char *pc,	/* Points to first byte of a bytecode
				 * instruction. The program counter. */
    int stackTop,		/* Current stack top. Must be between
				 * stackLowerBound and stackUpperBound
				 * (inclusive). */
    int checkStack)		/* 0 if the stack depth check should be
8853
8854
8855
8856
8857
8858
8859
8860

8861
8862
8863
8864
8865
8866
8867
	/*
	 * We now have the command. We can get the srcOffset back and from
	 * there find the list of word locations for this command.
	 */

	ExtCmdLoc *eclPtr;
	ECL *locPtr = NULL;
	int srcOffset, i;

	Interp *iPtr = (Interp *) *codePtr->interpHandle;
	Tcl_HashEntry *hePtr =
		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);

	if (!hePtr) {
	    return;
	}







|
>







8846
8847
8848
8849
8850
8851
8852
8853
8854
8855
8856
8857
8858
8859
8860
8861
	/*
	 * We now have the command. We can get the srcOffset back and from
	 * there find the list of word locations for this command.
	 */

	ExtCmdLoc *eclPtr;
	ECL *locPtr = NULL;
	size_t srcOffset;
	int i;
	Interp *iPtr = (Interp *) *codePtr->interpHandle;
	Tcl_HashEntry *hePtr =
		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);

	if (!hePtr) {
	    return;
	}
8899
8900
8901
8902
8903
8904
8905
8906
8907
8908
8909
8910
8911
8912
8913
8914
8915
8916
8917
8918
8919
8920
8921
8922
8923
8924
8925
8926
8927
8928
8929
8930
8931
8932
8933
8934
GetSrcInfoForPc(
    const unsigned char *pc,	/* The program counter value for which to
				 * return the closest command's source info.
				 * This points within a bytecode instruction
				 * in codePtr's code. */
    ByteCode *codePtr,		/* The bytecode sequence in which to look up
				 * the command source for the pc. */
    int *lengthPtr,		/* If non-NULL, the location where the length
				 * of the command's source should be stored.
				 * If NULL, no length is stored. */
    const unsigned char **pcBeg,/* If non-NULL, the bytecode location
				 * where the current instruction starts.
				 * If NULL; no pointer is stored. */
    int *cmdIdxPtr)		/* If non-NULL, the location where the index
				 * of the command containing the pc should
				 * be stored. */
{
    register int pcOffset = (pc - codePtr->codeStart);
    int numCmds = codePtr->numCommands;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
    int bestCmdIdx = -1;

    /* The pc must point within the bytecode */
    assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));

    /*
     * Decode the code and source offset and length for each command. The
     * closest enclosing command is the last one whose code started before
     * pcOffset.
     */








|









|
|


|






|







8893
8894
8895
8896
8897
8898
8899
8900
8901
8902
8903
8904
8905
8906
8907
8908
8909
8910
8911
8912
8913
8914
8915
8916
8917
8918
8919
8920
8921
8922
8923
8924
8925
8926
8927
8928
GetSrcInfoForPc(
    const unsigned char *pc,	/* The program counter value for which to
				 * return the closest command's source info.
				 * This points within a bytecode instruction
				 * in codePtr's code. */
    ByteCode *codePtr,		/* The bytecode sequence in which to look up
				 * the command source for the pc. */
    size_t *lengthPtr,		/* If non-NULL, the location where the length
				 * of the command's source should be stored.
				 * If NULL, no length is stored. */
    const unsigned char **pcBeg,/* If non-NULL, the bytecode location
				 * where the current instruction starts.
				 * If NULL; no pointer is stored. */
    int *cmdIdxPtr)		/* If non-NULL, the location where the index
				 * of the command containing the pc should
				 * be stored. */
{
    size_t pcOffset = (size_t)(pc - codePtr->codeStart);
    size_t numCmds = codePtr->numCommands;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    size_t codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
    int bestCmdIdx = -1;

    /* The pc must point within the bytecode */
    assert (pcOffset < codePtr->numCodeBytes);

    /*
     * Decode the code and source offset and length for each command. The
     * closest enclosing command is the last one whose code started before
     * pcOffset.
     */

9062
9063
9064
9065
9066
9067
9068
9069
9070
9071
9072
9073
9074
9075
9076
9077
9078
				 * for loop ranges that define a continue
				 * point or a catch range. */
    ByteCode *codePtr)		/* Points to the ByteCode in which to search
				 * for the enclosing ExceptionRange. */
{
    ExceptionRange *rangeArrayPtr;
    int numRanges = codePtr->numExceptRanges;
    register ExceptionRange *rangePtr;
    int pcOffset = pc - codePtr->codeStart;
    register int start;

    if (numRanges == 0) {
	return NULL;
    }

    /*
     * This exploits peculiarities of our compiler: nested ranges are always







|
|
|







9056
9057
9058
9059
9060
9061
9062
9063
9064
9065
9066
9067
9068
9069
9070
9071
9072
				 * for loop ranges that define a continue
				 * point or a catch range. */
    ByteCode *codePtr)		/* Points to the ByteCode in which to search
				 * for the enclosing ExceptionRange. */
{
    ExceptionRange *rangeArrayPtr;
    int numRanges = codePtr->numExceptRanges;
    ExceptionRange *rangePtr;
    unsigned int pcOffset = pc - codePtr->codeStart;
    unsigned int start;

    if (numRanges == 0) {
	return NULL;
    }

    /*
     * This exploits peculiarities of our compiler: nested ranges are always
9196
9197
9198
9199
9200
9201
9202
9203
9204
9205
9206
9207
9208
9209
9210
9211
9212
9213
9214
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclLog2(
    register int value)		/* The integer for which to compute the log
				 * base 2. */
{
    register int n = value;
    register int result = 0;

    while (n > 1) {
	n = n >> 1;
	result++;
    }
    return result;
}







|


|
|







9190
9191
9192
9193
9194
9195
9196
9197
9198
9199
9200
9201
9202
9203
9204
9205
9206
9207
9208
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclLog2(
    int value)		/* The integer for which to compute the log
				 * base 2. */
{
    int n = value;
    int result = 0;

    while (n > 1) {
	n = n >> 1;
	result++;
    }
    return result;
}
9507
9508
9509
9510
9511
9512
9513
9514
9515
9516
9517
9518
9519
9520
9521
	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
    }

    litTableStats = TclLiteralStats(globalTablePtr);
    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
	    litTableStats);
    ckfree(litTableStats);

    /*
     * Source and ByteCode size distributions.
     */

    Tcl_AppendPrintfToObj(objPtr, "\nSource sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");







|







9501
9502
9503
9504
9505
9506
9507
9508
9509
9510
9511
9512
9513
9514
9515
	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
    }

    litTableStats = TclLiteralStats(globalTablePtr);
    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
	    litTableStats);
    Tcl_Free(litTableStats);

    /*
     * Source and ByteCode size distributions.
     */

    Tcl_AppendPrintfToObj(objPtr, "\nSource sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
Changes to generic/tclFileName.c.
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
 * Results:
 *	Returns a standard Tcl result. The interpreter result contains a list
 *	of path components. *argvPtr will be filled in with the address of an
 *	array whose elements point to the elements of path, in order.
 *	*argcPtr will get filled in with the number of valid elements in the
 *	array. A single block of memory is dynamically allocated to hold both
 *	the argv array and a copy of the path elements. The caller must
 *	eventually free this memory by calling ckfree() on *argvPtr. Note:
 *	*argvPtr and *argcPtr are only modified if the procedure returns
 *	normally.
 *
 * Side effects:
 *	Allocates memory.
 *
 *----------------------------------------------------------------------







|







542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
 * Results:
 *	Returns a standard Tcl result. The interpreter result contains a list
 *	of path components. *argvPtr will be filled in with the address of an
 *	array whose elements point to the elements of path, in order.
 *	*argcPtr will get filled in with the number of valid elements in the
 *	array. A single block of memory is dynamically allocated to hold both
 *	the argv array and a copy of the path elements. The caller must
 *	eventually free this memory by calling Tcl_Free() on *argvPtr. Note:
 *	*argvPtr and *argcPtr are only modified if the procedure returns
 *	normally.
 *
 * Side effects:
 *	Allocates memory.
 *
 *----------------------------------------------------------------------
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
    /*
     * Calculate space required for the result.
     */

    size = 1;
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	TclGetStringFromObj(eltPtr, &len);
	size += len + 1;
    }

    /*
     * Allocate a buffer large enough to hold the contents of all of the list
     * plus the argv pointers and the terminating NULL pointer.
     */

    *argvPtr = ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size);

    /*
     * Position p after the last argv pointer and copy the contents of the
     * list in, piece by piece.
     */

    p = (char *) &(*argvPtr)[(*argcPtr) + 1];







|








|







583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
    /*
     * Calculate space required for the result.
     */

    size = 1;
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	(void)TclGetStringFromObj(eltPtr, &len);
	size += len + 1;
    }

    /*
     * Allocate a buffer large enough to hold the contents of all of the list
     * plus the argv pointers and the terminating NULL pointer.
     */

    *argvPtr = Tcl_Alloc((((*argcPtr) + 1) * sizeof(char *)) + size);

    /*
     * Position p after the last argv pointer and copy the contents of the
     * list in, piece by piece.
     */

    p = (char *) &(*argvPtr)[(*argcPtr) + 1];
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
	Tcl_Obj *pair[2];

	pair[0] = pathPtr;
	pair[1] = objv[0];
	return TclJoinPath(2, pair);
    } else {
	int elemc = objc + 1;
	Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj *));

	elemv[0] = pathPtr;
	memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
	ret = TclJoinPath(elemc, elemv);
	ckfree(elemv);
	return ret;
    }
}

/*
 *---------------------------------------------------------------------------
 *







|




|







826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
	Tcl_Obj *pair[2];

	pair[0] = pathPtr;
	pair[1] = objv[0];
	return TclJoinPath(2, pair);
    } else {
	int elemc = objc + 1;
	Tcl_Obj *ret, **elemv = Tcl_Alloc(elemc*sizeof(Tcl_Obj *));

	elemv[0] = pathPtr;
	memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
	ret = TclJoinPath(elemc, elemv);
	Tcl_Free(elemv);
	return ret;
    }
}

/*
 *---------------------------------------------------------------------------
 *
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
    case TCL_PLATFORM_UNIX:
	/*
	 * Append a separator if needed.
	 */

	if (length > 0 && (start[length-1] != '/')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    TclGetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */








|







890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
    case TCL_PLATFORM_UNIX:
	/*
	 * Append a separator if needed.
	 */

	if (length > 0 && (start[length-1] != '/')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    (void)TclGetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
	/*
	 * Check to see if we need to append a separator.
	 */

	if ((length > 0) &&
		(start[length-1] != '/') && (start[length-1] != ':')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    TclGetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */








|







926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
	/*
	 * Check to see if we need to append a separator.
	 */

	if ((length > 0) &&
		(start[length-1] != '/') && (start[length-1] != ':')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    (void)TclGetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
	 * ':' no longer needed as a separator. It is only relevant to the
	 * beginning of the path.
	 */

	separators = "/\\";

    } else if (tclPlatform == TCL_PLATFORM_UNIX) {
	if (pathPrefix == NULL && tail[0] == '/') {
	    pathPrefix = Tcl_NewStringObj(tail, 1);
	    tail++;
	    Tcl_IncrRefCount(pathPrefix);
	}
    }

    /*







|







1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
	 * ':' no longer needed as a separator. It is only relevant to the
	 * beginning of the path.
	 */

	separators = "/\\";

    } else if (tclPlatform == TCL_PLATFORM_UNIX) {
	if (pathPrefix == NULL && tail[0] == '/' && tail[1] != '/') {
	    pathPrefix = Tcl_NewStringObj(tail, 1);
	    tail++;
	    Tcl_IncrRefCount(pathPrefix);
	}
    }

    /*
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
 *
 *	This procedure allocates a Tcl_StatBuf on the heap. It exists so that
 *	extensions may be used unchanged on systems where largefile support is
 *	optional.
 *
 * Results:
 *	A pointer to a Tcl_StatBuf which may be deallocated by being passed to
 *	ckfree().
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_StatBuf *
Tcl_AllocStatBuf(void)
{
    return ckalloc(sizeof(Tcl_StatBuf));
}

/*
 *---------------------------------------------------------------------------
 *
 * Access functions for Tcl_StatBuf --
 *







|










|







2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
 *
 *	This procedure allocates a Tcl_StatBuf on the heap. It exists so that
 *	extensions may be used unchanged on systems where largefile support is
 *	optional.
 *
 * Results:
 *	A pointer to a Tcl_StatBuf which may be deallocated by being passed to
 *	Tcl_Free().
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_StatBuf *
Tcl_AllocStatBuf(void)
{
    return Tcl_Alloc(sizeof(Tcl_StatBuf));
}

/*
 *---------------------------------------------------------------------------
 *
 * Access functions for Tcl_StatBuf --
 *
Changes to generic/tclFileSystem.h.
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
MODULE_SCOPE int	TclFSNormalizeToUniquePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int startAt);
MODULE_SCOPE Tcl_Obj *	TclFSMakePathRelative(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
MODULE_SCOPE int	TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **fsPtrPtr);
MODULE_SCOPE void	TclFSSetPathDetails(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem *fsPtr, ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);
MODULE_SCOPE size_t	TclFSEpoch(void);

/*
 * Private shared variables for use by tclIOUtil.c and tclPathObj.c
 */







|







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
MODULE_SCOPE int	TclFSNormalizeToUniquePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int startAt);
MODULE_SCOPE Tcl_Obj *	TclFSMakePathRelative(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
MODULE_SCOPE int	TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **fsPtrPtr);
MODULE_SCOPE void	TclFSSetPathDetails(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem *fsPtr, void *clientData);
MODULE_SCOPE Tcl_Obj *	TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);
MODULE_SCOPE size_t	TclFSEpoch(void);

/*
 * Private shared variables for use by tclIOUtil.c and tclPathObj.c
 */
Changes to generic/tclGetDate.y.
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#define YYMALLOC	ckalloc
#define YYFREE(x)	(ckfree((void*) (x)))

#define yyDSTmode	(info->dateDSTmode)
#define yyDayOrdinal	(info->dateDayOrdinal)
#define yyDayNumber	(info->dateDayNumber)
#define yyMonthOrdinal	(info->dateMonthOrdinal)
#define yyHaveDate	(info->dateHaveDate)
#define yyHaveDay	(info->dateHaveDay)







|
|







85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#define YYMALLOC	Tcl_Alloc
#define YYFREE(x)	(Tcl_Free((void*) (x)))

#define yyDSTmode	(info->dateDSTmode)
#define yyDayOrdinal	(info->dateDayOrdinal)
#define yyDayNumber	(info->dateDayNumber)
#define yyMonthOrdinal	(info->dateMonthOrdinal)
#define yyHaveDate	(info->dateHaveDate)
#define yyHaveDay	(info->dateHaveDay)
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
    register char c;
    register char *p;
    char buff[20];
    int Count;

    location->first_column = yyInput - info->dateStart;
    for ( ; ; ) {
	while (isspace(UCHAR(*yyInput))) {
	    yyInput++;
	}

	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
	    /*
	     * Convert the string into a number; count the number of digits.
	     */







|







893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
    register char c;
    register char *p;
    char buff[20];
    int Count;

    location->first_column = yyInput - info->dateStart;
    for ( ; ; ) {
	while (TclIsSpaceProc(UCHAR(*yyInput))) {
	    yyInput++;
	}

	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
	    /*
	     * Convert the string into a number; count the number of digits.
	     */
Changes to generic/tclHash.c.
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 * The following macro takes a preliminary integer hash value and produces an
 * index into a hash tables bucket list. The idea is to make it so that
 * preliminary values that are arbitrarily similar will end up in different
 * buckets. The hash function was taken from a random-number generator.
 */

#define RANDOM_INDEX(tablePtr, i) \
    ((((i)*1103515245UL) >> (tablePtr)->downShift) & (tablePtr)->mask)

/*
 * Prototypes for the array hash key methods.
 */

static Tcl_HashEntry *	AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static int		CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);







|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 * The following macro takes a preliminary integer hash value and produces an
 * index into a hash tables bucket list. The idea is to make it so that
 * preliminary values that are arbitrarily similar will end up in different
 * buckets. The hash function was taken from a random-number generator.
 */

#define RANDOM_INDEX(tablePtr, i) \
    ((((i)*(size_t)1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)

/*
 * Prototypes for the array hash key methods.
 */

static Tcl_HashEntry *	AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static int		CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
    const char *key,		/* Key to use to find or create matching
				 * entry. */
    int *newPtr)		/* Store info here telling whether a new entry
				 * was created. */
{
    register Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;
    unsigned int hash;
    unsigned int index;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
	typePtr = tablePtr->typePtr;
    } else {
	typePtr = &tclArrayHashKeyType;
    }

    if (typePtr->hashKeyProc) {
	hash = typePtr->hashKeyProc(tablePtr, (void *) key);
	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	    index = RANDOM_INDEX(tablePtr, hash);
	} else {
	    index = hash & tablePtr->mask;
	}
    } else {
	hash = PTR2UINT(key);
	index = RANDOM_INDEX(tablePtr, hash);
    }

    /*
     * Search all of the entries in the appropriate bucket.
     */








|
<




















|







243
244
245
246
247
248
249
250

251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
    const char *key,		/* Key to use to find or create matching
				 * entry. */
    int *newPtr)		/* Store info here telling whether a new entry
				 * was created. */
{
    register Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;
    size_t hash, index;


    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
	typePtr = tablePtr->typePtr;
    } else {
	typePtr = &tclArrayHashKeyType;
    }

    if (typePtr->hashKeyProc) {
	hash = typePtr->hashKeyProc(tablePtr, (void *) key);
	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	    index = RANDOM_INDEX(tablePtr, hash);
	} else {
	    index = hash & tablePtr->mask;
	}
    } else {
	hash = (size_t) key;
	index = RANDOM_INDEX(tablePtr, hash);
    }

    /*
     * Search all of the entries in the appropriate bucket.
     */

315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
     * Entry not found. Add a new one to the bucket.
     */

    *newPtr = 1;
    if (typePtr->allocEntryProc) {
	hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
    } else {
	hPtr = ckalloc(sizeof(Tcl_HashEntry));
	hPtr->key.oneWordValue = (char *) key;
	hPtr->clientData = 0;
    }

    hPtr->tablePtr = tablePtr;
    hPtr->hash = hash;
    hPtr->nextPtr = tablePtr->buckets[index];
    tablePtr->buckets[index] = hPtr;
    tablePtr->numEntries++;







|

|







314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
     * Entry not found. Add a new one to the bucket.
     */

    *newPtr = 1;
    if (typePtr->allocEntryProc) {
	hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
    } else {
	hPtr = Tcl_Alloc(sizeof(Tcl_HashEntry));
	hPtr->key.oneWordValue = (char *) key;
	Tcl_SetHashValue(hPtr, NULL);
    }

    hPtr->tablePtr = tablePtr;
    hPtr->hash = hash;
    hPtr->nextPtr = tablePtr->buckets[index];
    tablePtr->buckets[index] = hPtr;
    tablePtr->numEntries++;
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
Tcl_DeleteHashEntry(
    Tcl_HashEntry *entryPtr)
{
    register Tcl_HashEntry *prevPtr;
    const Tcl_HashKeyType *typePtr;
    Tcl_HashTable *tablePtr;
    Tcl_HashEntry **bucketPtr;
    unsigned int index;

    tablePtr = entryPtr->tablePtr;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;







|







362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
Tcl_DeleteHashEntry(
    Tcl_HashEntry *entryPtr)
{
    register Tcl_HashEntry *prevPtr;
    const Tcl_HashKeyType *typePtr;
    Tcl_HashTable *tablePtr;
    Tcl_HashEntry **bucketPtr;
    size_t index;

    tablePtr = entryPtr->tablePtr;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
	}
    }

    tablePtr->numEntries--;
    if (typePtr->freeEntryProc) {
	typePtr->freeEntryProc(entryPtr);
    } else {
	ckfree(entryPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteHashTable --







|







404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
	}
    }

    tablePtr->numEntries--;
    if (typePtr->freeEntryProc) {
	typePtr->freeEntryProc(entryPtr);
    } else {
	Tcl_Free(entryPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteHashTable --
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446

void
Tcl_DeleteHashTable(
    register Tcl_HashTable *tablePtr)	/* Table to delete. */
{
    register Tcl_HashEntry *hPtr, *nextPtr;
    const Tcl_HashKeyType *typePtr;
    int i;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {







|







431
432
433
434
435
436
437
438
439
440
441
442
443
444
445

void
Tcl_DeleteHashTable(
    register Tcl_HashTable *tablePtr)	/* Table to delete. */
{
    register Tcl_HashEntry *hPtr, *nextPtr;
    const Tcl_HashKeyType *typePtr;
    size_t i;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
    for (i = 0; i < tablePtr->numBuckets; i++) {
	hPtr = tablePtr->buckets[i];
	while (hPtr != NULL) {
	    nextPtr = hPtr->nextPtr;
	    if (typePtr->freeEntryProc) {
		typePtr->freeEntryProc(hPtr);
	    } else {
		ckfree(hPtr);
	    }
	    hPtr = nextPtr;
	}
    }

    /*
     * Free up the bucket array, if it was dynamically allocated.
     */

    if (tablePtr->buckets != tablePtr->staticBuckets) {
	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	    TclpSysFree((char *) tablePtr->buckets);
	} else {
	    ckfree(tablePtr->buckets);
	}
    }

    /*
     * Arrange for panics if the table is used again without
     * re-initialization.
     */







|













|







455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
    for (i = 0; i < tablePtr->numBuckets; i++) {
	hPtr = tablePtr->buckets[i];
	while (hPtr != NULL) {
	    nextPtr = hPtr->nextPtr;
	    if (typePtr->freeEntryProc) {
		typePtr->freeEntryProc(hPtr);
	    } else {
		Tcl_Free(hPtr);
	    }
	    hPtr = nextPtr;
	}
    }

    /*
     * Free up the bucket array, if it was dynamically allocated.
     */

    if (tablePtr->buckets != tablePtr->staticBuckets) {
	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	    TclpSysFree((char *) tablePtr->buckets);
	} else {
	    Tcl_Free(tablePtr->buckets);
	}
    }

    /*
     * Arrange for panics if the table is used again without
     * re-initialization.
     */
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
 */

char *
Tcl_HashStats(
    Tcl_HashTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    int count[NUM_COUNTERS], overflow, i, j;
    double average, tmp;
    register Tcl_HashEntry *hPtr;
    char *result, *p;

    /*
     * Compute a histogram of bucket usage.
     */







|







580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
 */

char *
Tcl_HashStats(
    Tcl_HashTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    size_t count[NUM_COUNTERS], overflow, i, j;
    double average, tmp;
    register Tcl_HashEntry *hPtr;
    char *result, *p;

    /*
     * Compute a histogram of bucket usage.
     */
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
	}
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = ckalloc((NUM_COUNTERS * 60) + 300);
    sprintf(result, "%d entries in table, %d buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i = 0; i < NUM_COUNTERS; i++) {
	sprintf(p, "number of buckets with %d entries: %d\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %d\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}

/*







|
|



|



|







614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
	}
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = Tcl_Alloc((NUM_COUNTERS * 60) + 300);
    sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i = 0; i < NUM_COUNTERS; i++) {
	sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}

/*
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
AllocArrayEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    int *array = (int *) keyPtr;
    register int *iPtr1, *iPtr2;
    Tcl_HashEntry *hPtr;
    int count;
    unsigned int size;

    count = tablePtr->keyType;

    size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
    if (size < sizeof(Tcl_HashEntry)) {
	size = sizeof(Tcl_HashEntry);
    }
    hPtr = ckalloc(size);

    for (iPtr1 = array, iPtr2 = hPtr->key.words;
	    count > 0; count--, iPtr1++, iPtr2++) {
	*iPtr2 = *iPtr1;
    }
    hPtr->clientData = 0;

    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *







|





|







|





|







649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
AllocArrayEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)			/* Key to store in the hash table entry. */
{
    int *array = (int *) keyPtr;
    register int *iPtr1, *iPtr2;
    Tcl_HashEntry *hPtr;
    int count;
    size_t size;

    count = tablePtr->keyType;

    size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
    if (size < sizeof(Tcl_HashEntry)) {
	size = sizeof(Tcl_HashEntry);
    }
    hPtr = Tcl_Alloc(size);

    for (iPtr1 = array, iPtr2 = hPtr->key.words;
	    count > 0; count--, iPtr1++, iPtr2++) {
	*iPtr2 = *iPtr1;
    }
    Tcl_SetHashValue(hPtr, NULL);

    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CompareArrayKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    register const int *iPtr1 = (const int *) keyPtr;
    register const int *iPtr2 = (const int *) hPtr->key.words;
    Tcl_HashTable *tablePtr = hPtr->tablePtr;
    int count;

    for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
	if (count == 0) {
	    return 1;
	}







|


|
|







693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CompareArrayKeys(
    void *keyPtr,			/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    const int *iPtr1 = keyPtr;
    const int *iPtr2 = hPtr->key.words;
    Tcl_HashTable *tablePtr = hPtr->tablePtr;
    int count;

    for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
	if (count == 0) {
	    return 1;
	}
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
HashArrayKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    register const int *array = (const int *) keyPtr;
    register TCL_HASH_TYPE result;
    int count;

    for (result = 0, count = tablePtr->keyType; count > 0;
	    count--, array++) {







|







733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
HashArrayKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)				/* Key from which to compute hash value. */
{
    register const int *array = (const int *) keyPtr;
    register TCL_HASH_TYPE result;
    int count;

    for (result = 0, count = tablePtr->keyType; count > 0;
	    count--, array++) {
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
AllocStringEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    const char *string = (const char *) keyPtr;
    Tcl_HashEntry *hPtr;
    unsigned int size, allocsize;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize);
    memcpy(hPtr->key.string, string, size);
    hPtr->clientData = 0;
    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * CompareStringKeys --







|



|





|

|







765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
AllocStringEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)			/* Key to store in the hash table entry. */
{
    const char *string = (const char *) keyPtr;
    Tcl_HashEntry *hPtr;
    size_t size, allocsize;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = Tcl_Alloc(TclOffset(Tcl_HashEntry, key) + allocsize);
    memcpy(hPtr->key.string, string, size);
    Tcl_SetHashValue(hPtr, NULL);
    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * CompareStringKeys --
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CompareStringKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    register const char *p1 = (const char *) keyPtr;
    register const char *p2 = (const char *) hPtr->key.string;

    return !strcmp(p1, p2);
}

/*
 *----------------------------------------------------------------------
 *
 * HashStringKey --
 *







|


<
<
<
|







800
801
802
803
804
805
806
807
808
809



810
811
812
813
814
815
816
817
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CompareStringKeys(
    void *keyPtr,			/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{



    return !strcmp(keyPtr, hPtr->key.string);
}

/*
 *----------------------------------------------------------------------
 *
 * HashStringKey --
 *
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
HashStringKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    register const char *string = keyPtr;
    register TCL_HASH_TYPE result;
    register char c;

    /*
     * I tried a zillion different hash functions and asked many other people







|







826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
HashStringKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)			/* Key from which to compute hash value. */
{
    register const char *string = keyPtr;
    register TCL_HASH_TYPE result;
    register char c;

    /*
     * I tried a zillion different hash functions and asked many other people
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
 *----------------------------------------------------------------------
 */

static void
RebuildTable(
    register Tcl_HashTable *tablePtr)	/* Table to enlarge. */
{
    int count, oldSize = tablePtr->numBuckets;
    unsigned int index;
    Tcl_HashEntry **oldBuckets = tablePtr->buckets;
    register Tcl_HashEntry **oldChainPtr, **newChainPtr;
    register Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;

    /* Avoid outgrowing capability of the memory allocators */
    if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) {
	tablePtr->rebuildSize = INT_MAX;
	return;
    }

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {







|
<






|







951
952
953
954
955
956
957
958

959
960
961
962
963
964
965
966
967
968
969
970
971
972
 *----------------------------------------------------------------------
 */

static void
RebuildTable(
    register Tcl_HashTable *tablePtr)	/* Table to enlarge. */
{
    size_t count, index, oldSize = tablePtr->numBuckets;

    Tcl_HashEntry **oldBuckets = tablePtr->buckets;
    register Tcl_HashEntry **oldChainPtr, **newChainPtr;
    register Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;

    /* Avoid outgrowing capability of the memory allocators */
    if (oldSize > UINT_MAX / (4 * sizeof(Tcl_HashEntry *))) {
	tablePtr->rebuildSize = INT_MAX;
	return;
    }

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003

1004

1005
1006
1007
1008
1009
1010
1011
    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
     */

    tablePtr->numBuckets *= 4;
    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
		(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
    } else {
	tablePtr->buckets =
		ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
    }
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
	    count > 0; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;

    tablePtr->downShift -= 2;

    tablePtr->mask = (tablePtr->mask << 2) + 3;

    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {







|
|


|






>
|
>







981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
     */

    tablePtr->numBuckets *= 4;
    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	tablePtr->buckets = TclpSysAlloc(
		tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
    } else {
	tablePtr->buckets =
		Tcl_Alloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
    }
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
	    count > 0; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;
    if (tablePtr->downShift > 1) {
	tablePtr->downShift -= 2;
    }
    tablePtr->mask = (tablePtr->mask << 2) + 3;

    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
     * Free up the old bucket array, if it was dynamically allocated.
     */

    if (oldBuckets != tablePtr->staticBuckets) {
	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	    TclpSysFree((char *) oldBuckets);
	} else {
	    ckfree(oldBuckets);
	}
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|











1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
     * Free up the old bucket array, if it was dynamically allocated.
     */

    if (oldBuckets != tablePtr->staticBuckets) {
	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	    TclpSysFree((char *) oldBuckets);
	} else {
	    Tcl_Free(oldBuckets);
	}
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclHistory.c.
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
	    Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);

    /*
     * Create the references to the [::history add] command if necessary.
     */

    if (histObjsPtr == NULL) {
	histObjsPtr = ckalloc(sizeof(HistoryObjs));
	TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
	TclNewLiteralStringObj(histObjsPtr->addObj, "add");
	Tcl_IncrRefCount(histObjsPtr->historyObj);
	Tcl_IncrRefCount(histObjsPtr->addObj);
	Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
		histObjsPtr);
    }







|







126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
	    Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);

    /*
     * Create the references to the [::history add] command if necessary.
     */

    if (histObjsPtr == NULL) {
	histObjsPtr = Tcl_Alloc(sizeof(HistoryObjs));
	TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
	TclNewLiteralStringObj(histObjsPtr->addObj, "add");
	Tcl_IncrRefCount(histObjsPtr->historyObj);
	Tcl_IncrRefCount(histObjsPtr->addObj);
	Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
		histObjsPtr);
    }
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
    ClientData clientData,
    Tcl_Interp *interp)
{
    register HistoryObjs *histObjsPtr = clientData;

    TclDecrRefCount(histObjsPtr->historyObj);
    TclDecrRefCount(histObjsPtr->addObj);
    ckfree(histObjsPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|









206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
    ClientData clientData,
    Tcl_Interp *interp)
{
    register HistoryObjs *histObjsPtr = clientData;

    TclDecrRefCount(histObjsPtr->historyObj);
    TclDecrRefCount(histObjsPtr->addObj);
    Tcl_Free(histObjsPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclIO.c.
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
			    Tcl_Interp *interp);
static void		DeleteScriptRecord(Tcl_Interp *interp,
			    Channel *chanPtr, int mask);
static int		DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
static void		DiscardInputQueued(ChannelState *statePtr,
			    int discardSavedBuffers);
static void		DiscardOutputQueued(ChannelState *chanPtr);
static int		DoRead(Channel *chanPtr, char *dst, int bytesToRead,
			    int allowShortReads);
static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
			    int appendFlag);
static int		FilterInputBytes(Channel *chanPtr,
			    GetsState *statePtr);
static int		FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
			    int calledFromAsyncFlush);
static int		TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);
static Tcl_Encoding	GetBinaryEncoding();







|

|







187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
			    Tcl_Interp *interp);
static void		DeleteScriptRecord(Tcl_Interp *interp,
			    Channel *chanPtr, int mask);
static int		DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
static void		DiscardInputQueued(ChannelState *statePtr,
			    int discardSavedBuffers);
static void		DiscardOutputQueued(ChannelState *chanPtr);
static int		DoRead(Channel *chanPtr, char *dst, size_t bytesToRead,
			    int allowShortReads);
static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, size_t toRead,
			    int appendFlag);
static int		FilterInputBytes(Channel *chanPtr,
			    GetsState *statePtr);
static int		FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
			    int calledFromAsyncFlush);
static int		TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);
static Tcl_Encoding	GetBinaryEncoding();
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249

/*
 * Simplifying helper macros. All may use their argument(s) multiple times.
 * The ANSI C "prototypes" for the macros are listed below, together with a
 * short description of what the macro does.
 *
 * --------------------------------------------------------------------------
 * int BytesLeft(ChannelBuffer *bufPtr)
 *
 *	Returns the number of bytes of data remaining in the buffer.
 *
 * int SpaceLeft(ChannelBuffer *bufPtr)
 *
 *	Returns the number of bytes of space remaining at the end of the
 *	buffer.







|







235
236
237
238
239
240
241
242
243
244
245
246
247
248
249

/*
 * Simplifying helper macros. All may use their argument(s) multiple times.
 * The ANSI C "prototypes" for the macros are listed below, together with a
 * short description of what the macro does.
 *
 * --------------------------------------------------------------------------
 * size_t BytesLeft(ChannelBuffer *bufPtr)
 *
 *	Returns the number of bytes of data remaining in the buffer.
 *
 * int SpaceLeft(ChannelBuffer *bufPtr)
 *
 *	Returns the number of bytes of space remaining at the end of the
 *	buffer.
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
 * char *RemovePoint(ChannelBuffer *bufPtr)
 *
 *	Returns a pointer to where characters should be removed from the
 *	buffer.
 * --------------------------------------------------------------------------
 */

#define BytesLeft(bufPtr)	((bufPtr)->nextAdded - (bufPtr)->nextRemoved)

#define SpaceLeft(bufPtr)	((bufPtr)->bufLength - (bufPtr)->nextAdded)

#define IsBufferReady(bufPtr)	((bufPtr)->nextAdded > (bufPtr)->nextRemoved)

#define IsBufferEmpty(bufPtr)	((bufPtr)->nextAdded == (bufPtr)->nextRemoved)

#define IsBufferFull(bufPtr)	((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)








|

|







273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
 * char *RemovePoint(ChannelBuffer *bufPtr)
 *
 *	Returns a pointer to where characters should be removed from the
 *	buffer.
 * --------------------------------------------------------------------------
 */

#define BytesLeft(bufPtr)	((size_t)((bufPtr)->nextAdded - (bufPtr)->nextRemoved))

#define SpaceLeft(bufPtr)	((size_t)((bufPtr)->bufLength - (bufPtr)->nextAdded))

#define IsBufferReady(bufPtr)	((bufPtr)->nextAdded > (bufPtr)->nextRemoved)

#define IsBufferEmpty(bufPtr)	((bufPtr)->nextAdded == (bufPtr)->nextRemoved)

#define IsBufferFull(bufPtr)	((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)

420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443









444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
     */

    if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
        chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
    chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
    if (WillRead(chanPtr) < 0) {
        return -1;
    }

    bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
	    dst, dstSize, &result);

    /*
     * Stop any flag leakage through stacked channel levels.
     */

    if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
        chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
    chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
    if (bytesRead > 0) {









	/*
	 * If we get a short read, signal up that we may be BLOCKED. We should
	 * avoid calling the driver because on some platforms we will block in
	 * the low level reading code even though the channel is set into
	 * nonblocking mode.
	 */

	if (bytesRead < dstSize) {
	    SetFlag(chanPtr->state, CHANNEL_BLOCKED);
	}
    } else if (bytesRead == 0) {
	SetFlag(chanPtr->state, CHANNEL_EOF);
	chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END;
    } else if (bytesRead < 0) {
	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
	    SetFlag(chanPtr->state, CHANNEL_BLOCKED);
	    result = EAGAIN;
	}
	Tcl_SetErrno(result);
    }
    return bytesRead;
}

static inline Tcl_WideInt
ChanSeek(
    Channel *chanPtr,







|















|
>
>
>
>
>
>
>
>
>










<
<
<
<
<
<
<
<
<







420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462









463
464
465
466
467
468
469
     */

    if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
        chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
    chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
    if (WillRead(chanPtr) == -1) {
        return -1;
    }

    bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
	    dst, dstSize, &result);

    /*
     * Stop any flag leakage through stacked channel levels.
     */

    if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
        chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
    chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
    if (bytesRead == -1) {
	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
	    SetFlag(chanPtr->state, CHANNEL_BLOCKED);
	    result = EAGAIN;
	}
	Tcl_SetErrno(result);
    } else if (bytesRead == 0) {
	SetFlag(chanPtr->state, CHANNEL_EOF);
	chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END;
    } else {
	/*
	 * If we get a short read, signal up that we may be BLOCKED. We should
	 * avoid calling the driver because on some platforms we will block in
	 * the low level reading code even though the channel is set into
	 * nonblocking mode.
	 */

	if (bytesRead < dstSize) {
	    SetFlag(chanPtr->state, CHANNEL_BLOCKED);
	}









    }
    return bytesRead;
}

static inline Tcl_WideInt
ChanSeek(
    Channel *chanPtr,
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498

    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
	    chanPtr->typePtr->wideSeekProc != NULL) {
	return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
		offset, mode, errnoPtr);
    }

    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
	*errnoPtr = EOVERFLOW;
	return Tcl_LongAsWide(-1);
    }

    return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData,
	    Tcl_WideAsLong(offset), mode, errnoPtr));
}

static inline void
ChanThreadAction(
    Channel *chanPtr,
    int action)
{







|

|


|
|







478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498

    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
	    chanPtr->typePtr->wideSeekProc != NULL) {
	return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
		offset, mode, errnoPtr);
    }

    if (offset<LONG_MIN || offset>LONG_MAX) {
	*errnoPtr = EOVERFLOW;
	return -1;
    }

    return chanPtr->typePtr->seekProc(chanPtr->instanceData,
	    offset, mode, errnoPtr);
}

static inline void
ChanThreadAction(
    Channel *chanPtr,
    int action)
{
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
				 * channel will be closed. */
    ClientData clientData)	/* Arbitrary data to pass to the close
				 * callback. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
    CloseCallback *cbPtr;

    cbPtr = ckalloc(sizeof(CloseCallback));
    cbPtr->proc = proc;
    cbPtr->clientData = clientData;

    cbPtr->nextPtr = statePtr->closeCbPtr;
    statePtr->closeCbPtr = cbPtr;
}








|







840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
				 * channel will be closed. */
    ClientData clientData)	/* Arbitrary data to pass to the close
				 * callback. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
    CloseCallback *cbPtr;

    cbPtr = Tcl_Alloc(sizeof(CloseCallback));
    cbPtr->proc = proc;
    cbPtr->clientData = clientData;

    cbPtr->nextPtr = statePtr->closeCbPtr;
    statePtr->closeCbPtr = cbPtr;
}

886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
	    cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
	if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
	    if (cbPrevPtr == NULL) {
		statePtr->closeCbPtr = cbPtr->nextPtr;
	    } else {
		cbPrevPtr->nextPtr = cbPtr->nextPtr;
	    }
	    ckfree(cbPtr);
	    break;
	}
	cbPrevPtr = cbPtr;
    }
}

/*







|







886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
	    cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
	if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
	    if (cbPrevPtr == NULL) {
		statePtr->closeCbPtr = cbPtr->nextPtr;
	    } else {
		cbPrevPtr->nextPtr = cbPtr->nextPtr;
	    }
	    Tcl_Free(cbPtr);
	    break;
	}
	cbPrevPtr = cbPtr;
    }
}

/*
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
    Tcl_Interp *interp)
{
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_Channel stdinChan, stdoutChan, stderrChan;

    hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
    if (hTblPtr == NULL) {
	hTblPtr = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, "tclIO",
		(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);

	/*
	 * If the interpreter is trusted (not "safe"), insert channels for
	 * stdin, stdout and stderr (possibly creating them in the process).







|







921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
    Tcl_Interp *interp)
{
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_Channel stdinChan, stdoutChan, stderrChan;

    hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
    if (hTblPtr == NULL) {
	hTblPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, "tclIO",
		(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);

	/*
	 * If the interpreter is trusted (not "safe"), insert channels for
	 * stdin, stdout and stderr (possibly creating them in the process).
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
		    prevPtr->nextPtr = nextPtr;
		}

		Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
			TclChannelEventScriptInvoker, sPtr);

		TclDecrRefCount(sPtr->scriptPtr);
		ckfree(sPtr);
	    } else {
		prevPtr = sPtr;
	    }
	}

	/*
	 * Cannot call Tcl_UnregisterChannel because that procedure calls







|







1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
		    prevPtr->nextPtr = nextPtr;
		}

		Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
			TclChannelEventScriptInvoker, sPtr);

		TclDecrRefCount(sPtr->scriptPtr);
		Tcl_Free(sPtr);
	    } else {
		prevPtr = sPtr;
	    }
	}

	/*
	 * Cannot call Tcl_UnregisterChannel because that procedure calls
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
	    }
	}

    }
    Tcl_DeleteHashTable(hTblPtr);
    ckfree(hTblPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CheckForStdChannelsBeingClosed --
 *







|







1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
	    }
	}

    }
    Tcl_DeleteHashTable(hTblPtr);
    Tcl_Free(hTblPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CheckForStdChannelsBeingClosed --
 *
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
         */

	Tcl_Release((ClientData) resPtr->statePtr);

    } else {
	TclFreeIntRep(objPtr);

	resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName));
	resPtr->refCount = 1;
	objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr;
	objPtr->typePtr = &chanObjType;
    }
    statePtr = ((Channel *)chan)->state;
    resPtr->statePtr = statePtr;
    Tcl_Preserve((ClientData) statePtr);







|







1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
         */

	Tcl_Release((ClientData) resPtr->statePtr);

    } else {
	TclFreeIntRep(objPtr);

	resPtr = (ResolvedChanName *) Tcl_Alloc(sizeof(ResolvedChanName));
	resPtr->refCount = 1;
	objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr;
	objPtr->typePtr = &chanObjType;
    }
    statePtr = ((Channel *)chan)->state;
    resPtr->statePtr = statePtr;
    Tcl_Preserve((ClientData) statePtr);
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
    }

    /*
     * JH: We could subsequently memset these to 0 to avoid the numerous
     * assignments to 0/NULL below.
     */

    chanPtr = ckalloc(sizeof(Channel));
    statePtr = ckalloc(sizeof(ChannelState));
    chanPtr->state = statePtr;

    chanPtr->instanceData = instanceData;
    chanPtr->typePtr = typePtr;

    /*
     * Set all the bits that are part of the stack-independent state
     * information for the channel.
     */

    if (chanName != NULL) {
	unsigned len = strlen(chanName) + 1;

	/*
         * Make sure we allocate at least 7 bytes, so it fits for "stdout"
         * later.
         */

	tmp = ckalloc((len < 7) ? 7 : len);
	strcpy(tmp, chanName);
    } else {
	tmp = ckalloc(7);
	tmp[0] = '\0';
    }
    statePtr->channelName = tmp;
    statePtr->flags = mask;

    /*
     * Set the channel to system default encoding.







|
|


















|


|







1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
    }

    /*
     * JH: We could subsequently memset these to 0 to avoid the numerous
     * assignments to 0/NULL below.
     */

    chanPtr = Tcl_Alloc(sizeof(Channel));
    statePtr = Tcl_Alloc(sizeof(ChannelState));
    chanPtr->state = statePtr;

    chanPtr->instanceData = instanceData;
    chanPtr->typePtr = typePtr;

    /*
     * Set all the bits that are part of the stack-independent state
     * information for the channel.
     */

    if (chanName != NULL) {
	unsigned len = strlen(chanName) + 1;

	/*
         * Make sure we allocate at least 7 bytes, so it fits for "stdout"
         * later.
         */

	tmp = Tcl_Alloc((len < 7) ? 7 : len);
	strcpy(tmp, chanName);
    } else {
	tmp = Tcl_Alloc(7);
	tmp[0] = '\0';
    }
    statePtr->channelName = tmp;
    statePtr->flags = mask;

    /*
     * Set the channel to system default encoding.
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
	prevChanPtr->inQueueHead = statePtr->inQueueHead;
	prevChanPtr->inQueueTail = statePtr->inQueueTail;

	statePtr->inQueueHead = NULL;
	statePtr->inQueueTail = NULL;
    }

    chanPtr = ckalloc(sizeof(Channel));

    /*
     * Save some of the current state into the new structure, reinitialize the
     * parts which will stay with the transformation.
     *
     * Remarks:
     */







|







1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
	prevChanPtr->inQueueHead = statePtr->inQueueHead;
	prevChanPtr->inQueueTail = statePtr->inQueueTail;

	statePtr->inQueueHead = NULL;
	statePtr->inQueueTail = NULL;
    }

    chanPtr = Tcl_Alloc(sizeof(Channel));

    /*
     * Save some of the current state into the new structure, reinitialize the
     * parts which will stay with the transformation.
     *
     * Remarks:
     */
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
    if (chanPtr->refCount == 0) {
	Tcl_Panic("Channel released more than preserved");
    }
    if (--chanPtr->refCount) {
	return;
    }
    if (chanPtr->typePtr == NULL) {
	ckfree(chanPtr);
    }
}

static void
ChannelFree(
    Channel *chanPtr)
{
    if (chanPtr->refCount == 0) {
	ckfree(chanPtr);
	return;
    }
    chanPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------







|








|







1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
    if (chanPtr->refCount == 0) {
	Tcl_Panic("Channel released more than preserved");
    }
    if (--chanPtr->refCount) {
	return;
    }
    if (chanPtr->typePtr == NULL) {
	Tcl_Free(chanPtr);
    }
}

static void
ChannelFree(
    Channel *chanPtr)
{
    if (chanPtr->refCount == 0) {
	Tcl_Free(chanPtr);
	return;
    }
    chanPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
AllocChannelBuffer(
    int length)			/* Desired length of channel buffer. */
{
    ChannelBuffer *bufPtr;
    int n;

    n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
    bufPtr = ckalloc(n);
    bufPtr->nextAdded	= BUFFER_PADDING;
    bufPtr->nextRemoved	= BUFFER_PADDING;
    bufPtr->bufLength	= length + BUFFER_PADDING;
    bufPtr->nextPtr	= NULL;
    bufPtr->refCount	= 1;
    return bufPtr;
}







|







2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
AllocChannelBuffer(
    int length)			/* Desired length of channel buffer. */
{
    ChannelBuffer *bufPtr;
    int n;

    n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
    bufPtr = Tcl_Alloc(n);
    bufPtr->nextAdded	= BUFFER_PADDING;
    bufPtr->nextRemoved	= BUFFER_PADDING;
    bufPtr->bufLength	= length + BUFFER_PADDING;
    bufPtr->nextPtr	= NULL;
    bufPtr->refCount	= 1;
    return bufPtr;
}
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
static void
ReleaseChannelBuffer(
    ChannelBuffer *bufPtr)
{
    if (--bufPtr->refCount) {
	return;
    }
    ckfree(bufPtr);
}

static int
IsShared(
    ChannelBuffer *bufPtr)
{
    return bufPtr->refCount > 1;







|







2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
static void
ReleaseChannelBuffer(
    ChannelBuffer *bufPtr)
{
    if (--bufPtr->refCount) {
	return;
    }
    Tcl_Free(bufPtr);
}

static int
IsShared(
    ChannelBuffer *bufPtr)
{
    return bufPtr->refCount > 1;
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
    /*
     * Some resources can be cleared only if the bottom channel in a stack is
     * closed. All the other channels in the stack are not allowed to remove.
     */

    if (chanPtr == statePtr->bottomChanPtr) {
	if (statePtr->channelName != NULL) {
	    ckfree(statePtr->channelName);
	    statePtr->channelName = NULL;
	}

	Tcl_FreeEncoding(statePtr->encoding);
    }

    /*







|







3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
    /*
     * Some resources can be cleared only if the bottom channel in a stack is
     * closed. All the other channels in the stack are not allowed to remove.
     */

    if (chanPtr == statePtr->bottomChanPtr) {
	if (statePtr->channelName != NULL) {
	    Tcl_Free(statePtr->channelName);
	    statePtr->channelName = NULL;
	}

	Tcl_FreeEncoding(statePtr->encoding);
    }

    /*
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
     * Invoke the registered close callbacks and delete their records.
     */

    while (statePtr->closeCbPtr != NULL) {
	cbPtr = statePtr->closeCbPtr;
	statePtr->closeCbPtr = cbPtr->nextPtr;
	cbPtr->proc(cbPtr->clientData);
	ckfree(cbPtr);
    }

    ResetFlag(statePtr, CHANNEL_INCLOSE);

    /*
     * If this channel supports it, close the read side, since we don't need
     * it anymore and this will help avoid deadlocks on some channel types.







|







3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
     * Invoke the registered close callbacks and delete their records.
     */

    while (statePtr->closeCbPtr != NULL) {
	cbPtr = statePtr->closeCbPtr;
	statePtr->closeCbPtr = cbPtr->nextPtr;
	cbPtr->proc(cbPtr->clientData);
	Tcl_Free(cbPtr);
    }

    ResetFlag(statePtr, CHANNEL_INCLOSE);

    /*
     * If this channel supports it, close the read side, since we don't need
     * it anymore and this will help avoid deadlocks on some channel types.
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938

    /*
     * Remove all the channel handler records attached to the channel itself.
     */

    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) {
	chNext = chPtr->nextPtr;
	ckfree(chPtr);
    }
    statePtr->chPtr = NULL;

    /*
     * Cancel any pending copy operation.
     */








|







3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938

    /*
     * Remove all the channel handler records attached to the channel itself.
     */

    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) {
	chNext = chPtr->nextPtr;
	Tcl_Free(chPtr);
    }
    statePtr->chPtr = NULL;

    /*
     * Cancel any pending copy operation.
     */

3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051

4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
    /*
     * Remove any EventScript records for this channel.
     */

    for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {
	eNextPtr = ePtr->nextPtr;
	TclDecrRefCount(ePtr->scriptPtr);
	ckfree(ePtr);
    }
    statePtr->scriptRecordPtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Write --
 *
 *	Puts a sequence of bytes into an output buffer, may queue the buffer
 *	for output if it gets full, and also remembers whether the current
 *	buffer is ready e.g. if it contains a newline and we are in line
 *	buffering mode. Compensates stacking, i.e. will redirect the data from
 *	the specified channel to the topmost channel in a stack.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes written or -1 in case of error. If -1,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Write(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    int srcLen)			/* Length of data in bytes, or < 0 for
				 * strlen(). */
{
    /*
     * Always use the topmost channel of the stack
     */

    Channel *chanPtr;
    ChannelState *statePtr;	/* State info for channel */

    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return -1;
    }

    if (srcLen < 0) {
	srcLen = strlen(src);
    }
    if (WriteBytes(chanPtr, src, srcLen) < 0) {
	return -1;
    }
    return srcLen;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WriteRaw --
 *
 *	Puts a sequence of bytes into an output buffer, may queue the buffer
 *	for output if it gets full, and also remembers whether the current
 *	buffer is ready e.g. if it contains a newline and we are in line
 *	buffering mode. Writes directly to the driver of the channel, does not
 *	compensate for stacking.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes written or -1 in case of error. If -1,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WriteRaw(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    int srcLen)			/* Length of data in bytes, or < 0 for
				 * strlen(). */
{
    Channel *chanPtr = ((Channel *) chan);
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int errorCode, written;


    if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
	return -1;
    }

    if (srcLen < 0) {
	srcLen = strlen(src);
    }

    /*
     * Go immediately to the driver, do all the error handling by ourselves.
     * The code was stolen from 'FlushChannel'.
     */

    written = ChanWrite(chanPtr, src, srcLen, &errorCode);
    if (written < 0) {
	Tcl_SetErrno(errorCode);
    }

    return written;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_WriteChars --
 *
 *	Takes a sequence of UTF-8 characters and converts them for output
 *	using the channel's current encoding, may queue the buffer for output
 *	if it gets full, and also remembers whether the current buffer is
 *	ready e.g. if it contains a newline and we are in line buffering
 *	mode. Compensates stacking, i.e. will redirect the data from the
 *	specified channel to the topmost channel in a stack.
 *
 * Results:
 *	The number of bytes written or -1 in case of error. If -1,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WriteChars(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 characters to queue in output
				 * buffer. */
    int len)			/* Length of string in bytes, or < 0 for
				 * strlen(). */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;	/* State info for channel */
    int result;
    Tcl_Obj *objPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return -1;
    }

    chanPtr = statePtr->topChanPtr;

    if (len < 0) {
	len = strlen(src);
    }
    if (statePtr->encoding) {
	return WriteChars(chanPtr, src, len);
    }

    /*
     * Inefficient way to convert UTF-8 to byte-array, but the code
     * parallels the way it is done for objects.  Special case for 1-byte
     * (used by eg [puts] for the \n) could be extended to more efficient
     * translation of the src string.
     */

    if ((len == 1) && (UCHAR(*src) < 0xC0)) {
	return WriteBytes(chanPtr, src, len);
    }

    objPtr = Tcl_NewStringObj(src, len);
    src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
    result = WriteBytes(chanPtr, src, len);
    TclDecrRefCount(objPtr);
    return result;
}

/*
 *---------------------------------------------------------------------------







|


















|









|



|













|


|


|
|


















|









|



|





|
>


|


|









|



















|









|




|








|




|


















|







3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
    /*
     * Remove any EventScript records for this channel.
     */

    for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {
	eNextPtr = ePtr->nextPtr;
	TclDecrRefCount(ePtr->scriptPtr);
	Tcl_Free(ePtr);
    }
    statePtr->scriptRecordPtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Write --
 *
 *	Puts a sequence of bytes into an output buffer, may queue the buffer
 *	for output if it gets full, and also remembers whether the current
 *	buffer is ready e.g. if it contains a newline and we are in line
 *	buffering mode. Compensates stacking, i.e. will redirect the data from
 *	the specified channel to the topmost channel in a stack.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes written or (size_t)-1 in case of error. If (size_t)-1,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_Write(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    size_t srcLen)			/* Length of data in bytes, or -1 for
				 * strlen(). */
{
    /*
     * Always use the topmost channel of the stack
     */

    Channel *chanPtr;
    ChannelState *statePtr;	/* State info for channel */

    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_IO_FAILURE;
    }

    if (srcLen == TCL_AUTO_LENGTH) {
	srcLen = strlen(src);
    }
    if (WriteBytes(chanPtr, src, srcLen) == -1) {
	return TCL_IO_FAILURE;
    }
    return srcLen;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WriteRaw --
 *
 *	Puts a sequence of bytes into an output buffer, may queue the buffer
 *	for output if it gets full, and also remembers whether the current
 *	buffer is ready e.g. if it contains a newline and we are in line
 *	buffering mode. Writes directly to the driver of the channel, does not
 *	compensate for stacking.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes written or (size_t)-1 in case of error. If (size_t)-1,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_WriteRaw(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    size_t srcLen)		/* Length of data in bytes, or (size_t)-1 for
				 * strlen(). */
{
    Channel *chanPtr = ((Channel *) chan);
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int errorCode;
    size_t written;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
	return (size_t)-1;
    }

    if (srcLen == (size_t)-1) {
	srcLen = strlen(src);
    }

    /*
     * Go immediately to the driver, do all the error handling by ourselves.
     * The code was stolen from 'FlushChannel'.
     */

    written = ChanWrite(chanPtr, src, srcLen, &errorCode);
    if (written == (size_t)-1) {
	Tcl_SetErrno(errorCode);
    }

    return written;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_WriteChars --
 *
 *	Takes a sequence of UTF-8 characters and converts them for output
 *	using the channel's current encoding, may queue the buffer for output
 *	if it gets full, and also remembers whether the current buffer is
 *	ready e.g. if it contains a newline and we are in line buffering
 *	mode. Compensates stacking, i.e. will redirect the data from the
 *	specified channel to the topmost channel in a stack.
 *
 * Results:
 *	The number of bytes written or (size_t)-1 in case of error. If (size_t)-1,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_WriteChars(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 characters to queue in output
				 * buffer. */
    size_t len)			/* Length of string in bytes, or (size_t)-1 for
				 * strlen(). */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;	/* State info for channel */
    int result;
    Tcl_Obj *objPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_IO_FAILURE;
    }

    chanPtr = statePtr->topChanPtr;

    if (len == TCL_AUTO_LENGTH) {
	len = strlen(src);
    }
    if (statePtr->encoding) {
	return WriteChars(chanPtr, src, len);
    }

    /*
     * Inefficient way to convert UTF-8 to byte-array, but the code
     * parallels the way it is done for objects.  Special case for 1-byte
     * (used by eg [puts] for the \n) could be extended to more efficient
     * translation of the src string.
     */

    if ((len == 1) && (UCHAR(*src) < 0xC0)) {
	return WriteBytes(chanPtr, src, len);
    }

    objPtr = Tcl_NewStringObj(src, len);
    src = (char *) TclGetByteArrayFromObj(objPtr, &len);
    result = WriteBytes(chanPtr, src, len);
    TclDecrRefCount(objPtr);
    return result;
}

/*
 *---------------------------------------------------------------------------
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WriteObj(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    Tcl_Obj *objPtr)		/* The object to write. */
{
    /*
     * Always use the topmost channel of the stack
     */

    Channel *chanPtr;
    ChannelState *statePtr;	/* State info for channel */
    const char *src;
    int srcLen;

    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return -1;
    }
    if (statePtr->encoding == NULL) {
	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
	return WriteBytes(chanPtr, src, srcLen);
    } else {
	src = TclGetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}








|











|





|


|







4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_WriteObj(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    Tcl_Obj *objPtr)		/* The object to write. */
{
    /*
     * Always use the topmost channel of the stack
     */

    Channel *chanPtr;
    ChannelState *statePtr;	/* State info for channel */
    const char *src;
    size_t srcLen;

    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_IO_FAILURE;
    }
    if (statePtr->encoding == NULL) {
	src = (char *) TclGetByteArrayFromObj(objPtr, &srcLen);
	return WriteBytes(chanPtr, src, srcLen);
    } else {
	src = TclGetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}

4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
 * Side effects:
 *	May flush output on the channel. May cause input to be consumed from
 *	the channel.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_Gets(
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_DString *lineRead)	/* The line read will be appended to this
				 * DString as UTF-8 characters. The caller
				 * must have initialized it and is responsible
				 * for managing the storage. */
{
    Tcl_Obj *objPtr;
    int charsStored;

    TclNewObj(objPtr);
    charsStored = Tcl_GetsObj(chan, objPtr);
    if (charsStored > 0) {
	TclDStringAppendObj(lineRead, objPtr);
    }
    TclDecrRefCount(objPtr);
    return charsStored;
}

/*







|








|



|







4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
 * Side effects:
 *	May flush output on the channel. May cause input to be consumed from
 *	the channel.
 *
 *---------------------------------------------------------------------------
 */

size_t
Tcl_Gets(
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_DString *lineRead)	/* The line read will be appended to this
				 * DString as UTF-8 characters. The caller
				 * must have initialized it and is responsible
				 * for managing the storage. */
{
    Tcl_Obj *objPtr;
    size_t charsStored;

    TclNewObj(objPtr);
    charsStored = Tcl_GetsObj(chan, objPtr);
    if (charsStored + 1 > 1) {
	TclDStringAppendObj(lineRead, objPtr);
    }
    TclDecrRefCount(objPtr);
    return charsStored;
}

/*
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
 *
 *	On reading EOF, leave channel pointing at EOF char. On reading EOL,
 *	leave channel pointing after EOL, but don't return EOL in dst buffer.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_GetsObj(
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_Obj *objPtr)		/* The line read will be appended to this
				 * object as UTF-8 characters. */
{
    GetsState gs;
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
    Tcl_Encoding encoding;
    char *dst, *dstEnd, *eol, *eof;
    Tcl_EncodingState oldState;

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	return -1;
    }

    /*
     * If we're sitting ready to read the eofchar, there's no need to
     * do it.
     */

    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
	assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));

	/* TODO: Do we need this? */
	UpdateInterest(chanPtr);
	return -1;
    }

    /*
     * A binary version of Tcl_GetsObj. This could also handle encodings that
     * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion
     * done on objPtr.
     */







|
















|














|







4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
 *
 *	On reading EOF, leave channel pointing at EOF char. On reading EOL,
 *	leave channel pointing after EOL, but don't return EOL in dst buffer.
 *
 *---------------------------------------------------------------------------
 */

size_t
Tcl_GetsObj(
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_Obj *objPtr)		/* The line read will be appended to this
				 * object as UTF-8 characters. */
{
    GetsState gs;
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
    Tcl_Encoding encoding;
    char *dst, *dstEnd, *eol, *eof;
    Tcl_EncodingState oldState;

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	return TCL_IO_FAILURE;
    }

    /*
     * If we're sitting ready to read the eofchar, there's no need to
     * do it.
     */

    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
	assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));

	/* TODO: Do we need this? */
	UpdateInterest(chanPtr);
	return TCL_IO_FAILURE;
    }

    /*
     * A binary version of Tcl_GetsObj. This could also handle encodings that
     * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion
     * done on objPtr.
     */
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
    encoding = statePtr->encoding;

    /*
     * Preserved so we can restore the channel's state in case we don't find a
     * newline in the available input.
     */

    TclGetStringFromObj(objPtr, &oldLength);
    oldFlags = statePtr->inputEncodingFlags;
    oldState = statePtr->inputEncodingState;
    oldRemoved = BUFFER_PADDING;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }








|







4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
    encoding = statePtr->encoding;

    /*
     * Preserved so we can restore the channel's state in case we don't find a
     * newline in the available input.
     */

    (void)TclGetStringFromObj(objPtr, &oldLength);
    oldFlags = statePtr->inputEncodingFlags;
    oldState = statePtr->inputEncodingState;
    oldRemoved = BUFFER_PADDING;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }

4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
		    /*
		     * If a CR is at the end of the buffer, then check for a
		     * LF at the begining of the next buffer, unless EOF char
		     * was found already.
		     */

		    if (eol >= dstEnd) {
			int offset;

			if (eol != eof) {
			    offset = eol - objPtr->bytes;
			    dst = dstEnd;
			    if (FilterInputBytes(chanPtr, &gs) != 0) {
				goto restore;
			    }







|







4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
		    /*
		     * If a CR is at the end of the buffer, then check for a
		     * LF at the begining of the next buffer, unless EOF char
		     * was found already.
		     */

		    if (eol >= dstEnd) {
			size_t offset;

			if (eol != eof) {
			    offset = eol - objPtr->bytes;
			    dst = dstEnd;
			    if (FilterInputBytes(chanPtr, &gs) != 0) {
				goto restore;
			    }
4922
4923
4924
4925
4926
4927
4928
4929
4930

4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
    Tcl_Obj *objPtr)		/* The line read will be appended to this
				 * object as UTF-8 characters. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
    int rawLen, byteLen, eolChar;

    unsigned char *dst, *dstEnd, *eol, *eof, *byteArray;

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;
    TclChannelPreserve((Tcl_Channel)chanPtr);

    bufPtr = statePtr->inQueueHead;

    /*
     * Preserved so we can restore the channel's state in case we don't find a
     * newline in the available input.
     */

    byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen);
    oldFlags = statePtr->inputEncodingFlags;
    oldRemoved = BUFFER_PADDING;
    oldLength = byteLen;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }








|
|
>
















|







4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
    Tcl_Obj *objPtr)		/* The line read will be appended to this
				 * object as UTF-8 characters. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    int inEofChar, skip, copiedTotal, oldFlags, oldRemoved;
    size_t rawLen, byteLen, oldLength;
    int eolChar;
    unsigned char *dst, *dstEnd, *eol, *eof, *byteArray;

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;
    TclChannelPreserve((Tcl_Channel)chanPtr);

    bufPtr = statePtr->inQueueHead;

    /*
     * Preserved so we can restore the channel's state in case we don't find a
     * newline in the available input.
     */

    byteArray = TclGetByteArrayFromObj(objPtr, &byteLen);
    oldFlags = statePtr->inputEncodingFlags;
    oldRemoved = BUFFER_PADDING;
    oldLength = byteLen;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }

5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Read(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    int bytesToRead)		/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	return -1;
    }

    return DoRead(chanPtr, dst, bytesToRead, 0);
}

/*
 *----------------------------------------------------------------------







|



|












|







5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_Read(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    size_t bytesToRead)		/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	return TCL_IO_FAILURE;
    }

    return DoRead(chanPtr, dst, bytesToRead, 0);
}

/*
 *----------------------------------------------------------------------
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ReadRaw(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *readBuf,		/* Where to store input read. */
    int bytesToRead)		/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int copied = 0;

    assert(bytesToRead > 0);
    if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) {
	return -1;
    }

    /*
     * First read bytes from the push-back buffers.
     */

    while (chanPtr->inQueueHead && bytesToRead > 0) {
	ChannelBuffer *bufPtr = chanPtr->inQueueHead;
	int bytesInBuffer = BytesLeft(bufPtr);
	int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer
		: bytesToRead;

	/*
         * Copy the current chunk into the read buffer.
         */

	memcpy(readBuf, RemovePoint(bufPtr), (size_t) toCopy);
	bufPtr->nextRemoved += toCopy;







|



|








|









|
|







5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ReadRaw(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *readBuf,		/* Where to store input read. */
    size_t bytesToRead)		/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int copied = 0;

    assert(bytesToRead > 0);
    if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) {
	return TCL_IO_FAILURE;
    }

    /*
     * First read bytes from the push-back buffers.
     */

    while (chanPtr->inQueueHead && bytesToRead > 0) {
	ChannelBuffer *bufPtr = chanPtr->inQueueHead;
	int bytesInBuffer = BytesLeft(bufPtr);
	int toCopy = (bytesInBuffer < (int)bytesToRead) ? bytesInBuffer
		: (int)bytesToRead;

	/*
         * Copy the current chunk into the read buffer.
         */

	memcpy(readBuf, RemovePoint(bufPtr), (size_t) toCopy);
	bufPtr->nextRemoved += toCopy;
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701






5702
5703
5704
5705
5706
5707
5708
    /*
     * This test not needed.
     */

    if (bytesToRead > 0) {
	int nread = ChanRead(chanPtr, readBuf, bytesToRead);

	if (nread > 0) {
	    /*
             * Successful read (short is OK) - add to bytes copied.
             */

	    copied += nread;
	} else if (nread < 0) {
	    /*
	     * An error signaled.  If CHANNEL_BLOCKED, then the error is not
	     * real, but an indication of blocked state.  In that case, retain
	     * the flag and let caller receive the short read of copied bytes
	     * from the pushback.  HOWEVER, if copied==0 bytes from pushback
	     * then repeat signalling the blocked state as an error to caller
	     * so there is no false report of an EOF.  When !CHANNEL_BLOCKED,
	     * the error is real and passes on to caller.
	     */

	    if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
		copied = -1;
	    }






	} else {
	    /*
	     * nread == 0.  Driver is at EOF. Let that state filter up.
	     */
	}
    }
    return copied;







|
<
<
<
<
<
<













>
>
>
>
>
>







5677
5678
5679
5680
5681
5682
5683
5684






5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
    /*
     * This test not needed.
     */

    if (bytesToRead > 0) {
	int nread = ChanRead(chanPtr, readBuf, bytesToRead);

	if (nread == -1) {






	    /*
	     * An error signaled.  If CHANNEL_BLOCKED, then the error is not
	     * real, but an indication of blocked state.  In that case, retain
	     * the flag and let caller receive the short read of copied bytes
	     * from the pushback.  HOWEVER, if copied==0 bytes from pushback
	     * then repeat signalling the blocked state as an error to caller
	     * so there is no false report of an EOF.  When !CHANNEL_BLOCKED,
	     * the error is real and passes on to caller.
	     */

	    if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
		copied = -1;
	    }
	} else if (nread > 0) {
	    /*
             * Successful read (short is OK) - add to bytes copied.
             */

	    copied += nread;
	} else {
	    /*
	     * nread == 0.  Driver is at EOF. Let that state filter up.
	     */
	}
    }
    return copied;
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_ReadChars(
    Tcl_Channel chan,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    int toRead,			/* Maximum number of characters to store, or
				 * -1 to read all available data (up to EOF or
				 * when channel blocks). */
    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{







|



|







5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

size_t
Tcl_ReadChars(
    Tcl_Channel chan,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    size_t toRead,		/* Maximum number of characters to store, or
				 * -1 to read all available data (up to EOF or
				 * when channel blocks). */
    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
 *---------------------------------------------------------------------------
 */

static int
DoReadChars(
    Channel *chanPtr,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    int toRead,			/* Maximum number of characters to store, or
				 * -1 to read all available data (up to EOF or
				 * when channel blocks). */
    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{







|







5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
 *---------------------------------------------------------------------------
 */

static int
DoReadChars(
    Channel *chanPtr,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    size_t toRead,			/* Maximum number of characters to store, or
				 * -1 to read all available data (up to EOF or
				 * when channel blocks). */
    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
     */

    if (GotFlag(statePtr, CHANNEL_EOF)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
    for (copied = 0; (unsigned) toRead > 0; ) {
	copiedNow = -1;
	if (statePtr->inQueueHead != NULL) {
	    if (binaryMode) {
		copiedNow = ReadBytes(statePtr, objPtr, toRead);
	    } else {
		copiedNow = ReadChars(statePtr, objPtr, toRead, &factor);
	    }







|







5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
     */

    if (GotFlag(statePtr, CHANNEL_EOF)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
    for (copied = 0; toRead > 0; ) {
	copiedNow = -1;
	if (statePtr->inQueueHead != NULL) {
	    if (binaryMode) {
		copiedNow = ReadBytes(statePtr, objPtr, toRead);
	    } else {
		copiedNow = ReadChars(statePtr, objPtr, toRead, &factor);
	    }
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
ReadBytes(
    ChannelState *statePtr,	/* State of the channel to read. */
    Tcl_Obj *objPtr,		/* Input data is appended to this ByteArray
				 * object. Its length is how much space has
				 * been allocated to hold data, not how many
				 * bytes of data have been stored in the
				 * object. */
    int bytesToRead)		/* Maximum number of bytes to store, or < 0 to
				 * get all available bytes. Bytes are obtained
				 * from the first buffer in the queue - even
				 * if this number is larger than the number of
				 * bytes available in the first buffer, only
				 * the bytes from the first buffer are
				 * returned. */
{







|







5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
ReadBytes(
    ChannelState *statePtr,	/* State of the channel to read. */
    Tcl_Obj *objPtr,		/* Input data is appended to this ByteArray
				 * object. Its length is how much space has
				 * been allocated to hold data, not how many
				 * bytes of data have been stored in the
				 * object. */
    int bytesToRead)		/* Maximum number of bytes to store, or -1 to
				 * get all available bytes. Bytes are obtained
				 * from the first buffer in the queue - even
				 * if this number is larger than the number of
				 * bytes available in the first buffer, only
				 * the bytes from the first buffer are
				 * returned. */
{
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
 *
 * Tcl_Ungets --
 *
 *	Causes the supplied string to be added to the input queue of the
 *	channel, at either the head or tail of the queue.
 *
 * Results:
 *	The number of bytes stored in the channel, or -1 on error.
 *
 * Side effects:
 *	Adds input to the input queue of a channel.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Ungets(
    Tcl_Channel chan,		/* The channel for which to add the input. */
    const char *str,		/* The input itself. */
    int len,			/* The length of the input. */
    int atEnd)			/* If non-zero, add at end of queue; otherwise
				 * add at head of queue. */
{
    Channel *chanPtr;		/* The real IO channel. */
    ChannelState *statePtr;	/* State of actual channel. */
    ChannelBuffer *bufPtr;	/* Buffer to contain the data. */
    int flags;







|







|



|







6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
 *
 * Tcl_Ungets --
 *
 *	Causes the supplied string to be added to the input queue of the
 *	channel, at either the head or tail of the queue.
 *
 * Results:
 *	The number of bytes stored in the channel, or (size_t)-1 on error.
 *
 * Side effects:
 *	Adds input to the input queue of a channel.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_Ungets(
    Tcl_Channel chan,		/* The channel for which to add the input. */
    const char *str,		/* The input itself. */
    size_t len,			/* The length of the input. */
    int atEnd)			/* If non-zero, add at end of queue; otherwise
				 * add at head of queue. */
{
    Channel *chanPtr;		/* The real IO channel. */
    ChannelState *statePtr;	/* State of actual channel. */
    ChannelBuffer *bufPtr;	/* Buffer to contain the data. */
    int flags;
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
6661
6662
6663

    /*
     * CheckChannelErrors clears too many flag bits in this one case.
     */

    flags = statePtr->flags;
    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	len = -1;
	goto done;
    }
    statePtr->flags = flags;

    /*
     * Clear the EOF flags, and clear the BLOCKED bit.
     */

    if (GotFlag(statePtr, CHANNEL_EOF)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr,
	    CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;

    bufPtr = AllocChannelBuffer(len);
    memcpy(InsertPoint(bufPtr), str, (size_t) len);
    bufPtr->nextAdded += len;

    if (statePtr->inQueueHead == NULL) {
	bufPtr->nextPtr = NULL;
	statePtr->inQueueHead = bufPtr;
	statePtr->inQueueTail = bufPtr;
    } else if (atEnd) {







|
















|







6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
6661
6662
6663
6664
6665

    /*
     * CheckChannelErrors clears too many flag bits in this one case.
     */

    flags = statePtr->flags;
    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	len = (size_t)-1;
	goto done;
    }
    statePtr->flags = flags;

    /*
     * Clear the EOF flags, and clear the BLOCKED bit.
     */

    if (GotFlag(statePtr, CHANNEL_EOF)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr,
	    CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;

    bufPtr = AllocChannelBuffer(len);
    memcpy(InsertPoint(bufPtr), str, len);
    bufPtr->nextAdded += len;

    if (statePtr->inQueueHead == NULL) {
	bufPtr->nextPtr = NULL;
	statePtr->inQueueHead = bufPtr;
	statePtr->inQueueTail = bufPtr;
    } else if (atEnd) {
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
6984
6985
6986
6987
6988
6989
6990
6991
6992
6993
6994
6995
6996
6997
6998
6999
7000
7001
7002
7003
    int result;			/* Of device driver operations. */
    Tcl_WideInt curPos;		/* Position on the device. */
    int wasAsync;		/* Was the channel nonblocking before the seek
				 * operation? If so, must restore to
				 * non-blocking mode after the seek. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return Tcl_LongAsWide(-1);
    }

    /*
     * Disallow seek on dead channels - channels that have been closed but not
     * yet been deallocated. Such channels can be found if the exit handler
     * for channel cleanup has run but the channel is still registered in an
     * interpreter.
     */

    if (CheckForDeadChannel(NULL, statePtr)) {
	return Tcl_LongAsWide(-1);
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    /*
     * Disallow seek on channels whose type does not have a seek procedure
     * defined. This means that the channel does not support seeking.
     */

    if (chanPtr->typePtr->seekProc == NULL) {
	Tcl_SetErrno(EINVAL);
	return Tcl_LongAsWide(-1);
    }

    /*
     * Compute how much input and output is buffered. If both input and output
     * is buffered, cannot compute the current position.
     */

    inputBuffered = Tcl_InputBuffered(chan);
    outputBuffered = Tcl_OutputBuffered(chan);

    if ((inputBuffered != 0) && (outputBuffered != 0)) {
	Tcl_SetErrno(EFAULT);
	return Tcl_LongAsWide(-1);
    }

    /*
     * If we are seeking relative to the current position, compute the
     * corrected offset taking into account the amount of unread input.
     */








|










|















|












|







6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
6984
6985
6986
6987
6988
6989
6990
6991
6992
6993
6994
6995
6996
6997
6998
6999
7000
7001
7002
7003
7004
7005
    int result;			/* Of device driver operations. */
    Tcl_WideInt curPos;		/* Position on the device. */
    int wasAsync;		/* Was the channel nonblocking before the seek
				 * operation? If so, must restore to
				 * non-blocking mode after the seek. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return -1;
    }

    /*
     * Disallow seek on dead channels - channels that have been closed but not
     * yet been deallocated. Such channels can be found if the exit handler
     * for channel cleanup has run but the channel is still registered in an
     * interpreter.
     */

    if (CheckForDeadChannel(NULL, statePtr)) {
	return -1;
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    /*
     * Disallow seek on channels whose type does not have a seek procedure
     * defined. This means that the channel does not support seeking.
     */

    if (chanPtr->typePtr->seekProc == NULL) {
	Tcl_SetErrno(EINVAL);
	return -1;
    }

    /*
     * Compute how much input and output is buffered. If both input and output
     * is buffered, cannot compute the current position.
     */

    inputBuffered = Tcl_InputBuffered(chan);
    outputBuffered = Tcl_OutputBuffered(chan);

    if ((inputBuffered != 0) && (outputBuffered != 0)) {
	Tcl_SetErrno(EFAULT);
	return -1;
    }

    /*
     * If we are seeking relative to the current position, compute the
     * corrected offset taking into account the amount of unread input.
     */

7032
7033
7034
7035
7036
7037
7038
7039
7040
7041
7042
7043
7044
7045
7046
     */

    wasAsync = 0;
    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
	wasAsync = 1;
	result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
	if (result != 0) {
	    return Tcl_LongAsWide(-1);
	}
	ResetFlag(statePtr, CHANNEL_NONBLOCKING);
	if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
	}
    }








|







7034
7035
7036
7037
7038
7039
7040
7041
7042
7043
7044
7045
7046
7047
7048
     */

    wasAsync = 0;
    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
	wasAsync = 1;
	result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
	if (result != 0) {
	    return -1;
	}
	ResetFlag(statePtr, CHANNEL_NONBLOCKING);
	if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
	}
    }

7057
7058
7059
7060
7061
7062
7063
7064
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076
7077
7078
7079
7080
7081
7082
7083
7084
7085
7086
7087
    } else {
	/*
	 * Now seek to the new position in the channel as requested by the
	 * caller.
	 */

	curPos = ChanSeek(chanPtr, offset, mode, &result);
	if (curPos == Tcl_LongAsWide(-1)) {
	    Tcl_SetErrno(result);
	}
    }

    /*
     * Restore to nonblocking mode if that was the previous behavior.
     *
     * NOTE: Even if there was an async flush active we do not restore it now
     * because we already flushed all the queued output, above.
     */

    if (wasAsync) {
	SetFlag(statePtr, CHANNEL_NONBLOCKING);
	result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
	if (result != 0) {
	    return Tcl_LongAsWide(-1);
	}
    }

    return curPos;
}

/*







|















|







7059
7060
7061
7062
7063
7064
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076
7077
7078
7079
7080
7081
7082
7083
7084
7085
7086
7087
7088
7089
    } else {
	/*
	 * Now seek to the new position in the channel as requested by the
	 * caller.
	 */

	curPos = ChanSeek(chanPtr, offset, mode, &result);
	if (curPos == -1) {
	    Tcl_SetErrno(result);
	}
    }

    /*
     * Restore to nonblocking mode if that was the previous behavior.
     *
     * NOTE: Even if there was an async flush active we do not restore it now
     * because we already flushed all the queued output, above.
     */

    if (wasAsync) {
	SetFlag(statePtr, CHANNEL_NONBLOCKING);
	result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
	if (result != 0) {
	    return -1;
	}
    }

    return curPos;
}

/*
7113
7114
7115
7116
7117
7118
7119
7120
7121
7122
7123
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149
7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
7169
7170
7171
7172
7173
7174
				/* State info for channel */
    int inputBuffered, outputBuffered;
				/* # bytes held in buffers. */
    int result;			/* Of calling device driver. */
    Tcl_WideInt curPos;		/* Position on device. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return Tcl_LongAsWide(-1);
    }

    /*
     * Disallow tell on dead channels -- channels that have been closed but
     * not yet been deallocated. Such channels can be found if the exit
     * handler for channel cleanup has run but the channel is still registered
     * in an interpreter.
     */

    if (CheckForDeadChannel(NULL, statePtr)) {
	return Tcl_LongAsWide(-1);
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    /*
     * Disallow tell on channels whose type does not have a seek procedure
     * defined. This means that the channel does not support seeking.
     */

    if (chanPtr->typePtr->seekProc == NULL) {
	Tcl_SetErrno(EINVAL);
	return Tcl_LongAsWide(-1);
    }

    /*
     * Compute how much input and output is buffered. If both input and output
     * is buffered, cannot compute the current position.
     */

    inputBuffered = Tcl_InputBuffered(chan);
    outputBuffered = Tcl_OutputBuffered(chan);

    /*
     * Get the current position in the device and compute the position where
     * the next character will be read or written. Note that we prefer the
     * wideSeekProc if that is available and non-NULL...
     */

    curPos = ChanSeek(chanPtr, Tcl_LongAsWide(0), SEEK_CUR, &result);
    if (curPos == Tcl_LongAsWide(-1)) {
	Tcl_SetErrno(result);
	return Tcl_LongAsWide(-1);
    }

    if (inputBuffered != 0) {
	return curPos - inputBuffered;
    }
    return curPos + outputBuffered;
}







|










|















|
















|
|

|







7115
7116
7117
7118
7119
7120
7121
7122
7123
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149
7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
7169
7170
7171
7172
7173
7174
7175
7176
				/* State info for channel */
    int inputBuffered, outputBuffered;
				/* # bytes held in buffers. */
    int result;			/* Of calling device driver. */
    Tcl_WideInt curPos;		/* Position on device. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return -1;
    }

    /*
     * Disallow tell on dead channels -- channels that have been closed but
     * not yet been deallocated. Such channels can be found if the exit
     * handler for channel cleanup has run but the channel is still registered
     * in an interpreter.
     */

    if (CheckForDeadChannel(NULL, statePtr)) {
	return -1;
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    /*
     * Disallow tell on channels whose type does not have a seek procedure
     * defined. This means that the channel does not support seeking.
     */

    if (chanPtr->typePtr->seekProc == NULL) {
	Tcl_SetErrno(EINVAL);
	return -1;
    }

    /*
     * Compute how much input and output is buffered. If both input and output
     * is buffered, cannot compute the current position.
     */

    inputBuffered = Tcl_InputBuffered(chan);
    outputBuffered = Tcl_OutputBuffered(chan);

    /*
     * Get the current position in the device and compute the position where
     * the next character will be read or written. Note that we prefer the
     * wideSeekProc if that is available and non-NULL...
     */

    curPos = ChanSeek(chanPtr, 0, SEEK_CUR, &result);
    if (curPos == -1) {
	Tcl_SetErrno(result);
	return -1;
    }

    if (inputBuffered != 0) {
	return curPos - inputBuffered;
    }
    return curPos + outputBuffered;
}
7224
7225
7226
7227
7228
7229
7230
7231
7232
7233
7234
7235
7236
7237
7238
    /*
     * Seek first to force a total flush of all pending buffers and ditch any
     * pre-read input data.
     */

    WillWrite(chanPtr);

    if (WillRead(chanPtr) < 0) {
        return TCL_ERROR;
    }

    /*
     * We're all flushed to disk now and we also don't have any unfortunate
     * input baggage around either; can truncate with impunity.
     */







|







7226
7227
7228
7229
7230
7231
7232
7233
7234
7235
7236
7237
7238
7239
7240
    /*
     * Seek first to force a total flush of all pending buffers and ditch any
     * pre-read input data.
     */

    WillWrite(chanPtr);

    if (WillRead(chanPtr) == -1) {
        return TCL_ERROR;
    }

    /*
     * We're all flushed to disk now and we also don't have any unfortunate
     * input baggage around either; can truncate with impunity.
     */
7652
7653
7654
7655
7656
7657
7658
7659
7660
7661
7662
7663
7664
7665
7666
	argc--;
	for (i = 0; i < argc; i++) {
	    Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
	}
	Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
        Tcl_SetObjResult(interp, errObj);
	Tcl_DStringFree(&ds);
	ckfree(argv);
    }
    Tcl_SetErrno(EINVAL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------







|







7654
7655
7656
7657
7658
7659
7660
7661
7662
7663
7664
7665
7666
7667
7668
	argc--;
	for (i = 0; i < argc; i++) {
	    Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
	}
	Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
        Tcl_SetObjResult(interp, errObj);
	Tcl_DStringFree(&ds);
	Tcl_Free(argv);
    }
    Tcl_SetErrno(EINVAL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
8043
8044
8045
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
8069
8070
8071
8072
8073
8074
8075
8076

	    if (inValue & 0x80 || outValue & 0x80) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                            "bad value for -eofchar: must be non-NUL ASCII"
                            " character", -1));
		}
		ckfree(argv);
		return TCL_ERROR;
	    }
	    if (GotFlag(statePtr, TCL_READABLE)) {
		statePtr->inEofChar = inValue;
	    }
	    if (GotFlag(statePtr, TCL_WRITABLE)) {
		statePtr->outEofChar = outValue;
	    }
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -eofchar: should be a list of zero,"
			" one, or two elements", -1));
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}
	if (argv != NULL) {
	    ckfree(argv);
	}

	/*
	 * [Bug 930851] Reset EOF and BLOCKED flags. Changing the character
	 * which signals eof can transform a current eof condition into a 'go
	 * ahead'. Ditto for blocked.
	 */







|














|



|







8045
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
8069
8070
8071
8072
8073
8074
8075
8076
8077
8078

	    if (inValue & 0x80 || outValue & 0x80) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                            "bad value for -eofchar: must be non-NUL ASCII"
                            " character", -1));
		}
		Tcl_Free(argv);
		return TCL_ERROR;
	    }
	    if (GotFlag(statePtr, TCL_READABLE)) {
		statePtr->inEofChar = inValue;
	    }
	    if (GotFlag(statePtr, TCL_WRITABLE)) {
		statePtr->outEofChar = outValue;
	    }
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -eofchar: should be a list of zero,"
			" one, or two elements", -1));
	    }
	    Tcl_Free(argv);
	    return TCL_ERROR;
	}
	if (argv != NULL) {
	    Tcl_Free(argv);
	}

	/*
	 * [Bug 930851] Reset EOF and BLOCKED flags. Changing the character
	 * which signals eof can transform a current eof condition into a 'go
	 * ahead'. Ditto for blocked.
	 */
8096
8097
8098
8099
8100
8101
8102
8103
8104
8105
8106
8107
8108
8109
8110
	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -translation: must be a one or two"
			" element list", -1));
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	if (readMode) {
	    TclEolTranslation translation;

	    if (*readMode == '\0') {







|







8098
8099
8100
8101
8102
8103
8104
8105
8106
8107
8108
8109
8110
8111
8112
	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -translation: must be a one or two"
			" element list", -1));
	    }
	    Tcl_Free(argv);
	    return TCL_ERROR;
	}

	if (readMode) {
	    TclEolTranslation translation;

	    if (*readMode == '\0') {
8126
8127
8128
8129
8130
8131
8132
8133
8134
8135
8136
8137
8138
8139
8140
		translation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", -1));
		}
		ckfree(argv);
		return TCL_ERROR;
	    }

	    /*
	     * Reset the EOL flags since we need to look at any buffered data
	     * to see if the new translation mode allows us to complete the
	     * line.







|







8128
8129
8130
8131
8132
8133
8134
8135
8136
8137
8138
8139
8140
8141
8142
		translation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", -1));
		}
		Tcl_Free(argv);
		return TCL_ERROR;
	    }

	    /*
	     * Reset the EOL flags since we need to look at any buffered data
	     * to see if the new translation mode allows us to complete the
	     * line.
8176
8177
8178
8179
8180
8181
8182
8183
8184
8185
8186
8187
8188
8189
8190
8191
8192
8193
8194
		statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", -1));
		}
		ckfree(argv);
		return TCL_ERROR;
	    }
	}
	ckfree(argv);
	return TCL_OK;
    } else if (chanPtr->typePtr->setOptionProc != NULL) {
	return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp,
		optionName, newValue);
    } else {
	return Tcl_BadChannelOption(interp, optionName, NULL);
    }







|



|







8178
8179
8180
8181
8182
8183
8184
8185
8186
8187
8188
8189
8190
8191
8192
8193
8194
8195
8196
		statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", -1));
		}
		Tcl_Free(argv);
		return TCL_ERROR;
	    }
	}
	Tcl_Free(argv);
	return TCL_OK;
    } else if (chanPtr->typePtr->setOptionProc != NULL) {
	return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp,
		optionName, newValue);
    } else {
	return Tcl_BadChannelOption(interp, optionName, NULL);
    }
8239
8240
8241
8242
8243
8244
8245
8246
8247
8248
8249
8250
8251
8252
8253
		prevPtr->nextPtr = nextPtr;
	    }

	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, sPtr);

	    TclDecrRefCount(sPtr->scriptPtr);
	    ckfree(sPtr);
	} else {
	    prevPtr = sPtr;
	}
    }
}

/*







|







8241
8242
8243
8244
8245
8246
8247
8248
8249
8250
8251
8252
8253
8254
8255
		prevPtr->nextPtr = nextPtr;
	    }

	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, sPtr);

	    TclDecrRefCount(sPtr->scriptPtr);
	    Tcl_Free(sPtr);
	} else {
	    prevPtr = sPtr;
	}
    }
}

/*
8586
8587
8588
8589
8590
8591
8592
8593
8594
8595
8596
8597
8598
8599
8600
    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) {
	if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
		(chPtr->clientData == clientData)) {
	    break;
	}
    }
    if (chPtr == NULL) {
	chPtr = ckalloc(sizeof(ChannelHandler));
	chPtr->mask = 0;
	chPtr->proc = proc;
	chPtr->clientData = clientData;
	chPtr->chanPtr = chanPtr;
	chPtr->nextPtr = statePtr->chPtr;
	statePtr->chPtr = chPtr;
    }







|







8588
8589
8590
8591
8592
8593
8594
8595
8596
8597
8598
8599
8600
8601
8602
    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) {
	if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
		(chPtr->clientData == clientData)) {
	    break;
	}
    }
    if (chPtr == NULL) {
	chPtr = Tcl_Alloc(sizeof(ChannelHandler));
	chPtr->mask = 0;
	chPtr->proc = proc;
	chPtr->clientData = clientData;
	chPtr->chanPtr = chanPtr;
	chPtr->nextPtr = statePtr->chPtr;
	statePtr->chPtr = chPtr;
    }
8690
8691
8692
8693
8694
8695
8696
8697
8698
8699
8700
8701
8702
8703
8704
     */

    if (prevChPtr == NULL) {
	statePtr->chPtr = chPtr->nextPtr;
    } else {
	prevChPtr->nextPtr = chPtr->nextPtr;
    }
    ckfree(chPtr);

    /*
     * Recompute the interest list for the channel, so that infinite loops
     * will not result if Tcl_DeleteChannelHandler is called inside an event.
     */

    statePtr->interestMask = 0;







|







8692
8693
8694
8695
8696
8697
8698
8699
8700
8701
8702
8703
8704
8705
8706
     */

    if (prevChPtr == NULL) {
	statePtr->chPtr = chPtr->nextPtr;
    } else {
	prevChPtr->nextPtr = chPtr->nextPtr;
    }
    Tcl_Free(chPtr);

    /*
     * Recompute the interest list for the channel, so that infinite loops
     * will not result if Tcl_DeleteChannelHandler is called inside an event.
     */

    statePtr->interestMask = 0;
8749
8750
8751
8752
8753
8754
8755
8756
8757
8758
8759
8760
8761
8762
8763
		prevEsPtr->nextPtr = esPtr->nextPtr;
	    }

	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, esPtr);

	    TclDecrRefCount(esPtr->scriptPtr);
	    ckfree(esPtr);

	    break;
	}
    }
}

/*







|







8751
8752
8753
8754
8755
8756
8757
8758
8759
8760
8761
8762
8763
8764
8765
		prevEsPtr->nextPtr = esPtr->nextPtr;
	    }

	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, esPtr);

	    TclDecrRefCount(esPtr->scriptPtr);
	    Tcl_Free(esPtr);

	    break;
	}
    }
}

/*
8798
8799
8800
8801
8802
8803
8804
8805
8806
8807
8808
8809
8810
8811
8812
	    break;
	}
    }

    makeCH = (esPtr == NULL);

    if (makeCH) {
	esPtr = ckalloc(sizeof(EventScriptRecord));
    }

    /*
     * Initialize the structure before calling Tcl_CreateChannelHandler,
     * because a reflected channel calling 'chan postevent' aka
     * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke
     * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to







|







8800
8801
8802
8803
8804
8805
8806
8807
8808
8809
8810
8811
8812
8813
8814
	    break;
	}
    }

    makeCH = (esPtr == NULL);

    if (makeCH) {
	esPtr = Tcl_Alloc(sizeof(EventScriptRecord));
    }

    /*
     * Initialize the structure before calling Tcl_CreateChannelHandler,
     * because a reflected channel calling 'chan postevent' aka
     * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke
     * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to
9114
9115
9116
9117
9118
9119
9120
9121
9122
9123
9124
9125
9126
9127
9128

    /*
     * Allocate a new CopyState to maintain info about the current copy in
     * progress. This structure will be deallocated when the copy is
     * completed.
     */

    csPtr = ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
    csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
    csPtr->readPtr = inPtr;
    csPtr->writePtr = outPtr;
    csPtr->readFlags = readFlags;
    csPtr->writeFlags = writeFlags;
    csPtr->toRead = toRead;
    csPtr->total = (Tcl_WideInt) 0;







|







9116
9117
9118
9119
9120
9121
9122
9123
9124
9125
9126
9127
9128
9129
9130

    /*
     * Allocate a new CopyState to maintain info about the current copy in
     * progress. This structure will be deallocated when the copy is
     * completed.
     */

    csPtr = Tcl_Alloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
    csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
    csPtr->readPtr = inPtr;
    csPtr->writePtr = outPtr;
    csPtr->readFlags = readFlags;
    csPtr->writeFlags = writeFlags;
    csPtr->toRead = toRead;
    csPtr->total = (Tcl_WideInt) 0;
9736
9737
9738
9739
9740
9741
9742
9743
9744
9745
9746
9747
9748
9749
9750
9751
9752
9753
9754
9755
9756
9757
 *----------------------------------------------------------------------
 */

static int
DoRead(
    Channel *chanPtr,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    int bytesToRead,		/* Maximum number of bytes to read. */
    int allowShortReads)	/* Allow half-blocking (pipes,sockets) */
{
    ChannelState *statePtr = chanPtr->state;
    char *p = dst;

    assert(bytesToRead >= 0);

    /*
     * Early out when we know a read will get the eofchar.
     *
     * NOTE: This seems to be a bug.  The special handling for
     * a zero-char read request ought to come first.  As coded
     * the EOF due to eofchar has distinguishing behavior from
     * the EOF due to reported EOF on the underlying device, and







|





<
<







9738
9739
9740
9741
9742
9743
9744
9745
9746
9747
9748
9749
9750


9751
9752
9753
9754
9755
9756
9757
 *----------------------------------------------------------------------
 */

static int
DoRead(
    Channel *chanPtr,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    size_t bytesToRead,		/* Maximum number of bytes to read. */
    int allowShortReads)	/* Allow half-blocking (pipes,sockets) */
{
    ChannelState *statePtr = chanPtr->state;
    char *p = dst;



    /*
     * Early out when we know a read will get the eofchar.
     *
     * NOTE: This seems to be a bug.  The special handling for
     * a zero-char read request ought to come first.  As coded
     * the EOF due to eofchar has distinguishing behavior from
     * the EOF due to reported EOF on the underlying device, and
9797
9798
9799
9800
9801
9802
9803
9804
9805
9806
9807
9808
9809
9810
9811

	/*
	 * Don't read more data if we have what we need.
	 */

	while (!bufPtr ||			/* We got no buffer!   OR */
		(!IsBufferFull(bufPtr) && 	/* Our buffer has room AND */
		(BytesLeft(bufPtr) < bytesToRead))) {
						/* Not enough bytes in it yet
						 * to fill the dst */
	    int code;

	moreData:
	    code = GetInput(chanPtr);
	    bufPtr = statePtr->inQueueHead;







|







9797
9798
9799
9800
9801
9802
9803
9804
9805
9806
9807
9808
9809
9810
9811

	/*
	 * Don't read more data if we have what we need.
	 */

	while (!bufPtr ||			/* We got no buffer!   OR */
		(!IsBufferFull(bufPtr) && 	/* Our buffer has room AND */
		((size_t)BytesLeft(bufPtr) < bytesToRead))) {
						/* Not enough bytes in it yet
						 * to fill the dst */
	    int code;

	moreData:
	    code = GetInput(chanPtr);
	    bufPtr = statePtr->inQueueHead;
10041
10042
10043
10044
10045
10046
10047
10048
10049
10050
10051
10052
10053
10054
10055
	}
	Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
	TclDecrRefCount(csPtr->cmdPtr);
    }
    inStatePtr->csPtrR = NULL;
    outStatePtr->csPtrW = NULL;
    ckfree(csPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * StackSetBlockMode --
 *







|







10041
10042
10043
10044
10045
10046
10047
10048
10049
10050
10051
10052
10053
10054
10055
	}
	Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
	TclDecrRefCount(csPtr->cmdPtr);
    }
    inStatePtr->csPtrR = NULL;
    outStatePtr->csPtrW = NULL;
    Tcl_Free(csPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * StackSetBlockMode --
 *
11014
11015
11016
11017
11018
11019
11020
11021
11022
11023
11024
11025
11026
11027
11028
    if (newlevel >= 0) {
	lcn += 2;
    }
    if (newcode >= 0) {
	lcn += 2;
    }

    lvn = ckalloc(lcn * sizeof(Tcl_Obj *));

    /*
     * New level/code information is spliced into the first occurence of
     * -level, -code, further occurences are ignored. The options cannot be
     * not present, we would not come here. Options which are ok are simply
     * copied over.
     */







|







11014
11015
11016
11017
11018
11019
11020
11021
11022
11023
11024
11025
11026
11027
11028
    if (newlevel >= 0) {
	lcn += 2;
    }
    if (newcode >= 0) {
	lcn += 2;
    }

    lvn = Tcl_Alloc(lcn * sizeof(Tcl_Obj *));

    /*
     * New level/code information is spliced into the first occurence of
     * -level, -code, further occurences are ignored. The options cannot be
     * not present, we would not come here. Options which are ok are simply
     * copied over.
     */
11067
11068
11069
11070
11071
11072
11073
11074
11075
11076
11077
11078
11079
11080
11081

    if (explicitResult) {
	lvn[j++] = lv[i];
    }

    msg = Tcl_NewListObj(j, lvn);

    ckfree(lvn);
    return msg;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetChannelErrorInterp --







|







11067
11068
11069
11070
11071
11072
11073
11074
11075
11076
11077
11078
11079
11080
11081

    if (explicitResult) {
	lvn[j++] = lv[i];
    }

    msg = Tcl_NewListObj(j, lvn);

    Tcl_Free(lvn);
    return msg;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetChannelErrorInterp --
11214
11215
11216
11217
11218
11219
11220
11221
11222
11223
11224
11225
11226
11227
11228
    ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;

    objPtr->typePtr = NULL;
    if (resPtr->refCount-- > 1) {
	return;
    }
    Tcl_Release(resPtr->statePtr);
    ckfree(resPtr);
}

#if 0
/*
 * For future debugging work, a simple function to print the flags of a
 * channel in semi-readable form.
 */







|







11214
11215
11216
11217
11218
11219
11220
11221
11222
11223
11224
11225
11226
11227
11228
    ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;

    objPtr->typePtr = NULL;
    if (resPtr->refCount-- > 1) {
	return;
    }
    Tcl_Release(resPtr->statePtr);
    Tcl_Free(resPtr);
}

#if 0
/*
 * For future debugging work, a simple function to print the flags of a
 * channel in semi-readable form.
 */
Changes to generic/tclIO.h.
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
 * data specific to the channel but which belongs to the generic part of the
 * Tcl channel mechanism, and it points at an instance specific (and type
 * specific) instance data, and at a channel type structure.
 */

typedef struct Channel {
    struct ChannelState *state; /* Split out state information */
    ClientData instanceData;	/* Instance-specific data provided by creator
				 * of channel. */
    const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
    struct Channel *downChanPtr;/* Refers to channel this one was stacked
				 * upon. This reference is NULL for normal
				 * channels. See Tcl_StackChannel. */
    struct Channel *upChanPtr;	/* Refers to the channel above stacked this
				 * one. NULL for the top most channel. */







|







92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
 * data specific to the channel but which belongs to the generic part of the
 * Tcl channel mechanism, and it points at an instance specific (and type
 * specific) instance data, and at a channel type structure.
 */

typedef struct Channel {
    struct ChannelState *state; /* Split out state information */
    void *instanceData;	/* Instance-specific data provided by creator
				 * of channel. */
    const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
    struct Channel *downChanPtr;/* Refers to channel this one was stacked
				 * upon. This reference is NULL for normal
				 * channels. See Tcl_StackChannel. */
    struct Channel *upChanPtr;	/* Refers to the channel above stacked this
				 * one. NULL for the top most channel. */
Changes to generic/tclIOCmd.c.
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
		"channel \"%s\" wasn't opened for writing",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    TclChannelPreserve(chan);
    result = Tcl_WriteObj(chan, string);
    if (result < 0) {
	goto error;
    }
    if (newline != 0) {
	result = Tcl_WriteChars(chan, "\n", 1);
	if (result < 0) {
	    goto error;
	}
    }
    TclChannelRelease(chan);
    return TCL_OK;

    /*







|




|







164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
		"channel \"%s\" wasn't opened for writing",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    TclChannelPreserve(chan);
    result = Tcl_WriteObj(chan, string);
    if (result == -1) {
	goto error;
    }
    if (newline != 0) {
	result = Tcl_WriteChars(chan, "\n", 1);
	if (result == -1) {
	    goto error;
	}
    }
    TclChannelRelease(chan);
    return TCL_OK;

    /*
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
	    return TCL_ERROR;
	}
	mode = modeArray[optionIndex];
    }

    TclChannelPreserve(chan);
    result = Tcl_Seek(chan, offset, mode);
    if (result == Tcl_LongAsWide(-1)) {
	/*
	 * TIP #219.
	 * Capture error messages put by the driver into the bypass area and
	 * put them into the regular interpreter result. Fall back to the
	 * regular message if nothing was found in the bypass.
	 */








|







528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
	    return TCL_ERROR;
	}
	mode = modeArray[optionIndex];
    }

    TclChannelPreserve(chan);
    result = Tcl_Seek(chan, offset, mode);
    if (result == -1) {
	/*
	 * TIP #219.
	 * Capture error messages put by the driver into the bypass area and
	 * put them into the regular interpreter result. Fall back to the
	 * regular message if nothing was found in the bypass.
	 */

960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    resultPtr = Tcl_NewObj();
    if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
	if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
	    /*
	     * TIP #219.
	     * Capture error messages put by the driver into the bypass area
	     * and put them into the regular interpreter result. Fall back to
	     * the regular message if nothing was found in the bypass.
	     */








|







960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    resultPtr = Tcl_NewObj();
    if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
	if (Tcl_ReadChars(chan, resultPtr, -1, 0) == TCL_IO_FAILURE) {
	    /*
	     * TIP #219.
	     * Capture error messages put by the driver into the bypass area
	     * and put them into the regular interpreter result. Fall back to
	     * the regular message if nothing was found in the bypass.
	     */

1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
		break;
	    }
	    chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
	    if (binary && chan) {
		Tcl_SetChannelOption(interp, chan, "-translation", "binary");
	    }
	}
	ckfree(cmdArgv);
    }
    if (chan == NULL) {
	return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp, chan);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return TCL_OK;







|







1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
		break;
	    }
	    chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
	    if (binary && chan) {
		Tcl_SetChannelOption(interp, chan, "-translation", "binary");
	    }
	}
	Tcl_Free(cmdArgv);
    }
    if (chan == NULL) {
	return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp, chan);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return TCL_OK;
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	AcceptCallback *acceptCallbackPtr = Tcl_GetHashValue(hPtr);

	acceptCallbackPtr->interp = NULL;
    }
    Tcl_DeleteHashTable(hTblPtr);
    ckfree(hTblPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * RegisterTcpServerInterpCleanup --
 *







|







1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	AcceptCallback *acceptCallbackPtr = Tcl_GetHashValue(hPtr);

	acceptCallbackPtr->interp = NULL;
    }
    Tcl_DeleteHashTable(hTblPtr);
    Tcl_Free(hTblPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * RegisterTcpServerInterpCleanup --
 *
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
				 * deleted. */
    Tcl_HashEntry *hPtr;	/* Entry for this record. */
    int isNew;			/* Is the entry new? */

    hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);

    if (hTblPtr == NULL) {
	hTblPtr = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
	Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
		TcpAcceptCallbacksDeleteProc, hTblPtr);
    }

    hPtr = Tcl_CreateHashEntry(hTblPtr, acceptCallbackPtr, &isNew);
    if (!isNew) {







|







1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
				 * deleted. */
    Tcl_HashEntry *hPtr;	/* Entry for this record. */
    int isNew;			/* Is the entry new? */

    hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);

    if (hTblPtr == NULL) {
	hTblPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
	Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
		TcpAcceptCallbacksDeleteProc, hTblPtr);
    }

    hPtr = Tcl_CreateHashEntry(hTblPtr, acceptCallbackPtr, &isNew);
    if (!isNew) {
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
				/* The actual data. */

    if (acceptCallbackPtr->interp != NULL) {
	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
		acceptCallbackPtr);
    }
    Tcl_DecrRefCount(acceptCallbackPtr->script);
    ckfree(acceptCallbackPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SocketObjCmd --
 *







|







1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
				/* The actual data. */

    if (acceptCallbackPtr->interp != NULL) {
	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
		acceptCallbackPtr);
    }
    Tcl_DecrRefCount(acceptCallbackPtr->script);
    Tcl_Free(acceptCallbackPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SocketObjCmd --
 *
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
    if (a != objc-1) {
	goto wrongNumArgs;
    }

    port = TclGetString(objv[a]);

    if (server) {
	AcceptCallback *acceptCallbackPtr = ckalloc(sizeof(AcceptCallback));

	Tcl_IncrRefCount(script);
	acceptCallbackPtr->script = script;
	acceptCallbackPtr->interp = interp;

	chan = Tcl_OpenTcpServerEx(interp, port, host, flags,
		AcceptCallbackProc, acceptCallbackPtr);
	if (chan == NULL) {
	    Tcl_DecrRefCount(script);
	    ckfree(acceptCallbackPtr);
	    return TCL_ERROR;
	}

	/*
	 * Register with the interpreter to let us know when the interpreter
	 * is deleted (by having the callback set the interp field of the
	 * acceptCallbackPtr's structure to NULL). This is to avoid trying to







|









|







1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
    if (a != objc-1) {
	goto wrongNumArgs;
    }

    port = TclGetString(objv[a]);

    if (server) {
	AcceptCallback *acceptCallbackPtr = Tcl_Alloc(sizeof(AcceptCallback));

	Tcl_IncrRefCount(script);
	acceptCallbackPtr->script = script;
	acceptCallbackPtr->interp = interp;

	chan = Tcl_OpenTcpServerEx(interp, port, host, flags,
		AcceptCallbackProc, acceptCallbackPtr);
	if (chan == NULL) {
	    Tcl_DecrRefCount(script);
	    Tcl_Free(acceptCallbackPtr);
	    return TCL_ERROR;
	}

	/*
	 * Register with the interpreter to let us know when the interpreter
	 * is deleted (by having the callback set the interp field of the
	 * acceptCallbackPtr's structure to NULL). This is to avoid trying to
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
	}
    } else {
	/*
	 * User wants to truncate to the current file position.
	 */

	length = Tcl_Tell(chan);
	if (length == Tcl_WideAsLong(-1)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not determine current location in \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
    }








|







1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
	}
    } else {
	/*
	 * User wants to truncate to the current file position.
	 */

	length = Tcl_Tell(chan);
	if (length == -1) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not determine current location in \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
    }

Changes to generic/tclIOGT.c.
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
    TransformChannelData *dataPtr)
{
    if (dataPtr->refCount-- > 1) {
	return;
    }
    ResultClear(&dataPtr->result);
    Tcl_DecrRefCount(dataPtr->command);
    ckfree(dataPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclChannelTransform --
 *







|







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
    TransformChannelData *dataPtr)
{
    if (dataPtr->refCount-- > 1) {
	return;
    }
    ResultClear(&dataPtr->result);
    Tcl_DecrRefCount(dataPtr->command);
    Tcl_Free(dataPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclChannelTransform --
 *
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297

    /*
     * Now initialize the transformation state and stack it upon the specified
     * channel. One of the necessary things to do is to retrieve the blocking
     * regime of the underlying channel and to use the same for us too.
     */

    dataPtr = ckalloc(sizeof(TransformChannelData));

    dataPtr->refCount = 1;
    Tcl_DStringInit(&ds);
    Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
    dataPtr->readIsFlushed = 0;
    dataPtr->eofPending = 0;
    dataPtr->flags = 0;







|







283
284
285
286
287
288
289
290
291
292
293
294
295
296
297

    /*
     * Now initialize the transformation state and stack it upon the specified
     * channel. One of the necessary things to do is to retrieve the blocking
     * regime of the underlying channel and to use the same for us too.
     */

    dataPtr = Tcl_Alloc(sizeof(TransformChannelData));

    dataPtr->refCount = 1;
    Tcl_DStringInit(&ds);
    Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
    dataPtr->readIsFlushed = 0;
    dataPtr->eofPending = 0;
    dataPtr->flags = 0;
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
    Tcl_DriverWideSeekProc *parentWideSeekProc =
	    Tcl_ChannelWideSeekProc(parentType);
    ClientData parentData = Tcl_GetChannelInstanceData(parent);

    if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) {
	/*
	 * This is no seek but a request to tell the caller the current
	 * location. Simply pass the request down.
	 */

	if (parentWideSeekProc != NULL) {
	    return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
	}

	return Tcl_LongAsWide(parentSeekProc(parentData, 0, mode,
		errorCodePtr));
    }

    /*
     * It is a real request to change the position. Flush all data waiting for
     * output and discard everything in the input buffers. Then pass the
     * request down, unchanged.
     */







|









|
<







906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923

924
925
926
927
928
929
930
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
    Tcl_DriverWideSeekProc *parentWideSeekProc =
	    Tcl_ChannelWideSeekProc(parentType);
    ClientData parentData = Tcl_GetChannelInstanceData(parent);

    if ((offset == 0) && (mode == SEEK_CUR)) {
	/*
	 * This is no seek but a request to tell the caller the current
	 * location. Simply pass the request down.
	 */

	if (parentWideSeekProc != NULL) {
	    return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
	}

	return parentSeekProc(parentData, 0, mode, errorCodePtr);

    }

    /*
     * It is a real request to change the position. Flush all data waiting for
     * output and discard everything in the input buffers. Then pass the
     * request down, unchanged.
     */
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
     * We're transferring to narrow seeks at this point; this is a bit complex
     * because we have to check whether the seek is possible first (i.e.
     * whether we are losing information in truncating the bits of the
     * offset). Luckily, there's a defined error for what happens when trying
     * to go out of the representable range.
     */

    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
	*errorCodePtr = EOVERFLOW;
	return Tcl_LongAsWide(-1);
    }

    return Tcl_LongAsWide(parentSeekProc(parentData, Tcl_WideAsLong(offset),
	    mode, errorCodePtr));
}

/*
 *----------------------------------------------------------------------
 *
 * TransformSetOptionProc --
 *







|

|


|
|







956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
     * We're transferring to narrow seeks at this point; this is a bit complex
     * because we have to check whether the seek is possible first (i.e.
     * whether we are losing information in truncating the bits of the
     * offset). Luckily, there's a defined error for what happens when trying
     * to go out of the representable range.
     */

    if (offset<LONG_MIN || offset>LONG_MAX) {
	*errorCodePtr = EOVERFLOW;
	return -1;
    }

    return parentSeekProc(parentData, offset,
	    mode, errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TransformSetOptionProc --
 *
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
static inline void
ResultClear(
    ResultBuffer *r)		/* Reference to the buffer to clear out. */
{
    r->used = 0;

    if (r->allocated) {
	ckfree(r->buf);
	r->buf = NULL;
	r->allocated = 0;
    }
}

/*
 *----------------------------------------------------------------------







|







1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
static inline void
ResultClear(
    ResultBuffer *r)		/* Reference to the buffer to clear out. */
{
    r->used = 0;

    if (r->allocated) {
	Tcl_Free(r->buf);
	r->buf = NULL;
	r->allocated = 0;
    }
}

/*
 *----------------------------------------------------------------------
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
    if (r->used + toWrite > r->allocated) {
	/*
	 * Extension of the internal buffer is required.
	 */

	if (r->allocated == 0) {
	    r->allocated = toWrite + INCREMENT;
	    r->buf = ckalloc(r->allocated);
	} else {
	    r->allocated += toWrite + INCREMENT;
	    r->buf = ckrealloc(r->buf, r->allocated);
	}
    }

    /*
     * Now we may copy the data.
     */








|


|







1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
    if (r->used + toWrite > r->allocated) {
	/*
	 * Extension of the internal buffer is required.
	 */

	if (r->allocated == 0) {
	    r->allocated = toWrite + INCREMENT;
	    r->buf = Tcl_Alloc(r->allocated);
	} else {
	    r->allocated += toWrite + INCREMENT;
	    r->buf = Tcl_Realloc(r->buf, r->allocated);
	}
    }

    /*
     * Now we may copy the data.
     */

Changes to generic/tclIORChan.c.
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
 * ForwardParamBase. Where an operation does not need any special types, it
 * has no "subtype" and just uses ForwardParamBase, as listed above.)
 */

struct ForwardParamInput {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    char *buf;			/* O: Where to store the read bytes */
    int toRead;			/* I: #bytes to read,
				 * O: #bytes actually read */
};
struct ForwardParamOutput {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    const char *buf;		/* I: Where the bytes to write come from */
    int toWrite;		/* I: #bytes to write,
				 * O: #bytes actually written */







|







248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
 * ForwardParamBase. Where an operation does not need any special types, it
 * has no "subtype" and just uses ForwardParamBase, as listed above.)
 */

struct ForwardParamInput {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    char *buf;			/* O: Where to store the read bytes */
    size_t toRead;			/* I: #bytes to read,
				 * O: #bytes actually read */
};
struct ForwardParamOutput {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    const char *buf;		/* I: Where the bytes to write come from */
    int toWrite;		/* I: #bytes to write,
				 * O: #bytes actually written */
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
static void		ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
			    ForwardedOperation op, const void *param);
static int		ForwardProc(Tcl_Event *evPtr, int mask);
static void		SrcExitProc(ClientData clientData);

#define FreeReceivedError(p) \
	if ((p)->base.mustFree) {                               \
	    ckfree((p)->base.msgStr);                           \
	}
#define PassReceivedErrorInterp(i,p) \
	if ((i) != NULL) {                                      \
	    Tcl_SetChannelErrorInterp((i),                      \
		    Tcl_NewStringObj((p)->base.msgStr, -1));    \
	}                                                       \
	FreeReceivedError(p)







|







381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
static void		ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
			    ForwardedOperation op, const void *param);
static int		ForwardProc(Tcl_Event *evPtr, int mask);
static void		SrcExitProc(ClientData clientData);

#define FreeReceivedError(p) \
	if ((p)->base.mustFree) {                               \
	    Tcl_Free((p)->base.msgStr);                           \
	}
#define PassReceivedErrorInterp(i,p) \
	if ((i) != NULL) {                                      \
	    Tcl_SetChannelErrorInterp((i),                      \
		    Tcl_NewStringObj((p)->base.msgStr, -1));    \
	}                                                       \
	FreeReceivedError(p)
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
    if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
	/*
	 * Some of the nullable methods are not supported. We clone the
	 * channel type, null the associated C functions, and use the result
	 * as the actual channel type.
	 */

	Tcl_ChannelType *clonePtr = ckalloc(sizeof(Tcl_ChannelType));

	memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));

	if (!(methods & FLAG(METH_CONFIGURE))) {
	    clonePtr->setOptionProc = NULL;
	}








|







666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
    if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
	/*
	 * Some of the nullable methods are not supported. We clone the
	 * channel type, null the associated C functions, and use the result
	 * as the actual channel type.
	 */

	Tcl_ChannelType *clonePtr = Tcl_Alloc(sizeof(Tcl_ChannelType));

	memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));

	if (!(methods & FLAG(METH_CONFIGURE))) {
	    clonePtr->setOptionProc = NULL;
	}

721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
            Tcl_NewStringObj(chanPtr->state->channelName, -1));
    return TCL_OK;

  error:
    Tcl_DecrRefCount(rcPtr->name);
    Tcl_DecrRefCount(rcPtr->methods);
    Tcl_DecrRefCount(rcPtr->cmd);
    ckfree(rcPtr);
    return TCL_ERROR;

#undef MODE
#undef CMD
}

/*







|







721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
            Tcl_NewStringObj(chanPtr->state->channelName, -1));
    return TCL_OK;

  error:
    Tcl_DecrRefCount(rcPtr->name);
    Tcl_DecrRefCount(rcPtr->methods);
    Tcl_DecrRefCount(rcPtr->cmd);
    Tcl_Free(rcPtr);
    return TCL_ERROR;

#undef MODE
#undef CMD
}

/*
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933

#if TCL_THREADS
    if (rcPtr->owner == rcPtr->thread) {
#endif
        Tcl_NotifyChannel(chan, events);
#if TCL_THREADS
    } else {
        ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));

        ev->header.proc = ReflectEventRun;
        ev->events = events;
        ev->rcPtr = rcPtr;

        /*
         * We are not preserving the structure here. When the channel is







|







919
920
921
922
923
924
925
926
927
928
929
930
931
932
933

#if TCL_THREADS
    if (rcPtr->owner == rcPtr->thread) {
#endif
        Tcl_NotifyChannel(chan, events);
#if TCL_THREADS
    } else {
        ReflectEvent *ev = Tcl_Alloc(sizeof(ReflectEvent));

        ev->header.proc = ReflectEventRun;
        ev->events = events;
        ev->rcPtr = rcPtr;

        /*
         * We are not preserving the structure here. When the channel is
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
		FreeReceivedError(&p);
	    }
	}
#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree(tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	return EOK;
    }

    /*







|







1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
		FreeReceivedError(&p);
	    }
	}
#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    Tcl_Free((void *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	return EOK;
    }

    /*
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
    }
#endif
    tctPtr = ((Channel *)rcPtr->chan)->typePtr;
    if (tctPtr && tctPtr != &tclRChannelType) {
	ckfree(tctPtr);
	((Channel *)rcPtr->chan)->typePtr = NULL;
    }
    Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
    return (result == TCL_OK) ? EOK : EINVAL;
}

/*







|







1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
    }
#endif
    tctPtr = ((Channel *)rcPtr->chan)->typePtr;
    if (tctPtr && tctPtr != &tclRChannelType) {
	Tcl_Free((void *)tctPtr);
	((Channel *)rcPtr->chan)->typePtr = NULL;
    }
    Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
    return (result == TCL_OK) ? EOK : EINVAL;
}

/*
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
    ClientData clientData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = clientData;
    Tcl_Obj *toReadObj;
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    Tcl_Obj *resObj;		/* Result data for 'read' */

    /*
     * Are we in the correct thread?
     */








|







1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
    ClientData clientData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = clientData;
    Tcl_Obj *toReadObj;
    size_t bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    Tcl_Obj *resObj;		/* Result data for 'read' */

    /*
     * Are we in the correct thread?
     */

1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
                 */

		*errorCodePtr = -p.base.code;
	    } else {
		PassReceivedError(rcPtr->chan, &p);
		*errorCodePtr = EINVAL;
	    }
	    p.input.toRead = -1;
	} else {
	    *errorCodePtr = EOK;
	}

	return p.input.toRead;
    }
#endif







|







1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
                 */

		*errorCodePtr = -p.base.code;
	    } else {
		PassReceivedError(rcPtr->chan, &p);
		*errorCodePtr = EINVAL;
	    }
	    p.input.toRead = (size_t)-1;
	} else {
	    *errorCodePtr = EOK;
	}

	return p.input.toRead;
    }
#endif
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
            goto error;
	}

	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

    if (toRead < bytec) {
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
        goto invalid;
    }

    *errorCodePtr = EOK;

    if (bytec > 0) {
	memcpy(buf, bytev, (size_t) bytec);
    }

 stop:
    Tcl_DecrRefCount(toReadObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    Tcl_Release(rcPtr);
    return bytec;







|

|

|




|
|







1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
            goto error;
	}

	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    bytev = TclGetByteArrayFromObj(resObj, &bytec);

    if ((size_t)toRead < bytec) {
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
	goto invalid;
    }

    *errorCodePtr = EOK;

    if (bytec + 1 > 1) {
	memcpy(buf, bytev, bytec);
    }

 stop:
    Tcl_DecrRefCount(toReadObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    Tcl_Release(rcPtr);
    return bytec;
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
    }

    if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
        goto invalid;
    }

    if (newLoc < Tcl_LongAsWide(0)) {
	SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
        goto invalid;
    }

    *errorCodePtr = EOK;
 stop:
    Tcl_DecrRefCount(offObj);







|







1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
    }

    if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
        goto invalid;
    }

    if (newLoc < 0) {
	SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
        goto invalid;
    }

    *errorCodePtr = EOK;
 stop:
    Tcl_DecrRefCount(offObj);
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
    /*
     * This function can be invoked from a transformation which is based on
     * standard seeking, i.e. non-wide. Because of this we have to implement
     * it, a dummy is not enough. We simply delegate the call to the wide
     * routine.
     */

    return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
	    errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectWatch --







|







1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
    /*
     * This function can be invoked from a transformation which is based on
     * standard seeking, i.e. non-wide. Because of this we have to implement
     * it, a dummy is not enough. We simply delegate the call to the wide
     * routine.
     */

    return ReflectSeekWide(clientData, offset, seekMode,
	    errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectWatch --
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
    Tcl_Obj *cmdpfxObj,
    int mode,
    Tcl_Obj *handleObj)
{
    ReflectedChannel *rcPtr;
    MethodName mn = METH_BLOCKING;

    rcPtr = ckalloc(sizeof(ReflectedChannel));

    /* rcPtr->chan: Assigned by caller. Dummy data here. */

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
    rcPtr->dead = 0;
#if TCL_THREADS







|







2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
    Tcl_Obj *cmdpfxObj,
    int mode,
    Tcl_Obj *handleObj)
{
    ReflectedChannel *rcPtr;
    MethodName mn = METH_BLOCKING;

    rcPtr = Tcl_Alloc(sizeof(ReflectedChannel));

    /* rcPtr->chan: Assigned by caller. Dummy data here. */

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
    rcPtr->dead = 0;
#if TCL_THREADS
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
    }
    if (rcPtr->methods) {
	Tcl_DecrRefCount(rcPtr->methods);
    }
    if (rcPtr->cmd) {
	Tcl_DecrRefCount(rcPtr->cmd);
    }
    ckfree(rcPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *







|







2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
    }
    if (rcPtr->methods) {
	Tcl_DecrRefCount(rcPtr->methods);
    }
    if (rcPtr->cmd) {
	Tcl_DecrRefCount(rcPtr->cmd);
    }
    Tcl_Free(rcPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
static ReflectedChannelMap *
GetReflectedChannelMap(
    Tcl_Interp *interp)
{
    ReflectedChannelMap *rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL);

    if (rcmPtr == NULL) {
	rcmPtr = ckalloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, RCMKEY,
		(Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr);
    }
    return rcmPtr;
}








|







2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
static ReflectedChannelMap *
GetReflectedChannelMap(
    Tcl_Interp *interp)
{
    ReflectedChannelMap *rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL);

    if (rcmPtr == NULL) {
	rcmPtr = Tcl_Alloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, RCMKEY,
		(Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr);
    }
    return rcmPtr;
}

2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
	chan = Tcl_GetHashValue(hPtr);
	rcPtr = Tcl_GetChannelInstanceData(chan);

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rcmPtr->map);
    ckfree(&rcmPtr->map);

#if TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*







|







2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
	chan = Tcl_GetHashValue(hPtr);
	rcPtr = Tcl_GetChannelInstanceData(chan);

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rcmPtr->map);
    Tcl_Free(&rcmPtr->map);

#if TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656

static ReflectedChannelMap *
GetThreadReflectedChannelMap(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->rcmPtr) {
	tsdPtr->rcmPtr = ckalloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
	Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
    }

    return tsdPtr->rcmPtr;
}








|







2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656

static ReflectedChannelMap *
GetThreadReflectedChannelMap(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->rcmPtr) {
	tsdPtr->rcmPtr = Tcl_Alloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
	Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
    }

    return tsdPtr->rcmPtr;
}

2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
	Tcl_Channel chan = Tcl_GetHashValue(hPtr);
	ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    ckfree(rcmPtr);
}

static void
ForwardOpToHandlerThread(
    ReflectedChannel *rcPtr,	/* Channel instance */
    ForwardedOperation op,	/* Forwarded driver operation */
    const void *param)		/* Arguments */







|







2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
	Tcl_Channel chan = Tcl_GetHashValue(hPtr);
	ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_Free(rcmPtr);
}

static void
ForwardOpToHandlerThread(
    ReflectedChannel *rcPtr,	/* Channel instance */
    ForwardedOperation op,	/* Forwarded driver operation */
    const void *param)		/* Arguments */
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
	return;
    }

    /*
     * Create and initialize the event and data structures.
     */

    evPtr = ckalloc(sizeof(ForwardingEvent));
    resultPtr = ckalloc(sizeof(ForwardingResult));

    evPtr->event.proc = ForwardProc;
    evPtr->resultPtr = resultPtr;
    evPtr->op = op;
    evPtr->rcPtr = rcPtr;
    evPtr->param = (ForwardParam *) param;








|
|







2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
	return;
    }

    /*
     * Create and initialize the event and data structures.
     */

    evPtr = Tcl_Alloc(sizeof(ForwardingEvent));
    resultPtr = Tcl_Alloc(sizeof(ForwardingResult));

    evPtr->event.proc = ForwardProc;
    evPtr->resultPtr = resultPtr;
    evPtr->op = op;
    evPtr->rcPtr = rcPtr;
    evPtr->param = (ForwardParam *) param;

2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
     * returning the success code.
     *
     * Note: The event structure has already been deleted.
     */

    Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);

    ckfree(resultPtr);
}

static int
ForwardProc(
    Tcl_Event *evGPtr,
    int mask)
{







|







2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
     * returning the success code.
     *
     * Note: The event structure has already been deleted.
     */

    Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);

    Tcl_Free(resultPtr);
}

static int
ForwardProc(
    Tcl_Event *evGPtr,
    int mask)
{
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
	    int code = ErrnoReturn(rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }
	    paramPtr->input.toRead = -1;
	} else {
	    /*
	     * Process a regular result.
	     */

	    int bytec;			/* Number of returned bytes */
	    unsigned char *bytev;	/* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    if (paramPtr->input.toRead < bytec) {
		ForwardSetStaticError(paramPtr, msg_read_toomuch);
		paramPtr->input.toRead = -1;
	    } else {
		if (bytec > 0) {
		    memcpy(paramPtr->input.buf, bytev, (size_t) bytec);
		}
		paramPtr->input.toRead = bytec;
	    }
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(toReadObj);
	break;







|





|


|



|

|
|







2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
	    int code = ErrnoReturn(rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }
	    paramPtr->input.toRead = (size_t)-1;
	} else {
	    /*
	     * Process a regular result.
	     */

	    size_t bytec;			/* Number of returned bytes */
	    unsigned char *bytev;	/* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);

	    if (paramPtr->input.toRead < bytec) {
		ForwardSetStaticError(paramPtr, msg_read_toomuch);
		paramPtr->input.toRead = (size_t)-1;
	    } else {
		if (bytec + 1 > 1) {
		    memcpy(paramPtr->input.buf, bytev, bytec);
		}
		paramPtr->input.toRead = bytec;
	    }
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(toReadObj);
	break;
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
	     * Process a regular result. If the type is wrong this may change
	     * into an error.
	     */

	    Tcl_WideInt newLoc;

	    if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) {
		if (newLoc < Tcl_LongAsWide(0)) {
		    ForwardSetStaticError(paramPtr, msg_seek_beforestart);
		    paramPtr->seek.offset = -1;
		} else {
		    paramPtr->seek.offset = newLoc;
		}
	    } else {
		Tcl_DecrRefCount(resObj);







|







3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
	     * Process a regular result. If the type is wrong this may change
	     * into an error.
	     */

	    Tcl_WideInt newLoc;

	    if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) {
		if (newLoc < 0) {
		    ForwardSetStaticError(paramPtr, msg_seek_beforestart);
		    paramPtr->seek.offset = -1;
		} else {
		    paramPtr->seek.offset = newLoc;
		}
	    } else {
		Tcl_DecrRefCount(resObj);
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
	    } else if ((listc % 2) == 1) {
		/*
		 * Odd number of elements is wrong. [x].
		 */

		char *buf = ckalloc(200);
		sprintf(buf,
			"{Expected list with even number of elements, got %d %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		int len;







|







3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
	    } else if ((listc % 2) == 1) {
		/*
		 * Odd number of elements is wrong. [x].
		 */

		char *buf = Tcl_Alloc(200);
		sprintf(buf,
			"{Expected list with even number of elements, got %d %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		int len;
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */







|













3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, Tcl_Alloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */
Changes to generic/tclIORTrans.c.
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
			    ForwardedOperation op, const void *param);
static int		ForwardProc(Tcl_Event *evPtr, int mask);
static void		SrcExitProc(ClientData clientData);

#define FreeReceivedError(p) \
	do {								\
	    if ((p)->base.mustFree) {					\
		ckfree((p)->base.msgStr);				\
	    }								\
	} while (0)
#define PassReceivedErrorInterp(i,p) \
	do {								\
	    if ((i) != NULL) {						\
		Tcl_SetChannelErrorInterp((i),				\
			Tcl_NewStringObj((p)->base.msgStr, -1));	\







|







362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
			    ForwardedOperation op, const void *param);
static int		ForwardProc(Tcl_Event *evPtr, int mask);
static void		SrcExitProc(ClientData clientData);

#define FreeReceivedError(p) \
	do {								\
	    if ((p)->base.mustFree) {					\
		Tcl_Free((p)->base.msgStr);				\
	    }								\
	} while (0)
#define PassReceivedErrorInterp(i,p) \
	do {								\
	    if ((i) != NULL) {						\
		Tcl_SetChannelErrorInterp((i),				\
			Tcl_NewStringObj((p)->base.msgStr, -1));	\
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350

    /*
     * Fail if the parent channel is not seekable.
     */

    if (seekProc == NULL) {
	Tcl_SetErrno(EINVAL);
	return Tcl_LongAsWide(-1);
    }

    /*
     * Check if we can leave out involving the Tcl level, i.e. transformation
     * handler. This is true for tell requests, and transformations which
     * support neither flush, nor drain. For these cases we can pass the
     * request down and the result back up unchanged.







|







1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350

    /*
     * Fail if the parent channel is not seekable.
     */

    if (seekProc == NULL) {
	Tcl_SetErrno(EINVAL);
	return -1;
    }

    /*
     * Check if we can leave out involving the Tcl level, i.e. transformation
     * handler. This is true for tell requests, and transformations which
     * support neither flush, nor drain. For these cases we can pass the
     * request down and the result back up unchanged.
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
     * non-NULL...
     */

    if (HaveVersion(parent->typePtr, TCL_CHANNEL_VERSION_3) &&
	parent->typePtr->wideSeekProc != NULL) {
	curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
		seekMode, errorCodePtr);
    } else if (offset < Tcl_LongAsWide(LONG_MIN) ||
	    offset > Tcl_LongAsWide(LONG_MAX)) {
	*errorCodePtr = EOVERFLOW;
	curPos = Tcl_LongAsWide(-1);
    } else {
	curPos = Tcl_LongAsWide(parent->typePtr->seekProc(
		parent->instanceData, Tcl_WideAsLong(offset), seekMode,
		errorCodePtr));
    }
    if (curPos == Tcl_LongAsWide(-1)) {
	Tcl_SetErrno(*errorCodePtr);
    }

    *errorCodePtr = EOK;
    Tcl_Release(rtPtr);
    return curPos;
}







|
<

|

|
|
|

|







1386
1387
1388
1389
1390
1391
1392
1393

1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
     * non-NULL...
     */

    if (HaveVersion(parent->typePtr, TCL_CHANNEL_VERSION_3) &&
	parent->typePtr->wideSeekProc != NULL) {
	curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
		seekMode, errorCodePtr);
    } else if (offset < LONG_MIN || offset > LONG_MAX) {

	*errorCodePtr = EOVERFLOW;
	curPos = -1;
    } else {
	curPos = parent->typePtr->seekProc(
		parent->instanceData, offset, seekMode,
		errorCodePtr);
    }
    if (curPos == -1) {
	Tcl_SetErrno(*errorCodePtr);
    }

    *errorCodePtr = EOK;
    Tcl_Release(rtPtr);
    return curPos;
}
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
    /*
     * This function can be invoked from a transformation which is based on
     * standard seeking, i.e. non-wide. Because of this we have to implement
     * it, a dummy is not enough. We simply delegate the call to the wide
     * routine.
     */

    return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
	    errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectWatch --







|







1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
    /*
     * This function can be invoked from a transformation which is based on
     * standard seeking, i.e. non-wide. Because of this we have to implement
     * it, a dummy is not enough. We simply delegate the call to the wide
     * routine.
     */

    return ReflectSeekWide(clientData, offset, seekMode,
	    errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectWatch --
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
    Tcl_Channel parentChan)
{
    ReflectedTransform *rtPtr;
    int listc;
    Tcl_Obj **listv;
    int i;

    rtPtr = ckalloc(sizeof(ReflectedTransform));

    /* rtPtr->chan: Assigned by caller. Dummy data here. */
    /* rtPtr->methods: Assigned by caller. Dummy data here. */

    rtPtr->chan = NULL;
    rtPtr->methods = 0;
#if TCL_THREADS







|







1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
    Tcl_Channel parentChan)
{
    ReflectedTransform *rtPtr;
    int listc;
    Tcl_Obj **listv;
    int i;

    rtPtr = Tcl_Alloc(sizeof(ReflectedTransform));

    /* rtPtr->chan: Assigned by caller. Dummy data here. */
    /* rtPtr->methods: Assigned by caller. Dummy data here. */

    rtPtr->chan = NULL;
    rtPtr->methods = 0;
#if TCL_THREADS
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
     *
     * listv [0] [listc-1] | [listc]  [listc+1] |
     * argv  [0]   ... [.] | [argc-2] [argc-1]  | [argc]  [argc+2]
     *       cmd   ... pfx | method   chan      | detail1 detail2
     */

    rtPtr->argc = listc + 2;
    rtPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4));

    /*
     * Duplicate object references.
     */

    for (i=0; i<listc ; i++) {
	Tcl_Obj *word = rtPtr->argv[i] = listv[i];







|







1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
     *
     * listv [0] [listc-1] | [listc]  [listc+1] |
     * argv  [0]   ... [.] | [argc-2] [argc-1]  | [argc]  [argc+2]
     *       cmd   ... pfx | method   chan      | detail1 detail2
     */

    rtPtr->argc = listc + 2;
    rtPtr->argv = Tcl_Alloc(sizeof(Tcl_Obj *) * (listc+4));

    /*
     * Duplicate object references.
     */

    for (i=0; i<listc ; i++) {
	Tcl_Obj *word = rtPtr->argv[i] = listv[i];
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
    ReflectedTransform *rtPtr)
{
    TimerKill(rtPtr);
    ResultClear(&rtPtr->result);

    FreeReflectedTransformArgs(rtPtr);

    ckfree(rtPtr->argv);
    ckfree(rtPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *







|
|







1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
    ReflectedTransform *rtPtr)
{
    TimerKill(rtPtr);
    ResultClear(&rtPtr->result);

    FreeReflectedTransformArgs(rtPtr);

    Tcl_Free(rtPtr->argv);
    Tcl_Free(rtPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
static ReflectedTransformMap *
GetReflectedTransformMap(
    Tcl_Interp *interp)
{
    ReflectedTransformMap *rtmPtr = Tcl_GetAssocData(interp, RTMKEY, NULL);

    if (rtmPtr == NULL) {
	rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
	Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, RTMKEY,
		(Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
    }
    return rtmPtr;
}








|







2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
static ReflectedTransformMap *
GetReflectedTransformMap(
    Tcl_Interp *interp)
{
    ReflectedTransformMap *rtmPtr = Tcl_GetAssocData(interp, RTMKEY, NULL);

    if (rtmPtr == NULL) {
	rtmPtr = Tcl_Alloc(sizeof(ReflectedTransformMap));
	Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, RTMKEY,
		(Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
    }
    return rtmPtr;
}

2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
	rtPtr = Tcl_GetHashValue(hPtr);

	rtPtr->dead = 1;
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rtmPtr->map);
    ckfree(&rtmPtr->map);

#if TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*







|







2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
	rtPtr = Tcl_GetHashValue(hPtr);

	rtPtr->dead = 1;
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rtmPtr->map);
    Tcl_Free(&rtmPtr->map);

#if TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288

static ReflectedTransformMap *
GetThreadReflectedTransformMap(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->rtmPtr) {
	tsdPtr->rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
	Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
	Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
    }

    return tsdPtr->rtmPtr;
}








|







2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287

static ReflectedTransformMap *
GetThreadReflectedTransformMap(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->rtmPtr) {
	tsdPtr->rtmPtr = Tcl_Alloc(sizeof(ReflectedTransformMap));
	Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
	Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
    }

    return tsdPtr->rtmPtr;
}

2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
	ReflectedTransform *rtPtr = Tcl_GetHashValue(hPtr);

	rtPtr->dead = 1;
	FreeReflectedTransformArgs(rtPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    ckfree(rtmPtr);

    /*
     * Go through the list of pending results and cancel all whose events were
     * destined for this thread. While this is in progress we block any
     * other access to the list of pending results.
     */








|







2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
	ReflectedTransform *rtPtr = Tcl_GetHashValue(hPtr);

	rtPtr->dead = 1;
	FreeReflectedTransformArgs(rtPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_Free(rtmPtr);

    /*
     * Go through the list of pending results and cancel all whose events were
     * destined for this thread. While this is in progress we block any
     * other access to the list of pending results.
     */

2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
	return;
    }

    /*
     * Create and initialize the event and data structures.
     */

    evPtr = ckalloc(sizeof(ForwardingEvent));
    resultPtr = ckalloc(sizeof(ForwardingResult));

    evPtr->event.proc = ForwardProc;
    evPtr->resultPtr = resultPtr;
    evPtr->op = op;
    evPtr->rtPtr = rtPtr;
    evPtr->param = (ForwardParam *) param;








|
|







2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
	return;
    }

    /*
     * Create and initialize the event and data structures.
     */

    evPtr = Tcl_Alloc(sizeof(ForwardingEvent));
    resultPtr = Tcl_Alloc(sizeof(ForwardingResult));

    evPtr->event.proc = ForwardProc;
    evPtr->resultPtr = resultPtr;
    evPtr->op = op;
    evPtr->rtPtr = rtPtr;
    evPtr->param = (ForwardParam *) param;

2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
     *
     * Note: The event structure has already been deleted by the destination
     * notifier, after it serviced the event.
     */

    Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);

    ckfree(resultPtr);
}

static int
ForwardProc(
    Tcl_Event *evGPtr,
    int mask)
{







|







2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
     *
     * Note: The event structure has already been deleted by the destination
     * notifier, after it serviced the event.
     */

    Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);

    Tcl_Free(resultPtr);
}

static int
ForwardProc(
    Tcl_Event *evGPtr,
    int mask)
{
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
	    paramPtr->transform.size = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    int bytec;		/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);







|



|




|







2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
	    paramPtr->transform.size = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    size_t bytec;		/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
	    paramPtr->transform.size = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    int bytec;		/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);
	break;
    }

    case ForwardedDrain:
	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->transform.size = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    int bytec;		/* Number of returned bytes */
	    unsigned char *bytev; /* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

    case ForwardedFlush:
	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->transform.size = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    int bytec;		/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;








|



|




|




















|


|




|

















|



|




|







2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
	    paramPtr->transform.size = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    size_t bytec;		/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);
	break;
    }

    case ForwardedDrain:
	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->transform.size = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    size_t bytec;		/* Number of returned bytes */
	    unsigned char *bytev; /* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

    case ForwardedFlush:
	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->transform.size = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    size_t bytec;		/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *







|







2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, Tcl_Alloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
{
    rPtr->used = 0;

    if (!rPtr->allocated) {
	return;
    }

    ckfree(rPtr->buf);
    rPtr->buf = NULL;
    rPtr->allocated = 0;
}

/*
 *----------------------------------------------------------------------
 *







|







2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
{
    rPtr->used = 0;

    if (!rPtr->allocated) {
	return;
    }

    Tcl_Free(rPtr->buf);
    rPtr->buf = NULL;
    rPtr->allocated = 0;
}

/*
 *----------------------------------------------------------------------
 *
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
	/*
	 * Extension of the internal buffer is required.
	 * NOTE: Currently linear. Should be doubling to amortize.
	 */

	if (rPtr->allocated == 0) {
	    rPtr->allocated = toWrite + RB_INCREMENT;
	    rPtr->buf = UCHARP(ckalloc(rPtr->allocated));
	} else {
	    rPtr->allocated += toWrite + RB_INCREMENT;
	    rPtr->buf = UCHARP(ckrealloc((char *) rPtr->buf,
		    rPtr->allocated));
	}
    }

    /*
     * Now copy data.
     */







|


|







2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
	/*
	 * Extension of the internal buffer is required.
	 * NOTE: Currently linear. Should be doubling to amortize.
	 */

	if (rPtr->allocated == 0) {
	    rPtr->allocated = toWrite + RB_INCREMENT;
	    rPtr->buf = UCHARP(Tcl_Alloc(rPtr->allocated));
	} else {
	    rPtr->allocated += toWrite + RB_INCREMENT;
	    rPtr->buf = UCHARP(Tcl_Realloc((char *) rPtr->buf,
		    rPtr->allocated));
	}
    }

    /*
     * Now copy data.
     */
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
static int
TransformRead(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    Tcl_Obj *bufObj)
{
    Tcl_Obj *resObj;
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj,
		&(p.transform.size));

	ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
	ckfree(p.transform.buf);
	return 1;
    }
#endif /* TCL_THREADS */

    /* ASSERT: rtPtr->method & FLAG(METH_READ) */
    /* ASSERT: rtPtr->mode & TCL_READABLE */

    if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
	Tcl_SetChannelError(rtPtr->chan, resObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	*errorCodePtr = EINVAL;
	return 0;
    }

    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
    ResultAdd(&rtPtr->result, bytev, bytec);

    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    return 1;
}

static int
TransformWrite(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    unsigned char *buf,
    int toWrite)
{
    Tcl_Obj *bufObj;
    Tcl_Obj *resObj;
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */








|










|












|














|















|







3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
static int
TransformRead(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    Tcl_Obj *bufObj)
{
    Tcl_Obj *resObj;
    size_t bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.transform.buf = (char *) TclGetByteArrayFromObj(bufObj,
		&(p.transform.size));

	ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
	Tcl_Free(p.transform.buf);
	return 1;
    }
#endif /* TCL_THREADS */

    /* ASSERT: rtPtr->method & FLAG(METH_READ) */
    /* ASSERT: rtPtr->mode & TCL_READABLE */

    if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
	Tcl_SetChannelError(rtPtr->chan, resObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	*errorCodePtr = EINVAL;
	return 0;
    }

    bytev = TclGetByteArrayFromObj(resObj, &bytec);
    ResultAdd(&rtPtr->result, bytev, bytec);

    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    return 1;
}

static int
TransformWrite(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    unsigned char *buf,
    int toWrite)
{
    Tcl_Obj *bufObj;
    Tcl_Obj *resObj;
    size_t bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
		p.transform.size);
	ckfree(p.transform.buf);
    } else
#endif /* TCL_THREADS */
    {
	/* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
	/* ASSERT: rtPtr->mode & TCL_WRITABLE */

	bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
	Tcl_IncrRefCount(bufObj);
	if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
	    *errorCodePtr = EINVAL;
	    Tcl_SetChannelError(rtPtr->chan, resObj);

	    Tcl_DecrRefCount(bufObj);
	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	    return 0;
	}

	*errorCodePtr = EOK;

	bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
	res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);

	Tcl_DecrRefCount(bufObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }

    if (res < 0) {
	*errorCodePtr = Tcl_GetErrno();
	return 0;
    }

    return 1;
}

static int
TransformDrain(
    ReflectedTransform *rtPtr,
    int *errorCodePtr)
{
    Tcl_Obj *resObj;
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
	ckfree(p.transform.buf);
    } else
#endif /* TCL_THREADS */
    {
	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
	    Tcl_SetChannelError(rtPtr->chan, resObj);
	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
	ResultAdd(&rtPtr->result, bytev, bytec);

	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }

    rtPtr->readIsDrained = 1;
    return 1;
}

static int
TransformFlush(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    int op)
{
    Tcl_Obj *resObj;
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */








|



















|




















|




















|










|
















|







3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
		p.transform.size);
	Tcl_Free(p.transform.buf);
    } else
#endif /* TCL_THREADS */
    {
	/* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
	/* ASSERT: rtPtr->mode & TCL_WRITABLE */

	bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
	Tcl_IncrRefCount(bufObj);
	if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
	    *errorCodePtr = EINVAL;
	    Tcl_SetChannelError(rtPtr->chan, resObj);

	    Tcl_DecrRefCount(bufObj);
	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	    return 0;
	}

	*errorCodePtr = EOK;

	bytev = TclGetByteArrayFromObj(resObj, &bytec);
	res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);

	Tcl_DecrRefCount(bufObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }

    if (res < 0) {
	*errorCodePtr = Tcl_GetErrno();
	return 0;
    }

    return 1;
}

static int
TransformDrain(
    ReflectedTransform *rtPtr,
    int *errorCodePtr)
{
    Tcl_Obj *resObj;
    size_t bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
	Tcl_Free(p.transform.buf);
    } else
#endif /* TCL_THREADS */
    {
	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
	    Tcl_SetChannelError(rtPtr->chan, resObj);
	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	bytev = TclGetByteArrayFromObj(resObj, &bytec);
	ResultAdd(&rtPtr->result, bytev, bytec);

	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }

    rtPtr->readIsDrained = 1;
    return 1;
}

static int
TransformFlush(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    int op)
{
    Tcl_Obj *resObj;
    size_t bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
	*errorCodePtr = EOK;
	if (op == FLUSH_WRITE) {
	    res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
		    p.transform.size);
	} else {
	    res = 0;
	}
	ckfree(p.transform.buf);
    } else
#endif /* TCL_THREADS */
    {
	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
	    Tcl_SetChannelError(rtPtr->chan, resObj);
	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	if (op == FLUSH_WRITE) {
	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
	    res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);
	} else {
	    res = 0;
	}
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }








|











|







3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
	*errorCodePtr = EOK;
	if (op == FLUSH_WRITE) {
	    res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
		    p.transform.size);
	} else {
	    res = 0;
	}
	Tcl_Free(p.transform.buf);
    } else
#endif /* TCL_THREADS */
    {
	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
	    Tcl_SetChannelError(rtPtr->chan, resObj);
	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	if (op == FLUSH_WRITE) {
	    bytev = TclGetByteArrayFromObj(resObj, &bytec);
	    res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);
	} else {
	    res = 0;
	}
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }

Changes to generic/tclIOUtil.c.
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
    ret = Tcl_FSStat(pathPtr, &buf);
    Tcl_DecrRefCount(pathPtr);
    if (ret != -1) {
#ifndef TCL_WIDE_INT_IS_LONG
	Tcl_WideInt tmp1, tmp2, tmp3 = 0;

# define OUT_OF_RANGE(x) \
	(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
	 ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
# define OUT_OF_URANGE(x) \
	(((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))

	/*
	 * Perform the result-buffer overflow check manually.
	 *
	 * Note that ino_t/ino64_t is unsigned...







|
|







271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
    ret = Tcl_FSStat(pathPtr, &buf);
    Tcl_DecrRefCount(pathPtr);
    if (ret != -1) {
#ifndef TCL_WIDE_INT_IS_LONG
	Tcl_WideInt tmp1, tmp2, tmp3 = 0;

# define OUT_OF_RANGE(x) \
	(((Tcl_WideInt)(x)) < LONG_MIN || \
	 ((Tcl_WideInt)(x)) > LONG_MAX)
# define OUT_OF_URANGE(x) \
	(((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))

	/*
	 * Perform the result-buffer overflow check manually.
	 *
	 * Note that ino_t/ino64_t is unsigned...
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
     * Trash the filesystems cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr->nextPtr;
	fsRecPtr->fsPtr = NULL;
	ckfree(fsRecPtr);
	fsRecPtr = tmpFsRecPtr;
    }
    tsdPtr->filesystemList = NULL;
    tsdPtr->initialized = 0;
}

int







|







453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
     * Trash the filesystems cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr->nextPtr;
	fsRecPtr->fsPtr = NULL;
	Tcl_Free(fsRecPtr);
	fsRecPtr = tmpFsRecPtr;
    }
    tsdPtr->filesystemList = NULL;
    tsdPtr->initialized = 0;
}

int
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
    /*
     * Refill the cache honouring the order.
     */

    list = NULL;
    fsRecPtr = tmpFsRecPtr;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = ckalloc(sizeof(FilesystemRecord));
	*tmpFsRecPtr = *fsRecPtr;
	tmpFsRecPtr->nextPtr = list;
	tmpFsRecPtr->prevPtr = NULL;
	list = tmpFsRecPtr;
	fsRecPtr = fsRecPtr->prevPtr;
    }
    tsdPtr->filesystemList = list;
    tsdPtr->filesystemEpoch = theFilesystemEpoch;
    Tcl_MutexUnlock(&filesystemMutex);

    while (toFree) {
	FilesystemRecord *next = toFree->nextPtr;

	toFree->fsPtr = NULL;
	ckfree(toFree);
	toFree = next;
    }

    /*
     * Make sure the above gets released on thread exit.
     */








|














|







592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
    /*
     * Refill the cache honouring the order.
     */

    list = NULL;
    fsRecPtr = tmpFsRecPtr;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = Tcl_Alloc(sizeof(FilesystemRecord));
	*tmpFsRecPtr = *fsRecPtr;
	tmpFsRecPtr->nextPtr = list;
	tmpFsRecPtr->prevPtr = NULL;
	list = tmpFsRecPtr;
	fsRecPtr = fsRecPtr->prevPtr;
    }
    tsdPtr->filesystemList = list;
    tsdPtr->filesystemEpoch = theFilesystemEpoch;
    Tcl_MutexUnlock(&filesystemMutex);

    while (toFree) {
	FilesystemRecord *next = toFree->nextPtr;

	toFree->fsPtr = NULL;
	Tcl_Free(toFree);
	toFree = next;
    }

    /*
     * Make sure the above gets released on thread exit.
     */

677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
 */

static void
FsUpdateCwd(
    Tcl_Obj *cwdObj,
    ClientData clientData)
{
    int len;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = TclGetStringFromObj(cwdObj, &len);
    }








|







677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
 */

static void
FsUpdateCwd(
    Tcl_Obj *cwdObj,
    ClientData clientData)
{
    int len = 0;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = TclGetStringFromObj(cwdObj, &len);
    }

783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
	FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;

	/*
	 * The native filesystem is static, so we don't free it.
	 */

	if (fsRecPtr != &nativeFilesystemRecord) {
	    ckfree(fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }
    if (++theFilesystemEpoch == 0) {
	++theFilesystemEpoch;
    }
    filesystemList = NULL;







|







783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
	FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;

	/*
	 * The native filesystem is static, so we don't free it.
	 */

	if (fsRecPtr != &nativeFilesystemRecord) {
	    Tcl_Free(fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }
    if (++theFilesystemEpoch == 0) {
	++theFilesystemEpoch;
    }
    filesystemList = NULL;
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
{
    FilesystemRecord *newFilesystemPtr;

    if (fsPtr == NULL) {
	return TCL_ERROR;
    }

    newFilesystemPtr = ckalloc(sizeof(FilesystemRecord));

    newFilesystemPtr->clientData = clientData;
    newFilesystemPtr->fsPtr = fsPtr;

    /*
     * Is this lock and wait strictly speaking necessary? Since any iterators
     * out there will have grabbed a copy of the head of the list and be







|







868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
{
    FilesystemRecord *newFilesystemPtr;

    if (fsPtr == NULL) {
	return TCL_ERROR;
    }

    newFilesystemPtr = Tcl_Alloc(sizeof(FilesystemRecord));

    newFilesystemPtr->clientData = clientData;
    newFilesystemPtr->fsPtr = fsPtr;

    /*
     * Is this lock and wait strictly speaking necessary? Since any iterators
     * out there will have grabbed a copy of the head of the list and be
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
	     * (which would of course lead to memory exceptions).
	     */

	    if (++theFilesystemEpoch == 0) {
		++theFilesystemEpoch;
	    }

	    ckfree(fsRecPtr);

	    retVal = TCL_OK;
	} else {
	    fsRecPtr = fsRecPtr->nextPtr;
	}
    }








|







971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
	     * (which would of course lead to memory exceptions).
	     */

	    if (++theFilesystemEpoch == 0) {
		++theFilesystemEpoch;
	    }

	    Tcl_Free(fsRecPtr);

	    retVal = TCL_OK;
	} else {
	    fsRecPtr = fsRecPtr->nextPtr;
	}
    }

1386
1387
1388
1389
1390
1391
1392




1393
1394
1395
1396





1397

1398

1399













1400
1401
1402









1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417

1418
1419
1420
1421
1422
1423
1424
TclFSNormalizeToUniquePath(
    Tcl_Interp *interp,		/* Used for error messages. */
    Tcl_Obj *pathPtr,		/* The path to normalize in place. */
    int startAt)		/* Start at this char-offset. */
{
    FilesystemRecord *fsRecPtr, *firstFsRecPtr;





    /*
     * Call each of the "normalise path" functions in succession. This is a
     * special case, in which if we have a native filesystem handler, we call
     * it first. This is because the root of Tcl's filesystem is always a





     * native filesystem (i.e., '/' on unix is native).

     */















    firstFsRecPtr = FsGetFirstFilesystem();

    Claim();









    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
	    continue;
	}

	/*
	 * TODO: Assume that we always find the native file system; it should
	 * always be there...
	 */

	if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
	    startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
		    startAt);
	}
	break;

    }

    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
	/*
	 * Skip the native system next time through.
	 */








>
>
>
>

<
<
<
>
>
>
>
>
|
>

>

>
>
>
>
>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
|
|
|
|

|
|
|
|

|
|
|
|
|
>







1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397



1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
TclFSNormalizeToUniquePath(
    Tcl_Interp *interp,		/* Used for error messages. */
    Tcl_Obj *pathPtr,		/* The path to normalize in place. */
    int startAt)		/* Start at this char-offset. */
{
    FilesystemRecord *fsRecPtr, *firstFsRecPtr;

    int i;
    int isVfsPath = 0;
    char *path;

    /*



     * Paths starting with a UNC prefix whose final character is a colon
     * are reserved for VFS use.  These names can not conflict with real
     * UNC paths per https://msdn.microsoft.com/en-us/library/gg465305.aspx
     * and rfc3986's definition of reg-name.
     *
     * We check these first to avoid useless calls to the native filesystem's
     * normalizePathProc.
     */
    path = Tcl_GetStringFromObj(pathPtr, &i);

    if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/')
		    || (path[0] == '\\' && path[1] == '\\') ) ) {
	for ( i = 2; ; i++) {
	    if (path[i] == '\0') break;
	    if (path[i] == path[0]) break;
	}
	--i;
	if (path[i] == ':') isVfsPath = 1;
    }

    /*
     * Call each of the "normalise path" functions in succession.
     */
    firstFsRecPtr = FsGetFirstFilesystem();

    Claim();

    if (!isVfsPath) {

	/*
	 * If we have a native filesystem handler, we call it first.  This is
	 * because the root of Tcl's filesystem is always a native filesystem
	 * (i.e., '/' on unix is native).
	 */

	for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
	    if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
		continue;
	    }

	    /*
	     * TODO: Assume that we always find the native file system; it should
	     * always be there...
	     */

	    if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
		startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
			startAt);
	    }
	    break;
	}
    }

    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
	/*
	 * Skip the native system next time through.
	 */

1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
	    mode |= O_NOCTTY;
#else
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"access mode \"%s\" not supported by this system",
			flag));
	    }
	    ckfree(modeArgv);
	    return -1;
#endif

	} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
#ifdef O_NONBLOCK
	    mode |= O_NONBLOCK;
#else
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"access mode \"%s\" not supported by this system",
			flag));
	    }
	    ckfree(modeArgv);
	    return -1;
#endif

	} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
	    mode |= O_TRUNC;
	} else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) {
	    *binaryPtr = 1;
	} else {

	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"invalid access mode \"%s\": must be RDONLY, WRONLY, "
			"RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK,"
			" or TRUNC", flag));
	    }
	    ckfree(modeArgv);
	    return -1;
	}
    }

    ckfree(modeArgv);

    if (!gotRW) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "access mode must include either RDONLY, WRONLY, or RDWR",
		    -1));
	}







|












|















|




|







1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
	    mode |= O_NOCTTY;
#else
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"access mode \"%s\" not supported by this system",
			flag));
	    }
	    Tcl_Free(modeArgv);
	    return -1;
#endif

	} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
#ifdef O_NONBLOCK
	    mode |= O_NONBLOCK;
#else
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"access mode \"%s\" not supported by this system",
			flag));
	    }
	    Tcl_Free(modeArgv);
	    return -1;
#endif

	} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
	    mode |= O_TRUNC;
	} else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) {
	    *binaryPtr = 1;
	} else {

	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"invalid access mode \"%s\": must be RDONLY, WRONLY, "
			"RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK,"
			" or TRUNC", flag));
	    }
	    Tcl_Free(modeArgv);
	    return -1;
	}
    }

    Tcl_Free(modeArgv);

    if (!gotRW) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "access mode must include either RDONLY, WRONLY, or RDWR",
		    -1));
	}
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
    Tcl_IncrRefCount(objPtr);

    /*
     * Try to read first character of stream, so we can check for utf-8 BOM to
     * be handled especially.
     */

    if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	goto end;
    }
    string = Tcl_GetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters,
     * otherwise replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	goto end;
    }








|














|







1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
    Tcl_IncrRefCount(objPtr);

    /*
     * Try to read first character of stream, so we can check for utf-8 BOM to
     * be handled especially.
     */

    if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	goto end;
    }
    string = Tcl_GetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters,
     * otherwise replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	goto end;
    }

1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
    Tcl_IncrRefCount(objPtr);

    /*
     * Try to read first character of stream, so we can check for utf-8 BOM to
     * be handled especially.
     */

    if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }
    string = Tcl_GetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters,
     * otherwise replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }







|















|







1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
    Tcl_IncrRefCount(objPtr);

    /*
     * Try to read first character of stream, so we can check for utf-8 BOM to
     * be handled especially.
     */

    if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }
    string = Tcl_GetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters,
     * otherwise replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
    }

    /*
     * When we unload this file, we need to divert the unloading so we can
     * unload and cleanup the temporary file correctly.
     */

    tvdlPtr = ckalloc(sizeof(FsDivertLoad));

    /*
     * Remember three pieces of information. This allows us to cleanup the
     * diverted load completely, on platforms which allow proper unloading of
     * code.
     */








|







3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
    }

    /*
     * When we unload this file, we need to divert the unloading so we can
     * unload and cleanup the temporary file correctly.
     */

    tvdlPtr = Tcl_Alloc(sizeof(FsDivertLoad));

    /*
     * Remember three pieces of information. This allows us to cleanup the
     * diverted load completely, on platforms which allow proper unloading of
     * code.
     */

3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
	tvdlPtr->divertedFile = NULL;
	tvdlPtr->divertedFilesystem = NULL;
	Tcl_DecrRefCount(copyToPtr);
    }

    copyToPtr = NULL;

    divertedLoadHandle = ckalloc(sizeof(struct Tcl_LoadHandle_));
    divertedLoadHandle->clientData = tvdlPtr;
    divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
    divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
    *handlePtr = divertedLoadHandle;

    if (interp) {
	Tcl_ResetResult(interp);







|







3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
	tvdlPtr->divertedFile = NULL;
	tvdlPtr->divertedFilesystem = NULL;
	Tcl_DecrRefCount(copyToPtr);
    }

    copyToPtr = NULL;

    divertedLoadHandle = Tcl_Alloc(sizeof(struct Tcl_LoadHandle_));
    divertedLoadHandle->clientData = tvdlPtr;
    divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
    divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
    *handlePtr = divertedLoadHandle;

    if (interp) {
	Tcl_ResetResult(interp);
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
	 * refCount from the Tcl_Filesystem to which this file belongs, which
	 * could then free up the filesystem if we are exiting.
	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    ckfree(tvdlPtr);
    ckfree(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindSymbol --
 *







|
|







3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
	 * refCount from the Tcl_Filesystem to which this file belongs, which
	 * could then free up the filesystem if we are exiting.
	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    Tcl_Free(tvdlPtr);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindSymbol --
 *
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
	 * refCount from the Tcl_Filesystem to which this file belongs, which
	 * could then free up the filesystem if we are exiting.
	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    ckfree(tvdlPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSLink --
 *







|







3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
	 * refCount from the Tcl_Filesystem to which this file belongs, which
	 * could then free up the filesystem if we are exiting.
	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    Tcl_Free(tvdlPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSLink --
 *
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
 *---------------------------------------------------------------------------
 */

static void
NativeFreeInternalRep(
    ClientData clientData)
{
    ckfree(clientData);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSFileSystemInfo --
 *







|







4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
 *---------------------------------------------------------------------------
 */

static void
NativeFreeInternalRep(
    ClientData clientData)
{
    Tcl_Free(clientData);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSFileSystemInfo --
 *
Changes to generic/tclIndexObj.c.
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
 * pointer to one of these structures.
 *
 * Keep this structure declaration in sync with tclTestObj.c
 */

typedef struct {
    void *tablePtr;		/* Pointer to the table of strings */
    int offset;			/* Offset between table entries */
    int index;			/* Selected index into table. */
} IndexRep;

/*
 * The following macros greatly simplify moving through a table...
 */

#define STRING_AT(table, offset) \







|
|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
 * pointer to one of these structures.
 *
 * Keep this structure declaration in sync with tclTestObj.c
 */

typedef struct {
    void *tablePtr;		/* Pointer to the table of strings */
    size_t offset;			/* Offset between table entries */
    size_t index;			/* Selected index into table. */
} IndexRep;

/*
 * The following macros greatly simplify moving through a table...
 */

#define STRING_AT(table, offset) \
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
	return result;
    }

    /*
     * Build a string table from the list.
     */

    tablePtr = ckalloc((objc + 1) * sizeof(char *));
    for (t = 0; t < objc; t++) {
	if (objv[t] == objPtr) {
	    /*
	     * An exact match is always chosen, so we can stop here.
	     */

	    ckfree(tablePtr);
	    *indexPtr = t;
	    return TCL_OK;
	}

	tablePtr[t] = Tcl_GetString(objv[t]);
    }
    tablePtr[objc] = NULL;

    result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
	    sizeof(char *), msg, flags | INDEX_TEMP_TABLE, indexPtr);

    ckfree(tablePtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *







|






|











|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
	return result;
    }

    /*
     * Build a string table from the list.
     */

    tablePtr = Tcl_Alloc((objc + 1) * sizeof(char *));
    for (t = 0; t < objc; t++) {
	if (objv[t] == objPtr) {
	    /*
	     * An exact match is always chosen, so we can stop here.
	     */

	    Tcl_Free(tablePtr);
	    *indexPtr = t;
	    return TCL_OK;
	}

	tablePtr[t] = Tcl_GetString(objv[t]);
    }
    tablePtr[objc] = NULL;

    result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
	    sizeof(char *), msg, flags | INDEX_TEMP_TABLE, indexPtr);

    Tcl_Free(tablePtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
    const void *tablePtr,	/* The first string in the table. The second
				 * string will be at this address plus the
				 * offset, the third plus the offset again,
				 * etc. The last entry must be NULL and there
				 * must not be duplicate entries. */
    int offset,			/* The number of bytes between entries */
    const char *msg,		/* Identifying word to use in error
				 * messages. */
    int flags,			/* 0 or TCL_EXACT */
    int *indexPtr)		/* Place to store resulting integer index. */
{
    int index, idx, numAbbrev;
    const char *key, *p1;
    const char *p2;
    const char *const *entryPtr;
    Tcl_Obj *resultPtr;
    IndexRep *indexRep;

    /* Protect against invalid values, like -1 or 0. */
    if (offset < (int)sizeof(char *)) {
	offset = (int)sizeof(char *);
    }
    /*
     * See if there is a valid cached result from a previous lookup.
     */

    if (!(flags & INDEX_TEMP_TABLE) && objPtr->typePtr == &indexType) {
	indexRep = objPtr->internalRep.twoPtrValue.ptr1;







|













|
|







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
    const void *tablePtr,	/* The first string in the table. The second
				 * string will be at this address plus the
				 * offset, the third plus the offset again,
				 * etc. The last entry must be NULL and there
				 * must not be duplicate entries. */
    size_t offset,			/* The number of bytes between entries */
    const char *msg,		/* Identifying word to use in error
				 * messages. */
    int flags,			/* 0 or TCL_EXACT */
    int *indexPtr)		/* Place to store resulting integer index. */
{
    int index, idx, numAbbrev;
    const char *key, *p1;
    const char *p2;
    const char *const *entryPtr;
    Tcl_Obj *resultPtr;
    IndexRep *indexRep;

    /* Protect against invalid values, like -1 or 0. */
    if (offset+1 <= sizeof(char *)) {
	offset = sizeof(char *);
    }
    /*
     * See if there is a valid cached result from a previous lookup.
     */

    if (!(flags & INDEX_TEMP_TABLE) && objPtr->typePtr == &indexType) {
	indexRep = objPtr->internalRep.twoPtrValue.ptr1;
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
     */

    if (!(flags & INDEX_TEMP_TABLE)) {
	if (objPtr->typePtr == &indexType) {
	    indexRep = objPtr->internalRep.twoPtrValue.ptr1;
	} else {
	    TclFreeIntRep(objPtr);
	    indexRep = ckalloc(sizeof(IndexRep));
	    objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
	    objPtr->typePtr = &indexType;
	}
	indexRep->tablePtr = (void *) tablePtr;
	indexRep->offset = offset;
	indexRep->index = index;
    }







|







273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
     */

    if (!(flags & INDEX_TEMP_TABLE)) {
	if (objPtr->typePtr == &indexType) {
	    indexRep = objPtr->internalRep.twoPtrValue.ptr1;
	} else {
	    TclFreeIntRep(objPtr);
	    indexRep = Tcl_Alloc(sizeof(IndexRep));
	    objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
	    objPtr->typePtr = &indexType;
	}
	indexRep->tablePtr = (void *) tablePtr;
	indexRep->offset = offset;
	indexRep->index = index;
    }
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
{
    IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
    register char *buf;
    register unsigned len;
    register const char *indexStr = EXPAND_OF(indexRep);

    len = strlen(indexStr);
    buf = ckalloc(len + 1);
    memcpy(buf, indexStr, len+1);
    objPtr->bytes = buf;
    objPtr->length = len;
}

/*
 *----------------------------------------------------------------------







|







384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
{
    IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
    register char *buf;
    register unsigned len;
    register const char *indexStr = EXPAND_OF(indexRep);

    len = strlen(indexStr);
    buf = Tcl_Alloc(len + 1);
    memcpy(buf, indexStr, len+1);
    objPtr->bytes = buf;
    objPtr->length = len;
}

/*
 *----------------------------------------------------------------------
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428

static void
DupIndex(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1;
    IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep));

    memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
    dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
    dupPtr->typePtr = &indexType;
}

/*







|







414
415
416
417
418
419
420
421
422
423
424
425
426
427
428

static void
DupIndex(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1;
    IndexRep *dupIndexRep = Tcl_Alloc(sizeof(IndexRep));

    memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
    dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
    dupPtr->typePtr = &indexType;
}

/*
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
 *----------------------------------------------------------------------
 */

static void
FreeIndex(
    Tcl_Obj *objPtr)
{
    ckfree(objPtr->internalRep.twoPtrValue.ptr1);
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitPrefixCmd --







|







442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
 *----------------------------------------------------------------------
 */

static void
FreeIndex(
    Tcl_Obj *objPtr)
{
    Tcl_Free(objPtr->internalRep.twoPtrValue.ptr1);
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitPrefixCmd --
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
	 * Then we should copy the name of the command (0th argument). The
	 * upper bound on the number of elements is known, and (undocumented,
	 * but historically true) there should be a NULL argument after the
	 * last result. [Bug 3413857]
	 */

	nrem = 1;
	leftovers = ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
	leftovers[0] = objv[0];
    } else {
	nrem = 0;
	leftovers = NULL;
    }

    /*







|







1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
	 * Then we should copy the name of the command (0th argument). The
	 * upper bound on the number of elements is known, and (undocumented,
	 * but historically true) there should be a NULL argument after the
	 * last result. [Bug 3413857]
	 */

	nrem = 1;
	leftovers = Tcl_Alloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
	leftovers[0] = objv[0];
    } else {
	nrem = 0;
	leftovers = NULL;
    }

    /*
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243

    if (objc > 0) {
	memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *));
	nrem += objc;
    }
    leftovers[nrem] = NULL;
    *objcPtr = nrem++;
    *remObjv = ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *));
    return TCL_OK;

    /*
     * Make sure to handle freeing any temporary space we've allocated on the
     * way to an error.
     */

  missingArg:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "\"%s\" option requires an additional argument", str));
  error:
    if (leftovers != NULL) {
	ckfree(leftovers);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *







|












|







1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243

    if (objc > 0) {
	memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *));
	nrem += objc;
    }
    leftovers[nrem] = NULL;
    *objcPtr = nrem++;
    *remObjv = Tcl_Realloc(leftovers, nrem * sizeof(Tcl_Obj *));
    return TCL_OK;

    /*
     * Make sure to handle freeing any temporary space we've allocated on the
     * way to an error.
     */

  missingArg:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "\"%s\" option requires an additional argument", str));
  error:
    if (leftovers != NULL) {
	Tcl_Free(leftovers);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
Changes to generic/tclInt.decls.
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
    int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr,
	    Tcl_Channel errorChan)
}
declare 6 {
    void TclCleanupCommand(Command *cmdPtr)
}
declare 7 {
    int TclCopyAndCollapse(int count, const char *src, char *dst)
}
# Removed in 9.0:
#declare 8 {
#    int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
#	    Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
#}








|







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
    int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr,
	    Tcl_Channel errorChan)
}
declare 6 {
    void TclCleanupCommand(Command *cmdPtr)
}
declare 7 {
    size_t TclCopyAndCollapse(size_t count, const char *src, char *dst)
}
# Removed in 9.0:
#declare 8 {
#    int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
#	    Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
#}

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
}
# Removed in 8.5:
#declare 13 {
#    int TclDoGlob(Tcl_Interp *interp, char *separators,
#	    Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
#}
declare 14 {
    int TclDumpMemoryInfo(ClientData clientData, int flags)
}
# Removed in 8.1:
#  declare 15 {
#      void TclExpandParseValue(ParseValue *pvPtr, int needed)
#  }
declare 16 {
    void TclExprFloatError(Tcl_Interp *interp, double value)







|







76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
}
# Removed in 8.5:
#declare 13 {
#    int TclDoGlob(Tcl_Interp *interp, char *separators,
#	    Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
#}
declare 14 {
    int TclDumpMemoryInfo(void *clientData, int flags)
}
# Removed in 8.1:
#  declare 15 {
#      void TclExpandParseValue(ParseValue *pvPtr, int needed)
#  }
declare 16 {
    void TclExprFloatError(Tcl_Interp *interp, double value)
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
#}
#declare 21 {
#    int TclFileRenameCmd(Tcl_Interp *interp, int argc, char **argv)
#}
declare 22 {
    int TclFindElement(Tcl_Interp *interp, const char *listStr,
	    int listLength, const char **elementPtr, const char **nextPtr,
	    int *sizePtr, int *bracePtr)
}
declare 23 {
    Proc *TclFindProc(Interp *iPtr, const char *procName)
}
# Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10
declare 24 {
    int TclFormatInt(char *buffer, Tcl_WideInt n)
}
declare 25 {
    void TclFreePackageInfo(Interp *iPtr)
}
# Removed in 8.1:
#  declare 26 {
#      char *TclGetCwd(Tcl_Interp *interp)







|






|







104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
#}
#declare 21 {
#    int TclFileRenameCmd(Tcl_Interp *interp, int argc, char **argv)
#}
declare 22 {
    int TclFindElement(Tcl_Interp *interp, const char *listStr,
	    int listLength, const char **elementPtr, const char **nextPtr,
	    size_t *sizePtr, int *bracePtr)
}
declare 23 {
    Proc *TclFindProc(Interp *iPtr, const char *procName)
}
# Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10
declare 24 {
    size_t TclFormatInt(char *buffer, Tcl_WideInt n)
}
declare 25 {
    void TclFreePackageInfo(Interp *iPtr)
}
# Removed in 8.1:
#  declare 26 {
#      char *TclGetCwd(Tcl_Interp *interp)
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
}
# Removed in 8.5a2:
#declare 52 {
#    int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
#	    int flags)
#}
declare 53 {
    int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
	    int argc, const char **argv)
}
declare 54 {
    int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 55 {
    Proc *TclIsProc(Command *cmdPtr)
}
# Replaced with TclpLoadFile in 8.1:
#  declare 56 {







|



|







223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
}
# Removed in 8.5a2:
#declare 52 {
#    int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
#	    int flags)
#}
declare 53 {
    int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp,
	    int argc, const char **argv)
}
declare 54 {
    int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 55 {
    Proc *TclIsProc(Command *cmdPtr)
}
# Replaced with TclpLoadFile in 8.1:
#  declare 56 {
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
declare 61 {
    Tcl_Obj *TclNewProcBodyObj(Proc *procPtr)
}
declare 62 {
    int TclObjCommandComplete(Tcl_Obj *cmdPtr)
}
declare 63 {
    int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 64 {
    int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
	    int flags)
}
# Removed in 8.5a2:







|







263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
declare 61 {
    Tcl_Obj *TclNewProcBodyObj(Proc *procPtr)
}
declare 62 {
    int TclObjCommandComplete(Tcl_Obj *cmdPtr)
}
declare 63 {
    int TclObjInterpProc(void *clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 64 {
    int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
	    int flags)
}
# Removed in 8.5a2:
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
#    int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
#}
# Replaced by Tcl_FSAccess in 8.4:
#declare 68 {
#    int TclpAccess(const char *path, int mode)
#}
declare 69 {
    char *TclpAlloc(unsigned int size)
}
#declare 70 {
#    int TclpCopyFile(const char *source, const char *dest)
#}
#declare 71 {
#    int TclpCopyDirectory(const char *source, const char *dest,
#	    Tcl_DString *errorPtr)
#}
#declare 72 {
#    int TclpCreateDirectory(const char *path)
#}
#declare 73 {
#    int TclpDeleteFile(const char *path)
#}
declare 74 {
    void TclpFree(char *ptr)
}
declare 75 {
    unsigned long TclpGetClicks(void)
}
declare 76 {
    unsigned long TclpGetSeconds(void)
}

# Removed in 9.0:
#declare 77 {
#    void TclpGetTime(Tcl_Time *time)
#}
# Removed in 8.6:
#declare 78 {
#    int TclpGetTimeZone(unsigned long time)
#}
# Replaced by Tcl_FSListVolumes in 8.4:
#declare 79 {
#    int TclpListVolumes(Tcl_Interp *interp)
#}
# Replaced by Tcl_FSOpenFileChannel in 8.4:
#declare 80 {
#    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName,
#	    char *modeString, int permissions)
#}
declare 81 {
    char *TclpRealloc(char *ptr, unsigned int size)
}
#declare 82 {
#    int TclpRemoveDirectory(const char *path, int recursive,
#	    Tcl_DString *errorPtr)
#}
#declare 83 {
#    int TclpRenameFile(const char *source, const char *dest)







|















|


|


|




















|







286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
#    int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
#}
# Replaced by Tcl_FSAccess in 8.4:
#declare 68 {
#    int TclpAccess(const char *path, int mode)
#}
declare 69 {
    void *TclpAlloc(size_t size)
}
#declare 70 {
#    int TclpCopyFile(const char *source, const char *dest)
#}
#declare 71 {
#    int TclpCopyDirectory(const char *source, const char *dest,
#	    Tcl_DString *errorPtr)
#}
#declare 72 {
#    int TclpCreateDirectory(const char *path)
#}
#declare 73 {
#    int TclpDeleteFile(const char *path)
#}
declare 74 {
    void TclpFree(void *ptr)
}
declare 75 {
    Tcl_WideUInt TclpGetClicks(void)
}
declare 76 {
    Tcl_WideUInt TclpGetSeconds(void)
}

# Removed in 9.0:
#declare 77 {
#    void TclpGetTime(Tcl_Time *time)
#}
# Removed in 8.6:
#declare 78 {
#    int TclpGetTimeZone(unsigned long time)
#}
# Replaced by Tcl_FSListVolumes in 8.4:
#declare 79 {
#    int TclpListVolumes(Tcl_Interp *interp)
#}
# Replaced by Tcl_FSOpenFileChannel in 8.4:
#declare 80 {
#    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName,
#	    char *modeString, int permissions)
#}
declare 81 {
    void *TclpRealloc(void *ptr, size_t size)
}
#declare 82 {
#    int TclpRemoveDirectory(const char *path, int recursive,
#	    Tcl_DString *errorPtr)
#}
#declare 83 {
#    int TclpRenameFile(const char *source, const char *dest)
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
#  	    int flags, char **termPtr, ParseValue *pvPtr)
#  }
#  declare 87 {
#      void TclPlatformInit(Tcl_Interp *interp)
#  }
# Removed in 9.0:
#declare 88 {
#    char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
#	    const char *name1, const char *name2, int flags)
#}
declare 89 {
    int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
	    Tcl_Command cmd)
}
# Removed in 8.1 (only available if compiled with TCL_COMPILE_DEBUG):
#  declare 90 {
#      void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#  }
declare 91 {
    void TclProcCleanupProc(Proc *procPtr)
}
declare 92 {
    int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
	    Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description,
	    const char *procName)
}
declare 93 {
    void TclProcDeleteProc(ClientData clientData)
}
# Removed in 8.5:
#declare 94 {
#    int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
#	    int argc, const char **argv)
#}
# Replaced by Tcl_FSStat in 8.4:
#declare 95 {
#    int TclpStat(const char *path, Tcl_StatBuf *buf)
#}
declare 96 {







|



















|



|







356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
#  	    int flags, char **termPtr, ParseValue *pvPtr)
#  }
#  declare 87 {
#      void TclPlatformInit(Tcl_Interp *interp)
#  }
# Removed in 9.0:
#declare 88 {
#    char *TclPrecTraceProc(void *clientData, Tcl_Interp *interp,
#	    const char *name1, const char *name2, int flags)
#}
declare 89 {
    int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
	    Tcl_Command cmd)
}
# Removed in 8.1 (only available if compiled with TCL_COMPILE_DEBUG):
#  declare 90 {
#      void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#  }
declare 91 {
    void TclProcCleanupProc(Proc *procPtr)
}
declare 92 {
    int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
	    Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description,
	    const char *procName)
}
declare 93 {
    void TclProcDeleteProc(void *clientData)
}
# Removed in 8.5:
#declare 94 {
#    int TclProcInterpProc(void *clientData, Tcl_Interp *interp,
#	    int argc, const char **argv)
#}
# Replaced by Tcl_FSStat in 8.4:
#declare 95 {
#    int TclpStat(const char *path, Tcl_StatBuf *buf)
#}
declare 96 {
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
#declare 112 {
#    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 113 {
#    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
#	    ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
#}
# Removed in 9.0:
#declare 114 {
#    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
#}
# Removed in 9.0:
#declare 115 {







|







461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
#declare 112 {
#    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 113 {
#    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
#	    void *clientData, Tcl_NamespaceDeleteProc *deleteProc)
#}
# Removed in 9.0:
#declare 114 {
#    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
#}
# Removed in 9.0:
#declare 115 {
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
#}
declare 138 {
    const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
#declare 139 {
#    int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
#	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
#	    Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr)
#}
#declare 140 {
#    int TclLooksLikeInt(const char *bytes, int length)
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
    const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
    int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CompileHookProc *hookProc, ClientData clientData)
}
declare 143 {
    int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr,
	    LiteralEntry **litPtrPtr)
}
declare 144 {
    void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr,







|










|







567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
#}
declare 138 {
    const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
#declare 139 {
#    int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
#	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
#	    Tcl_PackageInitProc **proc2Ptr, void **clientDataPtr)
#}
#declare 140 {
#    int TclLooksLikeInt(const char *bytes, int length)
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
    const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
    int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CompileHookProc *hookProc, void *clientData)
}
declare 143 {
    int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr,
	    LiteralEntry **litPtrPtr)
}
declare 144 {
    void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr,
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640

# Added for Tcl 8.2

declare 150 {
    int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
}
declare 151 {
    void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr,
	    int *endPtr)
}
declare 152 {
    void TclSetLibraryPath(Tcl_Obj *pathPtr)
}
declare 153 {
    Tcl_Obj *TclGetLibraryPath(void)
}

# moved to tclTest.c (static) in 8.3.2/8.4a2
#declare 154 {
#    int TclTestChannelCmd(ClientData clientData,
#    Tcl_Interp *interp, int argc, char **argv)
#}
#declare 155 {
#    int TclTestChannelEventCmd(ClientData clientData,
#	     Tcl_Interp *interp, int argc, char **argv)
#}

declare 156 {
    void TclRegError(Tcl_Interp *interp, const char *msg,
	    int status)
}







|











|



|







610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640

# Added for Tcl 8.2

declare 150 {
    int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
}
declare 151 {
    void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, int *startPtr,
	    int *endPtr)
}
declare 152 {
    void TclSetLibraryPath(Tcl_Obj *pathPtr)
}
declare 153 {
    Tcl_Obj *TclGetLibraryPath(void)
}

# moved to tclTest.c (static) in 8.3.2/8.4a2
#declare 154 {
#    int TclTestChannelCmd(void *clientData,
#    Tcl_Interp *interp, int argc, char **argv)
#}
#declare 155 {
#    int TclTestChannelEventCmd(void *clientData,
#	     Tcl_Interp *interp, int argc, char **argv)
#}

declare 156 {
    void TclRegError(Tcl_Interp *interp, const char *msg,
	    int status)
}
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671

# new in 8.3.2/8.4a2
declare 161 {
    int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan,
	    Tcl_Obj *cmdObjPtr)
}
declare 162 {
    void TclChannelEventScriptInvoker(ClientData clientData, int flags)
}

# ALERT: The result of 'TclGetInstructionTable' is actually a
# "const InstructionDesc*" but we do not want to describe this structure in
# "tclInt.h". It is described in "tclCompile.h". Use a cast to the
# correct type when calling this procedure.








|







657
658
659
660
661
662
663
664
665
666
667
668
669
670
671

# new in 8.3.2/8.4a2
declare 161 {
    int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan,
	    Tcl_Obj *cmdObjPtr)
}
declare 162 {
    void TclChannelEventScriptInvoker(void *clientData, int flags)
}

# ALERT: The result of 'TclGetInstructionTable' is actually a
# "const InstructionDesc*" but we do not want to describe this structure in
# "tclInt.h". It is described in "tclCompile.h". Use a cast to the
# correct type when calling this procedure.

699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 168 {
#    Tcl_Obj *TclGetStartupScriptPath(void)
#}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
declare 169 {
    int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n)
}
declare 170 {
    int TclCheckInterpTraces(Tcl_Interp *interp, const char *command,
	    int numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 171 {
    int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command,
	    int numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 172 {
    int TclInThreadExit(void)
}

# added for 8.4.2

declare 173 {
    int TclUniCharMatch(const Tcl_UniChar *string, int strLen,
	    const Tcl_UniChar *pattern, int ptnLen, int flags)
}

# added for 8.4.3

#declare 174 {
#    Tcl_Obj *TclIncrWideVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
#	    Tcl_Obj *part2Ptr, Tcl_WideInt wideIncrAmount, int part1NotParsed)







|



|




|









|
|







699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 168 {
#    Tcl_Obj *TclGetStartupScriptPath(void)
#}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
declare 169 {
    int TclpUtfNcmp2(const char *s1, const char *s2, size_t n)
}
declare 170 {
    int TclCheckInterpTraces(Tcl_Interp *interp, const char *command,
	    size_t numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 171 {
    int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command,
	    size_t numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 172 {
    int TclInThreadExit(void)
}

# added for 8.4.2

declare 173 {
    int TclUniCharMatch(const Tcl_UniChar *string, size_t strLen,
	    const Tcl_UniChar *pattern, size_t ptnLen, int flags)
}

# added for 8.4.3

#declare 174 {
#    Tcl_Obj *TclIncrWideVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
#	    Tcl_Obj *part2Ptr, Tcl_WideInt wideIncrAmount, int part1NotParsed)
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
declare 213 {
    Tcl_Obj *TclGetObjNameOfExecutable(void)
}
declare 214 {
    void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
}
declare 215 {
    void *TclStackAlloc(Tcl_Interp *interp, int numBytes)
}
declare 216 {
    void TclStackFree(Tcl_Interp *interp, void *freePtr)
}
declare 217 {
    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
            Tcl_Namespace *namespacePtr, int isProcCallFrame)







|







882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
declare 213 {
    Tcl_Obj *TclGetObjNameOfExecutable(void)
}
declare 214 {
    void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
}
declare 215 {
    void *TclStackAlloc(Tcl_Interp *interp, size_t numBytes)
}
declare 216 {
    void TclStackFree(Tcl_Interp *interp, void *freePtr)
}
declare 217 {
    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
            Tcl_Namespace *namespacePtr, int isProcCallFrame)
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
    Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr,
	    int keyc, Tcl_Obj *const keyv[], int flags)
}
declare 226 {
    int TclObjBeingDeleted(Tcl_Obj *objPtr)
}
declare 227 {
    void TclSetNsPath(Namespace *nsPtr, int pathLength,
            Tcl_Namespace *pathAry[])
}
#  Used to be needed for TclOO-extension; unneeded now that TclOO is in the
#  core and NRE-enabled
#  declare 228 {
#      int TclObjInterpProcCore(register Tcl_Interp *interp, Tcl_Obj *procNameObj,
#             int skip, ProcErrorProc *errorProc)







|







909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
    Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr,
	    int keyc, Tcl_Obj *const keyv[], int flags)
}
declare 226 {
    int TclObjBeingDeleted(Tcl_Obj *objPtr)
}
declare 227 {
    void TclSetNsPath(Namespace *nsPtr, size_t pathLength,
            Tcl_Namespace *pathAry[])
}
#  Used to be needed for TclOO-extension; unneeded now that TclOO is in the
#  core and NRE-enabled
#  declare 228 {
#      int TclObjInterpProcCore(register Tcl_Interp *interp, Tcl_Obj *procNameObj,
#             int skip, ProcErrorProc *errorProc)
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
declare 237 {
    int TclResetCancellation(Tcl_Interp *interp, int force)
}

# NRE functions for "rogue" extensions to exploit NRE; they will need to
# include NRE.h too.
declare 238 {
    int TclNRInterpProc(ClientData clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 239 {
    int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
			    int skip, ProcErrorProc *errorProc)
}
declare 240 {







|







964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
declare 237 {
    int TclResetCancellation(Tcl_Interp *interp, int force)
}

# NRE functions for "rogue" extensions to exploit NRE; they will need to
# include NRE.h too.
declare 238 {
    int TclNRInterpProc(void *clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 239 {
    int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
			    int skip, ProcErrorProc *errorProc)
}
declare 240 {
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
declare 244 {
    Tcl_HashTable *TclGetNamespaceChildTable(Tcl_Namespace *nsPtr)
}
declare 245 {
    Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr)
}
declare 246 {
    int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved,
	    int numInserted, Tcl_Obj *const *objv)
}
declare 247 {
    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
}

declare 248 {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,







|
|







997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
declare 244 {
    Tcl_HashTable *TclGetNamespaceChildTable(Tcl_Namespace *nsPtr)
}
declare 245 {
    Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr)
}
declare 246 {
    int TclInitRewriteEnsemble(Tcl_Interp *interp, size_t numRemoved,
	    size_t numInserted, Tcl_Obj *const *objv)
}
declare 247 {
    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
}

declare 248 {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
declare 250 {
    void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
}

# Allow extensions for optimization
declare 251 {
    int TclRegisterLiteral(void *envPtr,
	    const char *bytes, int length, int flags)
}

# Exporting of the internal API to variables.

declare 252 {
    Tcl_Obj *TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
	    Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,







|







1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
declare 250 {
    void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
}

# Allow extensions for optimization
declare 251 {
    int TclRegisterLiteral(void *envPtr,
	    const char *bytes, size_t length, int flags)
}

# Exporting of the internal API to variables.

declare 252 {
    Tcl_Obj *TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
	    Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
#}
# Removed in 9.0:
#declare 7 win {
#    int TclWinSetSockOpt(SOCKET s, int level, int optname,
#	    const char *optval, int optlen)
#}
declare 8 win {
    int TclpGetPid(Tcl_Pid pid)
}
# Removed in 9.0:
#declare 9 win {
#    int TclWinGetPlatformId(void)
#}
# Removed in 9.0:
#declare 10 win {







|







1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
#}
# Removed in 9.0:
#declare 7 win {
#    int TclWinSetSockOpt(SOCKET s, int level, int optname,
#	    const char *optval, int optlen)
#}
declare 8 win {
    size_t TclpGetPid(Tcl_Pid pid)
}
# Removed in 9.0:
#declare 9 win {
#    int TclWinGetPlatformId(void)
#}
# Removed in 9.0:
#declare 10 win {
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
declare 18 win {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 19 win {
    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
    void TclWinAddProcess(HANDLE hProcess, DWORD id)
}
# Removed in 9.0:
#declare 21 win {
#    char *TclpInetNtoa(struct in_addr addr)
#}
# removed permanently for 8.4
#declare 21 win {







|







1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
declare 18 win {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 19 win {
    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
    void TclWinAddProcess(HANDLE hProcess, size_t id)
}
# Removed in 9.0:
#declare 21 win {
#    char *TclpInetNtoa(struct in_addr addr)
#}
# removed permanently for 8.4
#declare 21 win {
Changes to generic/tclInt.h.
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
typedef struct Namespace {
    char *name;			/* The namespace's simple (unqualified) name.
				 * This contains no ::'s. The name of the
				 * global namespace is "" although "::" is an
				 * synonym. */
    char *fullName;		/* The namespace's fully qualified name. This
				 * starts with ::. */
    ClientData clientData;	/* An arbitrary value associated with this
				 * namespace. */
    Tcl_NamespaceDeleteProc *deleteProc;
				/* Procedure invoked when deleting the
				 * namespace to, e.g., free clientData. */
    struct Namespace *parentPtr;/* Points to the namespace that contains this
				 * one. NULL if this is the global
				 * namespace. */
#ifndef BREAK_NAMESPACE_COMPAT
    Tcl_HashTable childTable;	/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). */
#else
    Tcl_HashTable *childTablePtr;
				/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). If
				 * NULL, there are no children. */
#endif
    size_t nsId;		/* Unique id for the namespace. */
    Tcl_Interp *interp;		/* The interpreter containing this
				 * namespace. */
    int flags;			/* OR-ed combination of the namespace status
				 * flags NS_DYING and NS_DEAD listed below. */
    int activationCount;	/* Number of "activations" or active call
				 * frames for this namespace that are on the
				 * Tcl call stack. The namespace won't be
				 * freed until activationCount becomes zero. */
    size_t refCount;		/* Count of references by namespaceName
				 * objects. The namespace can't be freed until
				 * refCount becomes zero. */
    Tcl_HashTable cmdTable;	/* Contains all the commands currently







|

















|



|







250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
typedef struct Namespace {
    char *name;			/* The namespace's simple (unqualified) name.
				 * This contains no ::'s. The name of the
				 * global namespace is "" although "::" is an
				 * synonym. */
    char *fullName;		/* The namespace's fully qualified name. This
				 * starts with ::. */
    void *clientData;	/* An arbitrary value associated with this
				 * namespace. */
    Tcl_NamespaceDeleteProc *deleteProc;
				/* Procedure invoked when deleting the
				 * namespace to, e.g., free clientData. */
    struct Namespace *parentPtr;/* Points to the namespace that contains this
				 * one. NULL if this is the global
				 * namespace. */
#ifndef BREAK_NAMESPACE_COMPAT
    Tcl_HashTable childTable;	/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). */
#else
    Tcl_HashTable *childTablePtr;
				/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). If
				 * NULL, there are no children. */
#endif
    size_t nsId;		/* Unique id for the namespace. */
    Tcl_Interp *interp;	/* The interpreter containing this
				 * namespace. */
    int flags;			/* OR-ed combination of the namespace status
				 * flags NS_DYING and NS_DEAD listed below. */
    size_t activationCount;	/* Number of "activations" or active call
				 * frames for this namespace that are on the
				 * Tcl call stack. The namespace won't be
				 * freed until activationCount becomes zero. */
    size_t refCount;		/* Count of references by namespaceName
				 * objects. The namespace can't be freed until
				 * refCount becomes zero. */
    Tcl_HashTable cmdTable;	/* Contains all the commands currently
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
    char **exportArrayPtr;	/* Points to an array of string patterns
				 * specifying which commands are exported. A
				 * pattern may include "string match" style
				 * wildcard characters to specify multiple
				 * commands; however, no namespace qualifiers
				 * are allowed. NULL if no export patterns are
				 * registered. */
    int numExportPatterns;	/* Number of export patterns currently
				 * registered using "namespace export". */
    int maxExportPatterns;	/* Mumber of export patterns for which space
				 * is currently allocated. */
    size_t cmdRefEpoch;		/* Incremented if a newly added command
				 * shadows a command for which this namespace
				 * has already cached a Command* pointer; this
				 * causes all its cached Command* pointers to
				 * be invalidated. */
    size_t resolverEpoch;	/* Incremented whenever (a) the name







|

|







297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
    char **exportArrayPtr;	/* Points to an array of string patterns
				 * specifying which commands are exported. A
				 * pattern may include "string match" style
				 * wildcard characters to specify multiple
				 * commands; however, no namespace qualifiers
				 * are allowed. NULL if no export patterns are
				 * registered. */
    size_t numExportPatterns;	/* Number of export patterns currently
				 * registered using "namespace export". */
    size_t maxExportPatterns;	/* Number of export patterns for which space
				 * is currently allocated. */
    size_t cmdRefEpoch;		/* Incremented if a newly added command
				 * shadows a command for which this namespace
				 * has already cached a Command* pointer; this
				 * causes all its cached Command* pointers to
				 * be invalidated. */
    size_t resolverEpoch;	/* Incremented whenever (a) the name
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
				 * validated efficiently. */
    Tcl_Ensemble *ensembles;	/* List of structures that contain the details
				 * of the ensembles that are implemented on
				 * top of this namespace. */
    Tcl_Obj *unknownHandlerPtr;	/* A script fragment to be used when command
				 * resolution in this namespace fails. TIP
				 * 181. */
    int commandPathLength;	/* The length of the explicit path. */
    NamespacePathEntry *commandPathArray;
				/* The explicit path of the namespace as an
				 * array. */
    NamespacePathEntry *commandPathSourceList;
				/* Linked list of path entries that point to
				 * this namespace. */
    Tcl_NamespaceDeleteProc *earlyDeleteProc;







|







344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
				 * validated efficiently. */
    Tcl_Ensemble *ensembles;	/* List of structures that contain the details
				 * of the ensembles that are implemented on
				 * top of this namespace. */
    Tcl_Obj *unknownHandlerPtr;	/* A script fragment to be used when command
				 * resolution in this namespace fails. TIP
				 * 181. */
    size_t commandPathLength;	/* The length of the explicit path. */
    NamespacePathEntry *commandPathArray;
				/* The explicit path of the namespace as an
				 * array. */
    NamespacePathEntry *commandPathSourceList;
				/* Linked list of path entries that point to
				 * this namespace. */
    Tcl_NamespaceDeleteProc *earlyDeleteProc;
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
 * specific C procedure whenever certain operations are performed on a
 * variable.
 */

typedef struct VarTrace {
    Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by
				 * flags are performed on variable. */
    ClientData clientData;	/* Argument to pass to proc. */
    int flags;			/* What events the trace procedure is
				 * interested in: OR-ed combination of
				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
				 * TCL_TRACE_UNSETS and TCL_TRACE_ARRAY. */
    struct VarTrace *nextPtr;	/* Next in list of traces associated with a
				 * particular variable. */
} VarTrace;

/*
 * The following structure defines a command trace, which is used to invoke a
 * specific C procedure whenever certain operations are performed on a
 * command.
 */

typedef struct CommandTrace {
    Tcl_CommandTraceProc *traceProc;
				/* Procedure to call when operations given by
				 * flags are performed on command. */
    ClientData clientData;	/* Argument to pass to proc. */
    int flags;			/* What events the trace procedure is
				 * interested in: OR-ed combination of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
    struct CommandTrace *nextPtr;
				/* Next in list of traces associated with a
				 * particular command. */
    size_t refCount;		/* Used to ensure this structure is not







|


















|







521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
 * specific C procedure whenever certain operations are performed on a
 * variable.
 */

typedef struct VarTrace {
    Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by
				 * flags are performed on variable. */
    void *clientData;	/* Argument to pass to proc. */
    int flags;			/* What events the trace procedure is
				 * interested in: OR-ed combination of
				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
				 * TCL_TRACE_UNSETS and TCL_TRACE_ARRAY. */
    struct VarTrace *nextPtr;	/* Next in list of traces associated with a
				 * particular variable. */
} VarTrace;

/*
 * The following structure defines a command trace, which is used to invoke a
 * specific C procedure whenever certain operations are performed on a
 * command.
 */

typedef struct CommandTrace {
    Tcl_CommandTraceProc *traceProc;
				/* Procedure to call when operations given by
				 * flags are performed on command. */
    void *clientData;	/* Argument to pass to proc. */
    int flags;			/* What events the trace procedure is
				 * interested in: OR-ed combination of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
    struct CommandTrace *nextPtr;
				/* Next in list of traces associated with a
				 * particular command. */
    size_t refCount;		/* Used to ensure this structure is not
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
				 * variable. See below for definitions. */
    union {
	Tcl_Obj *objPtr;	/* The variable's object value. Used for
				 * scalar variables and array elements. */
	TclVarHashTable *tablePtr;/* For array variables, this points to
				 * information about the hash table used to
				 * implement the associative array. Points to
				 * ckalloc-ed data. */
	struct Var *linkPtr;	/* If this is a global variable being referred
				 * to in a procedure, or a variable created by
				 * "upvar", this field points to the
				 * referenced variable's Var struct. */
    } value;
} Var;








|







610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
				 * variable. See below for definitions. */
    union {
	Tcl_Obj *objPtr;	/* The variable's object value. Used for
				 * scalar variables and array elements. */
	TclVarHashTable *tablePtr;/* For array variables, this points to
				 * information about the hash table used to
				 * implement the associative array. Points to
				 * Tcl_Alloc-ed data. */
	struct Var *linkPtr;	/* If this is a global variable being referred
				 * to in a procedure, or a variable created by
				 * "upvar", this field points to the
				 * referenced variable's Var struct. */
    } value;
} Var;

994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
 * clients to find out whenever a command is about to be executed.
 */

typedef struct Trace {
    int level;			/* Only trace commands at nesting level less
				 * than or equal to this. */
    Tcl_CmdObjTraceProc *proc;	/* Procedure to call to trace command. */
    ClientData 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
				 * Tcl_CreateObjTrace for details. */
    Tcl_CmdObjTraceDeleteProc *delProc;
				/* Procedure to call when trace is deleted. */
} Trace;








|







994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
 * clients to find out whenever a command is about to be executed.
 */

typedef struct Trace {
    int level;			/* Only trace commands at nesting level less
				 * than or equal to this. */
    Tcl_CmdObjTraceProc *proc;	/* Procedure to call to trace command. */
    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
				 * Tcl_CreateObjTrace for details. */
    Tcl_CmdObjTraceDeleteProc *delProc;
				/* Procedure to call when trace is deleted. */
} Trace;

1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
 * associated with an interpreter. The entry contains a pointer to a function
 * to call when the interpreter is deleted, and a pointer to a user-defined
 * piece of data.
 */

typedef struct AssocData {
    Tcl_InterpDeleteProc *proc;	/* Proc to call when deleting. */
    ClientData clientData;	/* Value to pass to proc. */
} AssocData;

/*
 * The structure below defines a call frame. A call frame defines a naming
 * context for a procedure call: its local naming scope (for local variables)
 * and its global naming scope (a namespace, perhaps the global :: namespace).
 * A call frame can also define the naming context for a namespace eval or







|







1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
 * associated with an interpreter. The entry contains a pointer to a function
 * to call when the interpreter is deleted, and a pointer to a user-defined
 * piece of data.
 */

typedef struct AssocData {
    Tcl_InterpDeleteProc *proc;	/* Proc to call when deleting. */
    void *clientData;	/* Value to pass to proc. */
} AssocData;

/*
 * The structure below defines a call frame. A call frame defines a naming
 * context for a procedure call: its local naming scope (for local variables)
 * and its global naming scope (a namespace, perhaps the global :: namespace).
 * A call frame can also define the naming context for a namespace eval or
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
				 * Initially NULL and created if needed. */
    int numCompiledLocals;	/* Count of local variables recognized by the
				 * compiler including arguments. */
    Var *compiledLocals;	/* Points to the array of local variables
				 * recognized by the compiler. The compiler
				 * emits code that refers to these variables
				 * using an index into this array. */
    ClientData clientData;	/* Pointer to some context that is used by
				 * object systems. The meaning of the contents
				 * of this field is defined by the code that
				 * sets it, and it should only ever be set by
				 * the code that is pushing the frame. In that
				 * case, the code that sets it should also
				 * have some means of discovering what the
				 * meaning of the value is, which we do not







|







1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
				 * Initially NULL and created if needed. */
    int numCompiledLocals;	/* Count of local variables recognized by the
				 * compiler including arguments. */
    Var *compiledLocals;	/* Points to the array of local variables
				 * recognized by the compiler. The compiler
				 * emits code that refers to these variables
				 * using an index into this array. */
    void *clientData;	/* Pointer to some context that is used by
				 * object systems. The meaning of the contents
				 * of this field is defined by the code that
				 * sets it, and it should only ever be set by
				 * the code that is pushing the frame. In that
				 * case, the code that sets it should also
				 * have some means of discovering what the
				 * meaning of the value is, which we do not
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
	struct {
	    const void *codePtr;/* Byte code currently executed... */
	    const char *pc;	/* ... and instruction pointer. */
	} tebc;
    } data;
    Tcl_Obj *cmdObj;
    const char *cmd;		/* The executed command, if possible... */
    int len;			/* ... and its length. */
    const struct CFWordBC *litarg;
				/* Link to set of literal arguments which have
				 * ben pushed on the lineLABCPtr stack by
				 * TclArgumentBCEnter(). These will be removed
				 * by TclArgumentBCRelease. */
} CmdFrame;

typedef struct CFWord {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    int word;			/* Index of the word in the command. */
    size_t refCount;		/* Number of times the word is on the
				 * stack. */
} CFWord;

typedef struct CFWordBC {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    int pc;			/* Instruction pointer of a command in
				 * ExtCmdLoc.loc[.] */
    int word;			/* Index of word in
				 * ExtCmdLoc.loc[cmd]->line[.] */
    struct CFWordBC *prevPtr;	/* Previous entry in stack for same Tcl_Obj. */
    struct CFWordBC *nextPtr;	/* Next entry for same command call. See
				 * CmdFrame litarg field for the list start. */
    Tcl_Obj *obj;		/* Back reference to hashtable key */







|
















|







1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
	struct {
	    const void *codePtr;/* Byte code currently executed... */
	    const char *pc;	/* ... and instruction pointer. */
	} tebc;
    } data;
    Tcl_Obj *cmdObj;
    const char *cmd;		/* The executed command, if possible... */
    size_t len;			/* ... and its length. */
    const struct CFWordBC *litarg;
				/* Link to set of literal arguments which have
				 * ben pushed on the lineLABCPtr stack by
				 * TclArgumentBCEnter(). These will be removed
				 * by TclArgumentBCRelease. */
} CmdFrame;

typedef struct CFWord {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    int word;			/* Index of the word in the command. */
    size_t refCount;		/* Number of times the word is on the
				 * stack. */
} CFWord;

typedef struct CFWordBC {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    size_t pc;			/* Instruction pointer of a command in
				 * ExtCmdLoc.loc[.] */
    int word;			/* Index of word in
				 * ExtCmdLoc.loc[cmd]->line[.] */
    struct CFWordBC *prevPtr;	/* Previous entry in stack for same Tcl_Obj. */
    struct CFWordBC *nextPtr;	/* Next entry for same command call. See
				 * CmdFrame litarg field for the list start. */
    Tcl_Obj *obj;		/* Back reference to hashtable key */
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336

/*
 * Structure passed to describe procedure-like "procedures" that are not
 * procedures (e.g. a lambda) so that their details can be reported correctly
 * by [info frame]. Contains a sub-structure for each extra field.
 */

typedef Tcl_Obj * (GetFrameInfoValueProc)(ClientData clientData);
typedef struct {
    const char *name;		/* Name of this field. */
    GetFrameInfoValueProc *proc;	/* Function to generate a Tcl_Obj* from the
				 * clientData, or just use the clientData
				 * directly (after casting) if NULL. */
    ClientData clientData;	/* Context for above function, or Tcl_Obj* if
				 * proc field is NULL. */
} ExtraFrameInfoField;
typedef struct {
    int length;			/* Length of array. */
    ExtraFrameInfoField fields[2];
				/* Really as long as necessary, but this is
				 * long enough for nearly anything. */
} ExtraFrameInfo;

/*
 *----------------------------------------------------------------







|





|



|







1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336

/*
 * Structure passed to describe procedure-like "procedures" that are not
 * procedures (e.g. a lambda) so that their details can be reported correctly
 * by [info frame]. Contains a sub-structure for each extra field.
 */

typedef Tcl_Obj * (GetFrameInfoValueProc)(void *clientData);
typedef struct {
    const char *name;		/* Name of this field. */
    GetFrameInfoValueProc *proc;	/* Function to generate a Tcl_Obj* from the
				 * clientData, or just use the clientData
				 * directly (after casting) if NULL. */
    void *clientData;	/* Context for above function, or Tcl_Obj* if
				 * proc field is NULL. */
} ExtraFrameInfoField;
typedef struct {
    size_t length;			/* Length of array. */
    ExtraFrameInfoField fields[2];
				/* Really as long as necessary, but this is
				 * long enough for nearly anything. */
} ExtraFrameInfo;

/*
 *----------------------------------------------------------------
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425

/*
 * The type of procedure called from the compilation hook point in
 * SetByteCodeFromAny.
 */

typedef int (CompileHookProc)(Tcl_Interp *interp,
	struct CompileEnv *compEnvPtr, ClientData clientData);

/*
 * The data structure for a (linked list of) execution stacks.
 */

typedef struct ExecStack {
    struct ExecStack *prevPtr;







|







1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425

/*
 * The type of procedure called from the compilation hook point in
 * SetByteCodeFromAny.
 */

typedef int (CompileHookProc)(Tcl_Interp *interp,
	struct CompileEnv *compEnvPtr, void *clientData);

/*
 * The data structure for a (linked list of) execution stacks.
 */

typedef struct ExecStack {
    struct ExecStack *prevPtr;
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
typedef struct LiteralTable {
    LiteralEntry **buckets;	/* Pointer to bucket array. Each element
				 * points to first entry in bucket's hash
				 * chain, or NULL. */
    LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
				/* Bucket array used for small tables to avoid
				 * mallocs and frees. */
    int numBuckets;		/* Total number of buckets allocated at
				 * **buckets. */
    int numEntries;		/* Total number of entries present in
				 * table. */
    int rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    unsigned int mask;		/* Mask value used in hashing function. */
} LiteralTable;

/*
 * The following structure defines for each Tcl interpreter various
 * statistics-related information about the bytecode compiler and
 * interpreter's operation in that interpreter.
 */







|

|

|

|







1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
typedef struct LiteralTable {
    LiteralEntry **buckets;	/* Pointer to bucket array. Each element
				 * points to first entry in bucket's hash
				 * chain, or NULL. */
    LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
				/* Bucket array used for small tables to avoid
				 * mallocs and frees. */
    size_t numBuckets;		/* Total number of buckets allocated at
				 * **buckets. */
    size_t numEntries;		/* Total number of entries present in
				 * table. */
    size_t rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    size_t mask;		/* Mask value used in hashing function. */
} LiteralTable;

/*
 * The following structure defines for each Tcl interpreter various
 * statistics-related information about the bytecode compiler and
 * interpreter's operation in that interpreter.
 */
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
 */

typedef struct {
    const char *name;		/* The name of the subcommand. */
    Tcl_ObjCmdProc *proc;	/* The implementation of the subcommand. */
    CompileProc *compileProc;	/* The compiler for the subcommand. */
    Tcl_ObjCmdProc *nreProc;	/* NRE implementation of this command. */
    ClientData clientData;	/* Any clientData to give the command. */
    int unsafe;			/* Whether this command is to be hidden by
				 * default in a safe interpreter. */
} EnsembleImplMap;

/*
 *----------------------------------------------------------------
 * Data structures related to commands.







|







1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
 */

typedef struct {
    const char *name;		/* The name of the subcommand. */
    Tcl_ObjCmdProc *proc;	/* The implementation of the subcommand. */
    CompileProc *compileProc;	/* The compiler for the subcommand. */
    Tcl_ObjCmdProc *nreProc;	/* NRE implementation of this command. */
    void *clientData;	/* Any clientData to give the command. */
    int unsafe;			/* Whether this command is to be hidden by
				 * default in a safe interpreter. */
} EnsembleImplMap;

/*
 *----------------------------------------------------------------
 * Data structures related to commands.
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
				 * freed when refCount becomes zero. */
    size_t cmdEpoch;		/* Incremented to invalidate any references
				 * that point to this command when it is
				 * renamed, deleted, hidden, or exposed. */
    CompileProc *compileProc;	/* Procedure called to compile command. NULL
				 * if no compile proc exists for command. */
    Tcl_ObjCmdProc *objProc;	/* Object-based command procedure. */
    ClientData objClientData;	/* Arbitrary value passed to object proc. */
    Tcl_CmdProc *proc;		/* String-based command procedure. */
    ClientData clientData;	/* Arbitrary value passed to string proc. */
    Tcl_CmdDeleteProc *deleteProc;
				/* Procedure invoked when deleting command to,
				 * e.g., free all client data. */
    ClientData deleteData;	/* Arbitrary value passed to deleteProc. */
    int flags;			/* Miscellaneous bits of information about
				 * command. See below for definitions. */
    ImportRef *importRefPtr;	/* List of each imported Command created in
				 * another namespace when this command is
				 * imported. These imported commands redirect
				 * invocations back to this command. The list
				 * is used to remove all those imported







|

|



|







1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
				 * freed when refCount becomes zero. */
    size_t cmdEpoch;		/* Incremented to invalidate any references
				 * that point to this command when it is
				 * renamed, deleted, hidden, or exposed. */
    CompileProc *compileProc;	/* Procedure called to compile command. NULL
				 * if no compile proc exists for command. */
    Tcl_ObjCmdProc *objProc;	/* Object-based command procedure. */
    void *objClientData;	/* Arbitrary value passed to object proc. */
    Tcl_CmdProc *proc;		/* String-based command procedure. */
    void *clientData;	/* Arbitrary value passed to string proc. */
    Tcl_CmdDeleteProc *deleteProc;
				/* Procedure invoked when deleting command to,
				 * e.g., free all client data. */
    void *deleteData;	/* Arbitrary value passed to deleteProc. */
    int flags;			/* Miscellaneous bits of information about
				 * command. See below for definitions. */
    ImportRef *importRefPtr;	/* List of each imported Command created in
				 * another namespace when this command is
				 * imported. These imported commands redirect
				 * invocations back to this command. The list
				 * is used to remove all those imported
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
				 * interp is deleted. */

    Namespace *globalNsPtr;	/* The interpreter's global namespace. */
    Tcl_HashTable *hiddenCmdTablePtr;
				/* Hash table used by tclBasic.c to keep track
				 * of hidden commands on a per-interp
				 * basis. */
    ClientData interpInfo;	/* Information used by tclInterp.c to keep
				 * track of master/slave interps on a
				 * per-interp basis. */
    void (*optimizer)(void *envPtr);
    /*
     * Information related to procedures and variables. See tclProc.c and
     * tclVar.c for usage.
     */







|







1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
				 * interp is deleted. */

    Namespace *globalNsPtr;	/* The interpreter's global namespace. */
    Tcl_HashTable *hiddenCmdTablePtr;
				/* Hash table used by tclBasic.c to keep track
				 * of hidden commands on a per-interp
				 * basis. */
    void *interpInfo;	/* Information used by tclInterp.c to keep
				 * track of master/slave interps on a
				 * per-interp basis. */
    void (*optimizer)(void *envPtr);
    /*
     * Information related to procedures and variables. See tclProc.c and
     * tclVar.c for usage.
     */
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998

    struct {
	Tcl_Obj *const *sourceObjs;
				/* What arguments were actually input into the
				 * *root* ensemble command? (Nested ensembles
				 * don't rewrite this.) NULL if we're not
				 * processing an ensemble. */
	int numRemovedObjs;	/* How many arguments have been stripped off
				 * because of ensemble processing. */
	int numInsertedObjs;	/* How many of the current arguments were
				 * inserted by an ensemble. */
    } ensembleRewrite;

    /*
     * TIP #219: Global info for the I/O system.
     */








|

|







1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998

    struct {
	Tcl_Obj *const *sourceObjs;
				/* What arguments were actually input into the
				 * *root* ensemble command? (Nested ensembles
				 * don't rewrite this.) NULL if we're not
				 * processing an ensemble. */
	size_t numRemovedObjs;	/* How many arguments have been stripped off
				 * because of ensemble processing. */
	size_t numInsertedObjs;	/* How many of the current arguments were
				 * inserted by an ensemble. */
    } ensembleRewrite;

    /*
     * TIP #219: Global info for the I/O system.
     */

2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType)	\
	    ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(ULONG_MAX) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(ULONG_MAX))	\
	    ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#endif

#define TclGetIntFromObj(interp, objPtr, intPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(UINT_MAX) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(UINT_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 >= INT_MIN \
	    && (objPtr)->internalRep.wideValue <= INT_MAX)	\
	    ? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))

/*
 * Macro used to save a function call for common uses of
 * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:







|
|






|
|




|







2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType)	\
	    ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX))	\
	    ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#endif

#define TclGetIntFromObj(interp, objPtr, intPtr) \
    (((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 >= -1 \
	    && (objPtr)->internalRep.wideValue <= INT_MAX)	\
	    ? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))

/*
 * Macro used to save a function call for common uses of
 * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
 * been thoroughly tested and investigated a new public filesystem interface
 * will be released. The aim is more versatile virtual filesystem interfaces,
 * more efficiency in 'path' manipulation and usage, and cleaner filesystem
 * code internally.
 */

#define TCL_FILESYSTEM_VERSION_2	((Tcl_FSVersion) 0x2)
typedef ClientData (TclFSGetCwdProc2)(ClientData clientData);
typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags);

/*
 * The following types are used for getting and storing platform-specific file
 * attributes in tclFCmd.c and the various platform-versions of that file.
 * This is done to have as much common code as possible in the file attributes







|







2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
 * been thoroughly tested and investigated a new public filesystem interface
 * will be released. The aim is more versatile virtual filesystem interfaces,
 * more efficiency in 'path' manipulation and usage, and cleaner filesystem
 * code internally.
 */

#define TCL_FILESYSTEM_VERSION_2	((Tcl_FSVersion) 0x2)
typedef void *(TclFSGetCwdProc2)(void *clientData);
typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags);

/*
 * The following types are used for getting and storing platform-specific file
 * attributes in tclFCmd.c and the various platform-versions of that file.
 * This is done to have as much common code as possible in the file attributes
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645

/*
 *----------------------------------------------------------------------
 * Type values TclGetNumberFromObj
 *----------------------------------------------------------------------
 */

#define TCL_NUMBER_LONG		1
#define TCL_NUMBER_WIDE		2
#define TCL_NUMBER_BIG		3
#define TCL_NUMBER_DOUBLE	4
#define TCL_NUMBER_NAN		5

/*
 *----------------------------------------------------------------
 * Variables shared among Tcl modules but not used by the outside world.







|
<







2630
2631
2632
2633
2634
2635
2636
2637

2638
2639
2640
2641
2642
2643
2644

/*
 *----------------------------------------------------------------------
 * Type values TclGetNumberFromObj
 *----------------------------------------------------------------------
 */

#define TCL_NUMBER_INT		2

#define TCL_NUMBER_BIG		3
#define TCL_NUMBER_DOUBLE	4
#define TCL_NUMBER_NAN		5

/*
 *----------------------------------------------------------------
 * Variables shared among Tcl modules but not used by the outside world.
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
/*
 * TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */

MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr;
MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr;
MODULE_SCOPE ClientData tclTimeClientData;

/*
 * Variables denoting the Tcl object types defined in the core.
 */

MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;







|







2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
/*
 * TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */

MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr;
MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr;
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;
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
/* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile
 *            and Tcl_FindSymbol. This structure corresponds to an opaque
 *            typedef in tcl.h */

typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
				const char* symbol);
struct Tcl_LoadHandle_ {
    ClientData clientData;	/* Client data is the load handle in the
				 * native filesystem if a module was loaded
				 * there, or an opaque pointer to a structure
				 * for further bookkeeping on load-from-VFS
				 * and load-from-memory */
    TclFindSymbolProc* findSymbolProcPtr;
				/* Procedure that resolves symbols in a
				 * loaded module */







|







2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
/* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile
 *            and Tcl_FindSymbol. This structure corresponds to an opaque
 *            typedef in tcl.h */

typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
				const char* symbol);
struct Tcl_LoadHandle_ {
    void *clientData;	/* Client data is the load handle in the
				 * native filesystem if a module was loaded
				 * there, or an opaque pointer to a structure
				 * for further bookkeeping on load-from-VFS
				 * and load-from-memory */
    TclFindSymbolProc* findSymbolProcPtr;
				/* Procedure that resolves symbols in a
				 * loaded module */
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world:
 *----------------------------------------------------------------
 */

MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
			    const unsigned char *bytes, int len);
MODULE_SCOPE int	TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
MODULE_SCOPE void	TclAdvanceContinuations(int *line, int **next,
			    int loc);
MODULE_SCOPE void	TclAdvanceLines(int *line, const char *start,
			    const char *end);
MODULE_SCOPE void	TclArgumentEnter(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc, CmdFrame *cf);
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, int cmd, int pc);
MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
			    CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE double	TclBignumToDouble(const mp_int *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    int strLen, const unsigned char *pattern,
			    int ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const mp_int *a);
MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int	TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int	TclCheckEmptyString(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
			    Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
			    Tcl_Obj *value2Ptr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
			    int *loc);
MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
			    int start, int *clNext);
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
			    Tcl_Obj *originObjPtr);
MODULE_SCOPE int	TclConvertElement(const char *src, int length,
			    char *dst, int flags);
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, ClientData clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
			    const char *name, Tcl_Namespace *nameNamespacePtr,
			    Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
			    const char *dict, int dictLength,
			    const char **elementPtr, const char **nextPtr,
			    int *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
			    int numBytes, int flags, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
			    Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int *objcPtr);







|












|






|
|



















|



|








|


|










|

|







2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world:
 *----------------------------------------------------------------
 */

MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
			    const unsigned char *bytes, size_t len);
MODULE_SCOPE int	TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
MODULE_SCOPE void	TclAdvanceContinuations(int *line, int **next,
			    int loc);
MODULE_SCOPE void	TclAdvanceLines(int *line, const char *start,
			    const char *end);
MODULE_SCOPE void	TclArgumentEnter(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc, CmdFrame *cf);
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, int cmd, size_t pc);
MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
			    CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE double	TclBignumToDouble(const mp_int *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    size_t strLen, const unsigned char *pattern,
			    size_t ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const mp_int *a);
MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int	TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int	TclCheckEmptyString(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
			    Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
			    Tcl_Obj *value2Ptr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
			    int *loc);
MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
			    int start, int *clNext);
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
			    Tcl_Obj *originObjPtr);
MODULE_SCOPE size_t	TclConvertElement(const char *src, size_t length,
			    char *dst, int flags);
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, void *clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
			    const char *name, Tcl_Namespace *nameNamespacePtr,
			    Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
			    const char *dict, int dictLength,
			    const char **elementPtr, const char **nextPtr,
			    size_t *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
			    size_t numBytes, int flags, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
			    Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int *objcPtr);
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966


2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
MODULE_SCOPE double	TclFloor(const mp_int *a);
MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
			    const char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
			    ClientData clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    const char *encodingName);
MODULE_SCOPE void	TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
MODULE_SCOPE int *	TclGetAsyncReadyPtr(void);
MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
MODULE_SCOPE int	TclGetChannelFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
			    int *modePtr, int flags);
MODULE_SCOPE CmdFrame *	TclGetCmdFrameForProcedure(Proc *procPtr);
MODULE_SCOPE int	TclGetCompletionCodeFromObj(Tcl_Interp *interp,
			    Tcl_Obj *value, int *code);
MODULE_SCOPE int	TclGetNumberFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, ClientData *clientDataPtr,
			    int *typePtr);
MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
			    const char *modeString, int *seekFlagPtr,
			    int *binaryPtr);
MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
MODULE_SCOPE Tcl_Obj *	TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
			    unsigned int *sizePtr);
MODULE_SCOPE int	TclGetLoadedPackagesEx(Tcl_Interp *interp,
				const char *targetName,
				const char *packageName);


MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
			    Tcl_Obj *incrPtr);
MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
MODULE_SCOPE int	TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Obj *	TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
MODULE_SCOPE int	TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclInitAlloc(void);
MODULE_SCOPE void	TclInitBignumFromLong(mp_int *, long);
MODULE_SCOPE void	TclInitBignumFromWideInt(mp_int *, Tcl_WideInt);
MODULE_SCOPE void	TclInitBignumFromWideUInt(mp_int *, Tcl_WideUInt);
MODULE_SCOPE void	TclInitDbCkalloc(void);
MODULE_SCOPE void	TclInitDoubleConversion(void);







|













|












>
>




|

|


|

|

|







2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
MODULE_SCOPE double	TclFloor(const mp_int *a);
MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
			    const char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
			    void *clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    const char *encodingName);
MODULE_SCOPE void	TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
MODULE_SCOPE int *	TclGetAsyncReadyPtr(void);
MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
MODULE_SCOPE int	TclGetChannelFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
			    int *modePtr, int flags);
MODULE_SCOPE CmdFrame *	TclGetCmdFrameForProcedure(Proc *procPtr);
MODULE_SCOPE int	TclGetCompletionCodeFromObj(Tcl_Interp *interp,
			    Tcl_Obj *value, int *code);
MODULE_SCOPE int	TclGetNumberFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, void **clientDataPtr,
			    int *typePtr);
MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
			    const char *modeString, int *seekFlagPtr,
			    int *binaryPtr);
MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
MODULE_SCOPE Tcl_Obj *	TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
			    unsigned int *sizePtr);
MODULE_SCOPE int	TclGetLoadedPackagesEx(Tcl_Interp *interp,
				const char *targetName,
				const char *packageName);
MODULE_SCOPE int	TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
				Tcl_WideInt *);
MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
			    Tcl_Obj *incrPtr);
MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
MODULE_SCOPE int	TclInfoExistsCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoCoroutineCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Obj *	TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
MODULE_SCOPE int	TclInfoGlobalsCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoLocalsCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoVarsCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclInitAlloc(void);
MODULE_SCOPE void	TclInitBignumFromLong(mp_int *, long);
MODULE_SCOPE void	TclInitBignumFromWideInt(mp_int *, Tcl_WideInt);
MODULE_SCOPE void	TclInitBignumFromWideUInt(mp_int *, Tcl_WideUInt);
MODULE_SCOPE void	TclInitDbCkalloc(void);
MODULE_SCOPE void	TclInitDoubleConversion(void);
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
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,
			    int indexCount, Tcl_Obj *const indexArray[],
			    Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
			    const EnsembleImplMap map[]);
MODULE_SCOPE int	TclMaxListLength(const char *bytes, int numBytes,
			    const char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);
MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);
MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Namespace *nsPtr, int flags);
MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
MODULE_SCOPE int	TclParseBackslash(const char *src,
			    int numBytes, int *readPtr, char *dst);
MODULE_SCOPE int	TclParseHex(const char *src, int numBytes,
			    int *resultPtr);
MODULE_SCOPE int	TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const char *expected, const char *bytes,
			    int numBytes, const char **endPtrPtr, int flags);
MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, const char *string,
			    int numBytes, Tcl_Parse *parsePtr);
MODULE_SCOPE int	TclParseAllWhiteSpace(const char *src, int numBytes);
MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
			    int code, int level, Tcl_Obj *returnOpts);
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 Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
			    int len);
MODULE_SCOPE int	TclpDeleteFile(const void *path);
MODULE_SCOPE void	TclpFinalizeCondition(Tcl_Condition *condPtr);
MODULE_SCOPE void	TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
MODULE_SCOPE void	TclpFinalizePipes(void);
MODULE_SCOPE void	TclpFinalizeSockets(void);
MODULE_SCOPE int	TclCreateSocketAddress(Tcl_Interp *interp,
			    struct addrinfo **addrlist,
			    const char *host, int port, int willBind,
			    const char **errorMsgPtr);
MODULE_SCOPE int	TclpThreadCreate(Tcl_ThreadId *idPtr,
			    Tcl_ThreadCreateProc *proc, ClientData clientData,
			    int stackSize, int flags);
MODULE_SCOPE int	TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
			    size_t *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void	TclpInitLock(void);
MODULE_SCOPE void	TclpInitPlatform(void);
MODULE_SCOPE void	TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj *	TclpObjListVolumes(void);
MODULE_SCOPE void	TclpMasterLock(void);







|
















|
|



|

|
|






|










|
|
|







3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
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,
			    int indexCount, Tcl_Obj *const indexArray[],
			    Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
			    const EnsembleImplMap map[]);
MODULE_SCOPE int	TclMaxListLength(const char *bytes, size_t numBytes,
			    const char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);
MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);
MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Namespace *nsPtr, int flags);
MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
MODULE_SCOPE int	TclParseBackslash(const char *src,
			    size_t numBytes, size_t *readPtr, char *dst);
MODULE_SCOPE int	TclParseHex(const char *src, size_t numBytes,
			    int *resultPtr);
MODULE_SCOPE int	TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const char *expected, const char *bytes,
			    size_t numBytes, const char **endPtrPtr, int flags);
MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, const char *string,
			    size_t numBytes, Tcl_Parse *parsePtr);
MODULE_SCOPE size_t	TclParseAllWhiteSpace(const char *src, size_t numBytes);
MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
			    int code, int level, Tcl_Obj *returnOpts);
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 Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
			    size_t len);
MODULE_SCOPE int	TclpDeleteFile(const void *path);
MODULE_SCOPE void	TclpFinalizeCondition(Tcl_Condition *condPtr);
MODULE_SCOPE void	TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
MODULE_SCOPE void	TclpFinalizePipes(void);
MODULE_SCOPE void	TclpFinalizeSockets(void);
MODULE_SCOPE int	TclCreateSocketAddress(Tcl_Interp *interp,
			    struct addrinfo **addrlist,
			    const char *host, int port, int willBind,
			    const char **errorMsgPtr);
MODULE_SCOPE int	TclpThreadCreate(Tcl_ThreadId *idPtr,
			    Tcl_ThreadCreateProc *proc, void *clientData,
			    size_t stackSize, int flags);
MODULE_SCOPE size_t	TclpFindVariable(const char *name, size_t *lengthPtr);
MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
			    size_t *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void	TclpInitLock(void);
MODULE_SCOPE void	TclpInitPlatform(void);
MODULE_SCOPE void	TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj *	TclpObjListVolumes(void);
MODULE_SCOPE void	TclpMasterLock(void);
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclCrossFilesystemCopy(Tcl_Interp *interp,
			    Tcl_Obj *source, Tcl_Obj *target);
MODULE_SCOPE int	TclpMatchInDirectory(Tcl_Interp *interp,
			    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
MODULE_SCOPE ClientData	TclpGetNativeCwd(ClientData clientData);
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 Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
			    Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
			    Tcl_Obj *resultingNameObj);







|







3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclCrossFilesystemCopy(Tcl_Interp *interp,
			    Tcl_Obj *source, Tcl_Obj *target);
MODULE_SCOPE int	TclpMatchInDirectory(Tcl_Interp *interp,
			    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
MODULE_SCOPE void	*TclpGetNativeCwd(void *clientData);
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 Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
			    Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
			    Tcl_Obj *resultingNameObj);
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158




3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181




3182
3183
3184
3185
3186
3187




3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
			    int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
			    int *quantifiersFoundPtr);
MODULE_SCOPE int	TclScanElement(const char *string, int length,
			    char *flagPtr);
MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *cmdPrefix);
MODULE_SCOPE void	TclSetBignumIntRep(Tcl_Obj *objPtr,
			    mp_int *bignumValue);
MODULE_SCOPE int	TclSetBooleanFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int	TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
			    int checkEq, int nocase, int reqlength);
MODULE_SCOPE int	TclStringCmpOpts(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int *nocase,
			    int *reqlength);
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, int numOpts,
			    Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, Tcl_Parse *parsePtr,
			    Tcl_InterpState *statePtr);
MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
			    int count, int *tokensLeftPtr, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE int	TclTrim(const char *bytes, int numBytes,
			    const char *trim, int numTrim, int *trimRight);
MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
			    const char *trim, int numTrim);




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);
MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
MODULE_SCOPE int	TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
#ifdef TCL_LOAD_FROM_MEMORY
MODULE_SCOPE void *	TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size);
MODULE_SCOPE int	TclpLoadMemory(Tcl_Interp *interp, void *buffer,
			    int size, int codeSize, Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
#endif
MODULE_SCOPE void	TclInitThreadStorage(void);
MODULE_SCOPE void	TclFinalizeThreadDataThread(void);
MODULE_SCOPE void	TclFinalizeThreadStorage(void);
#ifdef TCL_WIDE_CLICKS
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
#endif
MODULE_SCOPE int	TclZlibInit(Tcl_Interp *interp);




MODULE_SCOPE void *	TclpThreadCreateKey(void);
MODULE_SCOPE void	TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void	TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void *	TclpThreadGetMasterTSD(void *tsdKeyPtr);
MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
			    const char *msg, int length);





/*
 *----------------------------------------------------------------
 * Command procedures in the generic core:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	Tcl_AfterObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_AppendObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ApplyObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_BreakObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CatchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CdObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclChanCreateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPostEventObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPopObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPushObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE int	TclClockOldscanObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CloseObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ConcatObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ContinueObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
			    ClientData clientData);
MODULE_SCOPE int	TclDefaultBgErrorHandlerObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int index, int pathc,
			    Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    int pathc, Tcl_Obj *const pathv[]);
MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/* Assemble command function */
MODULE_SCOPE int	Tcl_AssembleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRAssembleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclMakeEncodingCommandSafe(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_EofObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ErrorObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_EvalObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExecObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExitObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExprObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FblockedObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FconfigureObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FcopyObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclMakeFileCommandSafe(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_FileEventObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FlushObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ForObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ForeachObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FormatObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GetsObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GlobalObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GlobObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_IfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_IncrObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_InterpObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int argc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_JoinObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LappendObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LassignObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LindexObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LinsertObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LlengthObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ListObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LmapObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LoadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrangeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrepeatObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreplaceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreverseObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsearchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsetObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsortObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclNamespaceEnsembleCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_OpenObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PackageObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PidObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_PutsObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PwdObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ReadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RegexpObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RegsubObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RenameObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RepresentationCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ReturnObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ScanObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SeekObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SetObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SplitObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SocketObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SourceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_SubstObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SwitchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TellObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TraceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TryObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnloadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnsetObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UpdateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UplevelObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UpvarObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_VariableObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_VwaitObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_WhileObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/*
 *----------------------------------------------------------------
 * Compilation procedures for commands in the generic core:
 *----------------------------------------------------------------







|














|


|


|



|




|




|




|
|
|
|
|
|
>
>
>
>



|



















>
>
>
>





|
>
>
>
>







|


|


|




|


|


|



|


|


|

|



|

|


|


|




|

|








|




|


|



<
|


|


|


|


|


|


|



|

|



<
|


|


|


|


|


|


|


|


|


|



|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|



|


|


|


|



|


|


|


|


|


|


|


|


|


|


|


|


|


|



|


|


|


|

|


|


|


|


|


|


|


|


|


|


|







3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276

3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304

3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
			    int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
			    int *quantifiersFoundPtr);
MODULE_SCOPE size_t	TclScanElement(const char *string, size_t length,
			    char *flagPtr);
MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *cmdPrefix);
MODULE_SCOPE void	TclSetBignumIntRep(Tcl_Obj *objPtr,
			    mp_int *bignumValue);
MODULE_SCOPE int	TclSetBooleanFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, size_t subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    size_t numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int	TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
			    int checkEq, int nocase, size_t reqlength);
MODULE_SCOPE int	TclStringCmpOpts(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int *nocase,
			    int *reqlength);
MODULE_SCOPE int	TclStringMatch(const char *str, size_t strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    size_t numBytes, int flags, int line,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, int numOpts,
			    Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
			    size_t numBytes, int flags, Tcl_Parse *parsePtr,
			    Tcl_InterpState *statePtr);
MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
			    int count, int *tokensLeftPtr, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE size_t	TclTrim(const char *bytes, size_t numBytes,
			    const char *trim, size_t numTrim, size_t *trimRight);
MODULE_SCOPE size_t	TclTrimLeft(const char *bytes, size_t numBytes,
			    const char *trim, size_t numTrim);
MODULE_SCOPE size_t	TclTrimRight(const char *bytes, size_t numBytes,
			    const char *trim, size_t numTrim);
MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
MODULE_SCOPE void	TclRegisterCommandTypeName(
			    Tcl_ObjCmdProc *implementationProc,
			    const char *nameStr);
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);
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,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
MODULE_SCOPE int	TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
#ifdef TCL_LOAD_FROM_MEMORY
MODULE_SCOPE void *	TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size);
MODULE_SCOPE int	TclpLoadMemory(Tcl_Interp *interp, void *buffer,
			    int size, int codeSize, Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
#endif
MODULE_SCOPE void	TclInitThreadStorage(void);
MODULE_SCOPE void	TclFinalizeThreadDataThread(void);
MODULE_SCOPE void	TclFinalizeThreadStorage(void);
#ifdef TCL_WIDE_CLICKS
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
#endif
MODULE_SCOPE int	TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE int	TclZipfsInit(Tcl_Interp *interp);
MODULE_SCOPE int        TclZipfsMount(Tcl_Interp *interp, const char *zipname,
			 const char *mntpt, const char *passwd);
MODULE_SCOPE int 	TclZipfsUnmount(Tcl_Interp *interp, const char *zipname);
MODULE_SCOPE void *	TclpThreadCreateKey(void);
MODULE_SCOPE void	TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void	TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void *	TclpThreadGetMasterTSD(void *tsdKeyPtr);
MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
			    const char *msg, size_t length);
/* Tip 430 */
MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);
MODULE_SCOPE int    TclZipfs_SafeInit(Tcl_Interp *interp);


/*
 *----------------------------------------------------------------
 * Command procedures in the generic core:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	Tcl_AfterObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_AppendObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ApplyObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_BreakObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CatchObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CdObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclChanCreateObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPostEventObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPopObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPushObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE int	TclClockOldscanObjCmd(
			    void *clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CloseObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ConcatObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ContinueObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
			    void *clientData);
MODULE_SCOPE int	TclDefaultBgErrorHandlerObjCmd(
			    void *clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int index, int pathc,
			    Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    int pathc, Tcl_Obj *const pathv[]);
MODULE_SCOPE int	Tcl_DisassembleObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/* Assemble command function */
MODULE_SCOPE int	Tcl_AssembleObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRAssembleObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);

MODULE_SCOPE int	Tcl_EofObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ErrorObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_EvalObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExecObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExitObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExprObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FblockedObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FconfigureObjCmd(
			    void *clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FcopyObjCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp);

MODULE_SCOPE int	Tcl_FileEventObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FlushObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ForObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ForeachObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FormatObjCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GetsObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GlobalObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GlobObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_IfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_IncrObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_InterpObjCmd(void *clientData,
			    Tcl_Interp *interp, int argc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_JoinObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LappendObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LassignObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LindexObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LinsertObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LlengthObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ListObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LmapObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LoadObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrangeObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrepeatObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreplaceObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreverseObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsearchObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsetObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsortObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclNamespaceEnsembleCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_OpenObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PackageObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PidObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_PutsObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PwdObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ReadObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RegexpObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RegsubObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RenameObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RepresentationCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ReturnObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ScanObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SeekObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SetObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SplitObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SocketObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SourceObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_SubstObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SwitchObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TellObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ThrowObjCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TraceObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TryObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnloadObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnsetObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UpdateObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UplevelObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UpvarObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_VariableObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_VwaitObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_WhileObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/*
 *----------------------------------------------------------------
 * Compilation procedures for commands in the generic core:
 *----------------------------------------------------------------
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
MODULE_SCOPE int	TclCompileBasicMin1ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasicMin2ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

MODULE_SCOPE int	TclInvertOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileInvertOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclNotOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileNotOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclAddOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileAddOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclMulOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileMulOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclAndOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileAndOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclOrOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileOrOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclXorOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileXorOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclPowOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompilePowOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclLshiftOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileLshiftOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclRshiftOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileRshiftOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclModOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileModOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclNeqOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileNeqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclStrneqOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileStrneqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclInOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileInOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclNiOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileNiOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclMinusOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileMinusOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclDivOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileDivOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclLessOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileLessOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclLeqOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileLeqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclGreaterOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileGreaterOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclGeqOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileGeqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclEqOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileEqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclStreqOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

/*
 * Routines that provide the [string] ensemble functionality. Possible
 * candidates for public interface.
 */

MODULE_SCOPE Tcl_Obj *	TclStringCat(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int flags);
MODULE_SCOPE int	TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int start);
MODULE_SCOPE int	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int last);
MODULE_SCOPE Tcl_Obj *	TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int count, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int first, int count, Tcl_Obj *insertPtr,
			    int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReverse(Tcl_Obj *objPtr, int flags);

/* Flag values for the [string] ensemble functions. */

#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */
#define TCL_STRING_IN_PLACE (1<<1)







|





|





|





|





|





|





|





|





|





|





|





|





|





|





|





|





|





|





|





|





|





|





|

















|
|
|
|

|

|







3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
MODULE_SCOPE int	TclCompileBasicMin1ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasicMin2ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

MODULE_SCOPE int	TclInvertOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileInvertOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclNotOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileNotOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclAddOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileAddOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclMulOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileMulOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclAndOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileAndOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclOrOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileOrOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclXorOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileXorOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclPowOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompilePowOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclLshiftOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileLshiftOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclRshiftOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileRshiftOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclModOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileModOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclNeqOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileNeqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclStrneqOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileStrneqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclInOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileInOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclNiOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileNiOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclMinusOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileMinusOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclDivOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileDivOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclLessOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileLessOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclLeqOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileLeqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclGreaterOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileGreaterOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclGeqOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileGeqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclEqOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileEqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclStreqOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

/*
 * Routines that provide the [string] ensemble functionality. Possible
 * candidates for public interface.
 */

MODULE_SCOPE Tcl_Obj *	TclStringCat(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int flags);
MODULE_SCOPE size_t	TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
			    size_t start);
MODULE_SCOPE size_t	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    size_t last);
MODULE_SCOPE Tcl_Obj *	TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t count, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t first, size_t count, Tcl_Obj *insertPtr,
			    int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReverse(Tcl_Obj *objPtr, int flags);

/* Flag values for the [string] ensemble functions. */

#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */
#define TCL_STRING_IN_PLACE (1<<1)
4014
4015
4016
4017
4018
4019
4020













4021
4022
4023
4024
4025
4026
4027

MODULE_SCOPE int	TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
MODULE_SCOPE void	TclFreeObjEntry(Tcl_HashEntry *hPtr);
MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);

MODULE_SCOPE int	TclFullFinalizationRequested(void);














/*
 * TIP #462.
 */

/*
 * The following enum values give the status of a spawned process.
 */







>
>
>
>
>
>
>
>
>
>
>
>
>







4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051

MODULE_SCOPE int	TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
MODULE_SCOPE void	TclFreeObjEntry(Tcl_HashEntry *hPtr);
MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);

MODULE_SCOPE int	TclFullFinalizationRequested(void);

/*
 * Just for the purposes of command-type registration.
 */

MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclLocalAliasObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclSlaveObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInvokeImportedCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclOOPublicObjectCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclOOPrivateObjectCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclOOMyClassObjCmd;

/*
 * TIP #462.
 */

/*
 * The following enum values give the status of a spawned process.
 */
4038
4039
4040
4041
4042
4043
4044







4045
4046
4047
4048
4049
4050
4051

MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
			    int *codePtr, Tcl_Obj **msgObjPtr,
			    Tcl_Obj **errorObjPtr);








/*
 * Utility routines for encoding index values as integers. Used by both
 * some of the command compilers and by [lsort] and [lsearch].
 */

MODULE_SCOPE int	TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int before, int after, int *indexPtr);







>
>
>
>
>
>
>







4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082

MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
			    int *codePtr, Tcl_Obj **msgObjPtr,
			    Tcl_Obj **errorObjPtr);

/*
 * TIP #508: [array default]
 */

MODULE_SCOPE void	TclInitArrayVar(Var *arrayPtr);
MODULE_SCOPE Tcl_Obj *	TclGetArrayDefault(Var *arrayPtr);

/*
 * Utility routines for encoding index values as integers. Used by both
 * some of the command compilers and by [lsort] and [lsearch].
 */

MODULE_SCOPE int	TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int before, int after, int *indexPtr);
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
    (objPtr)->length   = 0; \
    (objPtr)->typePtr  = NULL; \
    TCL_DTRACE_OBJ_CREATE(objPtr)

/*
 * Invalidate the string rep first so we can use the bytes value for our
 * pointer chain, and signal an obj deletion (as opposed to shimmering) with
 * 'length == -1'.
 * Use empty 'if ; else' to handle use in unbraced outer if/else conditions.
 */

# define TclDecrRefCount(objPtr) \
    if ((objPtr)->refCount-- > 1) ; else { \
	if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
	    TCL_DTRACE_OBJ_FREE(objPtr); \
	    if ((objPtr)->bytes \
		    && ((objPtr)->bytes != &tclEmptyString)) { \
		ckfree((objPtr)->bytes); \
	    } \
	    (objPtr)->length = -1; \
	    TclFreeObjStorage(objPtr); \
	    TclIncrObjsFreed(); \
	} else { \
	    TclFreeObj(objPtr); \
	} \
    }








|









|

|







4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
    (objPtr)->length   = 0; \
    (objPtr)->typePtr  = NULL; \
    TCL_DTRACE_OBJ_CREATE(objPtr)

/*
 * Invalidate the string rep first so we can use the bytes value for our
 * pointer chain, and signal an obj deletion (as opposed to shimmering) with
 * 'length == TCL_AUTO_LENGTH'.
 * Use empty 'if ; else' to handle use in unbraced outer if/else conditions.
 */

# define TclDecrRefCount(objPtr) \
    if ((objPtr)->refCount-- > 1) ; else { \
	if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
	    TCL_DTRACE_OBJ_FREE(objPtr); \
	    if ((objPtr)->bytes \
		    && ((objPtr)->bytes != &tclEmptyString)) { \
		Tcl_Free((objPtr)->bytes); \
	    } \
	    (objPtr)->length = TCL_AUTO_LENGTH; \
	    TclFreeObjStorage(objPtr); \
	    TclIncrObjsFreed(); \
	} else { \
	    TclFreeObj(objPtr); \
	} \
    }

4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
 * The PURIFY mode is like the regular mode, but instead of doing block
 * Tcl_Obj allocation and keeping a freed list for efficiency, it always
 * allocates and frees a single Tcl_Obj so that tools like Purify can better
 * track memory leaks.
 */

#  define TclAllocObjStorageEx(interp, objPtr) \
	(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))

#  define TclFreeObjStorageEx(interp, objPtr) \
	ckfree(objPtr)

#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
#elif TCL_THREADS && defined(USE_THREAD_ALLOC)

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from







|


|







4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
 * The PURIFY mode is like the regular mode, but instead of doing block
 * Tcl_Obj allocation and keeping a freed list for efficiency, it always
 * allocates and frees a single Tcl_Obj so that tools like Purify can better
 * track memory leaks.
 */

#  define TclAllocObjStorageEx(interp, objPtr) \
	(objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))

#  define TclFreeObjStorageEx(interp, objPtr) \
	Tcl_Free(objPtr)

#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
#elif TCL_THREADS && defined(USE_THREAD_ALLOC)

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323


















4324
4325

4326



4327





4328
4329
4330
4331
4332
4333
4334
 *----------------------------------------------------------------
 * Macro used by the Tcl core to set a Tcl_Obj's string representation to a
 * copy of the "len" bytes starting at "bytePtr". This code works even if the
 * byte array contains NULLs as long as the length is correct. Because "len"
 * is referenced multiple times, it should be as simple an expression as
 * possible. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, int len);
 *
 * This macro should only be called on an unshared objPtr where
 *  objPtr->typePtr->freeIntRepProc == NULL
 *----------------------------------------------------------------
 */

#define TclInitStringRep(objPtr, bytePtr, len) \
    if ((len) == 0) { \
	(objPtr)->bytes	 = &tclEmptyString; \
	(objPtr)->length = 0; \
    } else { \
	(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
	memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \
	(objPtr)->bytes[len] = '\0'; \
	(objPtr)->length = (len); \
    }

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the string representation's byte array
 * pointer from a Tcl_Obj. This is an inline version of Tcl_GetString(). The
 * macro's expression result is the string rep's byte pointer which might be
 * NULL. The bytes referenced by this pointer must not be modified by the
 * caller. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE char *	TclGetString(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclGetString(objPtr) \
    ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr))



















#define TclGetStringFromObj(objPtr, lenPtr) \
    ((objPtr)->bytes \

	    ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes)	\



	    : Tcl_GetStringFromObj((objPtr), (lenPtr)))






/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to clean out an object's internal
 * representation. Does not actually reset the rep's bytes. The ANSI C
 * "prototype" for this macro is:
 *







|











|
|



















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|
>
|
>
>
>
|
>
>
>
>
>







4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
 *----------------------------------------------------------------
 * Macro used by the Tcl core to set a Tcl_Obj's string representation to a
 * copy of the "len" bytes starting at "bytePtr". This code works even if the
 * byte array contains NULLs as long as the length is correct. Because "len"
 * is referenced multiple times, it should be as simple an expression as
 * possible. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len);
 *
 * This macro should only be called on an unshared objPtr where
 *  objPtr->typePtr->freeIntRepProc == NULL
 *----------------------------------------------------------------
 */

#define TclInitStringRep(objPtr, bytePtr, len) \
    if ((len) == 0) { \
	(objPtr)->bytes	 = &tclEmptyString; \
	(objPtr)->length = 0; \
    } else { \
	(objPtr)->bytes = Tcl_Alloc((len) + 1); \
	memcpy((objPtr)->bytes, (bytePtr), (len)); \
	(objPtr)->bytes[len] = '\0'; \
	(objPtr)->length = (len); \
    }

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the string representation's byte array
 * pointer from a Tcl_Obj. This is an inline version of Tcl_GetString(). The
 * macro's expression result is the string rep's byte pointer which might be
 * NULL. The bytes referenced by this pointer must not be modified by the
 * caller. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE char *	TclGetString(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclGetString(objPtr) \
    ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr))

#if 0
   static inline char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lenPtr) {
      char *response = Tcl_GetString(objPtr);
      *(lenPtr) = objPtr->length;
      return response;
   }
   static inline Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lenPtr) {
      Tcl_UniChar *response = Tcl_GetUnicodeFromObj(objPtr, NULL);
      *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1);
      return response;
   }
   static inline unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lenPtr) {
      unsigned char *response = Tcl_GetByteArrayFromObj(objPtr, NULL);
      *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1);
      return response;
   }

#else
#define TclGetStringFromObj(objPtr, lenPtr) \
    (((objPtr)->bytes \
	    ? 0 : Tcl_GetString((objPtr)), \
	    *(lenPtr) = (objPtr)->length, (objPtr)->bytes))
#define TclGetUnicodeFromObj(objPtr, lenPtr) \
    (Tcl_GetUnicodeFromObj(objPtr, NULL), \
	    *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1), \
	    Tcl_GetUnicodeFromObj(objPtr, NULL))
#define TclGetByteArrayFromObj(objPtr, lenPtr) \
    (Tcl_GetByteArrayFromObj(objPtr, NULL), \
	    *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1), \
	    Tcl_GetByteArrayFromObj(objPtr, NULL))
#endif

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to clean out an object's internal
 * representation. Does not actually reset the rep's bytes. The ANSI C
 * "prototype" for this macro is:
 *
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
 * MODULE_SCOPE void	TclInvalidateStringRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclInvalidateStringRep(objPtr) \
    if ((objPtr)->bytes != NULL) { \
	if ((objPtr)->bytes != &tclEmptyString) { \
	    ckfree((objPtr)->bytes); \
	} \
	(objPtr)->bytes = NULL; \
    }

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same







|







4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
 * MODULE_SCOPE void	TclInvalidateStringRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclInvalidateStringRep(objPtr) \
    if ((objPtr)->bytes != NULL) { \
	if ((objPtr)->bytes != &tclEmptyString) { \
	    Tcl_Free((objPtr)->bytes); \
	} \
	(objPtr)->bytes = NULL; \
    }

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
	    Tcl_Token *newPtr;						\
	    if (oldPtr == (staticPtr)) {				\
		oldPtr = NULL;						\
	    }								\
	    if (allocated > TCL_MAX_TOKENS) {				\
		allocated = TCL_MAX_TOKENS;				\
	    }								\
	    newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr,	\
		    (unsigned int) (allocated * sizeof(Tcl_Token)));	\
	    if (newPtr == NULL) {					\
		allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH;	\
		if (allocated > TCL_MAX_TOKENS) {			\
		    allocated = TCL_MAX_TOKENS;				\
		}							\
		newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr,	\
			(unsigned int) (allocated * sizeof(Tcl_Token))); \
	    }								\
	    (available) = allocated;					\
	    if (oldPtr == NULL) {					\
		memcpy(newPtr, staticPtr,				\
			(size_t) ((used) * sizeof(Tcl_Token)));		\
	    }								\







|






|







4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
	    Tcl_Token *newPtr;						\
	    if (oldPtr == (staticPtr)) {				\
		oldPtr = NULL;						\
	    }								\
	    if (allocated > TCL_MAX_TOKENS) {				\
		allocated = TCL_MAX_TOKENS;				\
	    }								\
	    newPtr = (Tcl_Token *) Tcl_AttemptRealloc((char *) oldPtr,	\
		    (unsigned int) (allocated * sizeof(Tcl_Token)));	\
	    if (newPtr == NULL) {					\
		allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH;	\
		if (allocated > TCL_MAX_TOKENS) {			\
		    allocated = TCL_MAX_TOKENS;				\
		}							\
		newPtr = (Tcl_Token *) Tcl_Realloc((char *) oldPtr,	\
			(unsigned int) (allocated * sizeof(Tcl_Token))); \
	    }								\
	    (available) = allocated;					\
	    if (oldPtr == NULL) {					\
		memcpy(newPtr, staticPtr,				\
			(size_t) ((used) * sizeof(Tcl_Token)));		\
	    }								\
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
 *----------------------------------------------------------------
 * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed-
 * -sensitive points where it pays to avoid a function call in the common case
 * of counting along a string of all one-byte characters.  The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclNumUtfChars(int numChars, const char *bytes,
 *				int numBytes);
 *----------------------------------------------------------------
 */

#define TclNumUtfChars(numChars, bytes, numBytes) \
    do { \
	int _count, _i = (numBytes); \
	unsigned char *_str = (unsigned char *) (bytes); \
	while (_i && (*_str < 0xC0)) { _i--; _str++; } \
	_count = (numBytes) - _i; \
	if (_i) { \
	    _count += Tcl_NumUtfChars((bytes) + _count, _i); \
	} \
	(numChars) = _count; \







|





|







4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
 *----------------------------------------------------------------
 * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed-
 * -sensitive points where it pays to avoid a function call in the common case
 * of counting along a string of all one-byte characters.  The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclNumUtfChars(int numChars, const char *bytes,
 *				size_t numBytes);
 *----------------------------------------------------------------
 */

#define TclNumUtfChars(numChars, bytes, numBytes) \
    do { \
	size_t _count, _i = (numBytes); \
	unsigned char *_str = (unsigned char *) (bytes); \
	while (_i && (*_str < 0xC0)) { _i--; _str++; } \
	_count = (numBytes) - _i; \
	if (_i) { \
	    _count += Tcl_NumUtfChars((bytes) + _count, _i); \
	} \
	(numChars) = _count; \
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and initialise objects of standard
 * types, avoiding the corresponding function calls in time critical parts of
 * the core. The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	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, int len);
 * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
 *
 *----------------------------------------------------------------
 */

#ifndef TCL_MEM_DEBUG
#define TclNewIntObj(objPtr, i) \







|







4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and initialise objects of standard
 * types, avoiding the corresponding function calls in time critical parts of
 * the core. The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	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, size_t len);
 * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
 *
 *----------------------------------------------------------------
 */

#ifndef TCL_MEM_DEBUG
#define TclNewIntObj(objPtr, i) \
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
#endif /* TCL_MEM_DEBUG */

/*
 * The sLiteral argument *must* be a string literal; the incantation with
 * sizeof(sLiteral "") will fail to compile otherwise.
 */
#define TclNewLiteralStringObj(objPtr, sLiteral) \
    TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))

/*
 *----------------------------------------------------------------
 * Convenience macros for DStrings.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr,
 *			const char *sLiteral);
 * MODULE_SCOPE void   TclDStringClear(Tcl_DString *dsPtr);
 */

#define TclDStringAppendLiteral(dsPtr, sLiteral) \
    Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
#define TclDStringClear(dsPtr) \
    Tcl_DStringSetLength((dsPtr), 0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to test for some special double values.
 * The ANSI C "prototypes" for these macros are:







|












|







4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
#endif /* TCL_MEM_DEBUG */

/*
 * The sLiteral argument *must* be a string literal; the incantation with
 * sizeof(sLiteral "") will fail to compile otherwise.
 */
#define TclNewLiteralStringObj(objPtr, sLiteral) \
    TclNewStringObj((objPtr), (sLiteral), sizeof(sLiteral "") - 1)

/*
 *----------------------------------------------------------------
 * Convenience macros for DStrings.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr,
 *			const char *sLiteral);
 * MODULE_SCOPE void   TclDStringClear(Tcl_DString *dsPtr);
 */

#define TclDStringAppendLiteral(dsPtr, sLiteral) \
    Tcl_DStringAppend((dsPtr), (sLiteral), sizeof(sLiteral "") - 1)
#define TclDStringClear(dsPtr) \
    Tcl_DStringSetLength((dsPtr), 0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to test for some special double values.
 * The ANSI C "prototypes" for these macros are:
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
/*
 * ----------------------------------------------------------------------
 * Macro to use to find the offset of a field in a structure. Computes number
 * of bytes from beginning of structure to a given field.
 */

#ifdef offsetof
#define TclOffset(type, field) ((int) offsetof(type, field))
#else
#define TclOffset(type, field) ((int) ((char *) &((type *) 0)->field))
#endif

/*
 *----------------------------------------------------------------
 * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace.
 */








|

|







4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
/*
 * ----------------------------------------------------------------------
 * Macro to use to find the offset of a field in a structure. Computes number
 * of bytes from beginning of structure to a given field.
 */

#ifdef offsetof
#define TclOffset(type, field) (offsetof(type, field))
#else
#define TclOffset(type, field) (((char *) &((type *) 0)->field))
#endif

/*
 *----------------------------------------------------------------
 * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace.
 */

4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
 *----------------------------------------------------------------
 * Inline version of TclCleanupCommand; still need the function as it is in
 * the internal stubs, but the core can use the macro instead.
 */

#define TclCleanupCommandMacro(cmdPtr) \
    if ((cmdPtr)->refCount-- <= 1) { \
	ckfree(cmdPtr);\
    }

/*
 *----------------------------------------------------------------
 * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number
 * of calls out of the critical path. Note that this code isn't particularly
 * readable; the non-inline version (in tclInterp.c) is much easier to







|







4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
 *----------------------------------------------------------------
 * Inline version of TclCleanupCommand; still need the function as it is in
 * the internal stubs, but the core can use the macro instead.
 */

#define TclCleanupCommandMacro(cmdPtr) \
    if ((cmdPtr)->refCount-- <= 1) { \
	Tcl_Free(cmdPtr);\
    }

/*
 *----------------------------------------------------------------
 * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number
 * of calls out of the critical path. Note that this code isn't particularly
 * readable; the non-inline version (in tclInterp.c) is much easier to
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815

#ifndef TCL_MEM_DEBUG
#define TclSmallAllocEx(interp, nbytes, memPtr) \
    do {								\
	Tcl_Obj *_objPtr;						\
	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
	TclIncrObjsAllocated();						\
	TclAllocObjStorageEx((interp), (_objPtr));			\
	memPtr = (ClientData) (_objPtr);					\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr));		\
	TclIncrObjsFreed();						\
    } while (0)

#else    /* TCL_MEM_DEBUG */
#define TclSmallAllocEx(interp, nbytes, memPtr) \
    do {								\
	Tcl_Obj *_objPtr;						\
	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
	TclNewObj(_objPtr);						\
	memPtr = (ClientData) _objPtr;					\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	Tcl_Obj *_objPtr = (Tcl_Obj *) memPtr;				\
	_objPtr->bytes = NULL;						\
	_objPtr->typePtr = NULL;					\







|
|




|









|







4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873

#ifndef TCL_MEM_DEBUG
#define TclSmallAllocEx(interp, nbytes, memPtr) \
    do {								\
	Tcl_Obj *_objPtr;						\
	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
	TclIncrObjsAllocated();						\
	TclAllocObjStorageEx((interp), _objPtr);			\
	memPtr = (void *)_objPtr;					\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	TclFreeObjStorageEx((interp), (Tcl_Obj *)memPtr);		\
	TclIncrObjsFreed();						\
    } while (0)

#else    /* TCL_MEM_DEBUG */
#define TclSmallAllocEx(interp, nbytes, memPtr) \
    do {								\
	Tcl_Obj *_objPtr;						\
	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
	TclNewObj(_objPtr);						\
	memPtr = (void *)_objPtr;					\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	Tcl_Obj *_objPtr = (Tcl_Obj *) memPtr;				\
	_objPtr->bytes = NULL;						\
	_objPtr->typePtr = NULL;					\
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
 * This is the main data struct for representing NR commands. It is designed
 * to fit in sizeof(Tcl_Obj) in order to exploit the fastest memory allocator
 * available.
 */

typedef struct NRE_callback {
    Tcl_NRPostProc *procPtr;
    ClientData data[4];
    struct NRE_callback *nextPtr;
} NRE_callback;

#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)

/*
 * Inline version of Tcl_NRAddCallback.
 */

#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \
    do {								\
	NRE_callback *_callbackPtr;					\
	TCLNR_ALLOC((interp), (_callbackPtr));				\
	_callbackPtr->procPtr = (postProcPtr);				\
	_callbackPtr->data[0] = (ClientData)(data0);			\
	_callbackPtr->data[1] = (ClientData)(data1);			\
	_callbackPtr->data[2] = (ClientData)(data2);			\
	_callbackPtr->data[3] = (ClientData)(data3);			\
	_callbackPtr->nextPtr = TOP_CB(interp);				\
	TOP_CB(interp) = _callbackPtr;					\
    } while (0)

#if NRE_USE_SMALL_ALLOC
#define TCLNR_ALLOC(interp, ptr) \
    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
    (ptr = ((ClientData) ckalloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr)  ckfree(ptr)
#endif

#if NRE_ENABLE_ASSERTS
#define NRE_ASSERT(expr) assert((expr))
#else
#define NRE_ASSERT(expr)
#endif

#include "tclIntDecls.h"
#include "tclIntPlatDecls.h"
#include "tclTomMathDecls.h"

#if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG)
#define Tcl_AttemptAlloc(size)        TclpAlloc(size)
#define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size))
#define Tcl_Free(ptr)                 TclpFree(ptr)
#endif

#endif /* _TCLINT */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|














|
|
|
|










|
|













|
|
|











4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
 * This is the main data struct for representing NR commands. It is designed
 * to fit in sizeof(Tcl_Obj) in order to exploit the fastest memory allocator
 * available.
 */

typedef struct NRE_callback {
    Tcl_NRPostProc *procPtr;
    void *data[4];
    struct NRE_callback *nextPtr;
} NRE_callback;

#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)

/*
 * Inline version of Tcl_NRAddCallback.
 */

#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \
    do {								\
	NRE_callback *_callbackPtr;					\
	TCLNR_ALLOC((interp), (_callbackPtr));				\
	_callbackPtr->procPtr = (postProcPtr);				\
	_callbackPtr->data[0] = (void *)(data0);			\
	_callbackPtr->data[1] = (void *)(data1);			\
	_callbackPtr->data[2] = (void *)(data2);			\
	_callbackPtr->data[3] = (void *)(data3);			\
	_callbackPtr->nextPtr = TOP_CB(interp);				\
	TOP_CB(interp) = _callbackPtr;					\
    } while (0)

#if NRE_USE_SMALL_ALLOC
#define TCLNR_ALLOC(interp, ptr) \
    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
    (ptr = (Tcl_Alloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr)  Tcl_Free(ptr)
#endif

#if NRE_ENABLE_ASSERTS
#define NRE_ASSERT(expr) assert((expr))
#else
#define NRE_ASSERT(expr)
#endif

#include "tclIntDecls.h"
#include "tclIntPlatDecls.h"
#include "tclTomMathDecls.h"

#if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG)
#define Tcl_AttemptAlloc        TclpAlloc
#define Tcl_AttemptRealloc      TclpRealloc
#define Tcl_Free                TclpFree
#endif

#endif /* _TCLINT */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclIntDecls.h.
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
/* Slot 4 is reserved */
/* 5 */
TCLAPI int		TclCleanupChildren(Tcl_Interp *interp, int numPids,
				Tcl_Pid *pidPtr, Tcl_Channel errorChan);
/* 6 */
TCLAPI void		TclCleanupCommand(Command *cmdPtr);
/* 7 */
TCLAPI int		TclCopyAndCollapse(int count, const char *src,
				char *dst);
/* Slot 8 is reserved */
/* 9 */
TCLAPI int		TclCreatePipeline(Tcl_Interp *interp, int argc,
				const char **argv, Tcl_Pid **pidArrayPtr,
				TclFile *inPipePtr, TclFile *outPipePtr,
				TclFile *errFilePtr);
/* 10 */
TCLAPI int		TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
				const char *procName, Tcl_Obj *argsPtr,
				Tcl_Obj *bodyPtr, Proc **procPtrPtr);
/* 11 */
TCLAPI void		TclDeleteCompiledLocalVars(Interp *iPtr,
				CallFrame *framePtr);
/* 12 */
TCLAPI void		TclDeleteVars(Interp *iPtr,
				TclVarHashTable *tablePtr);
/* Slot 13 is reserved */
/* 14 */
TCLAPI int		TclDumpMemoryInfo(ClientData clientData, int flags);
/* Slot 15 is reserved */
/* 16 */
TCLAPI void		TclExprFloatError(Tcl_Interp *interp, double value);
/* Slot 17 is reserved */
/* Slot 18 is reserved */
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* 22 */
TCLAPI int		TclFindElement(Tcl_Interp *interp,
				const char *listStr, int listLength,
				const char **elementPtr,
				const char **nextPtr, int *sizePtr,
				int *bracePtr);
/* 23 */
TCLAPI Proc *		TclFindProc(Interp *iPtr, const char *procName);
/* 24 */
TCLAPI int		TclFormatInt(char *buffer, Tcl_WideInt n);
/* 25 */
TCLAPI void		TclFreePackageInfo(Interp *iPtr);
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* 28 */
TCLAPI Tcl_Channel	TclpGetDefaultStdChannel(int type);
/* Slot 29 is reserved */







|



















|












|




|







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
/* Slot 4 is reserved */
/* 5 */
TCLAPI int		TclCleanupChildren(Tcl_Interp *interp, int numPids,
				Tcl_Pid *pidPtr, Tcl_Channel errorChan);
/* 6 */
TCLAPI void		TclCleanupCommand(Command *cmdPtr);
/* 7 */
TCLAPI size_t		TclCopyAndCollapse(size_t count, const char *src,
				char *dst);
/* Slot 8 is reserved */
/* 9 */
TCLAPI int		TclCreatePipeline(Tcl_Interp *interp, int argc,
				const char **argv, Tcl_Pid **pidArrayPtr,
				TclFile *inPipePtr, TclFile *outPipePtr,
				TclFile *errFilePtr);
/* 10 */
TCLAPI int		TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
				const char *procName, Tcl_Obj *argsPtr,
				Tcl_Obj *bodyPtr, Proc **procPtrPtr);
/* 11 */
TCLAPI void		TclDeleteCompiledLocalVars(Interp *iPtr,
				CallFrame *framePtr);
/* 12 */
TCLAPI void		TclDeleteVars(Interp *iPtr,
				TclVarHashTable *tablePtr);
/* Slot 13 is reserved */
/* 14 */
TCLAPI int		TclDumpMemoryInfo(void *clientData, int flags);
/* Slot 15 is reserved */
/* 16 */
TCLAPI void		TclExprFloatError(Tcl_Interp *interp, double value);
/* Slot 17 is reserved */
/* Slot 18 is reserved */
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* 22 */
TCLAPI int		TclFindElement(Tcl_Interp *interp,
				const char *listStr, int listLength,
				const char **elementPtr,
				const char **nextPtr, size_t *sizePtr,
				int *bracePtr);
/* 23 */
TCLAPI Proc *		TclFindProc(Interp *iPtr, const char *procName);
/* 24 */
TCLAPI size_t		TclFormatInt(char *buffer, Tcl_WideInt n);
/* 25 */
TCLAPI void		TclFreePackageInfo(Interp *iPtr);
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* 28 */
TCLAPI Tcl_Channel	TclpGetDefaultStdChannel(int type);
/* Slot 29 is reserved */
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
/* 50 */
TCLAPI void		TclInitCompiledLocals(Tcl_Interp *interp,
				CallFrame *framePtr, Namespace *nsPtr);
/* 51 */
TCLAPI int		TclInterpInit(Tcl_Interp *interp);
/* Slot 52 is reserved */
/* 53 */
TCLAPI int		TclInvokeObjectCommand(ClientData clientData,
				Tcl_Interp *interp, int argc,
				const char **argv);
/* 54 */
TCLAPI int		TclInvokeStringCommand(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 55 */
TCLAPI Proc *		TclIsProc(Command *cmdPtr);
/* Slot 56 is reserved */
/* Slot 57 is reserved */
/* 58 */
TCLAPI Var *		TclLookupVar(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags,
				const char *msg, int createPart1,
				int createPart2, Var **arrayPtrPtr);
/* Slot 59 is reserved */
/* 60 */
TCLAPI int		TclNeedSpace(const char *start, const char *end);
/* 61 */
TCLAPI Tcl_Obj *	TclNewProcBodyObj(Proc *procPtr);
/* 62 */
TCLAPI int		TclObjCommandComplete(Tcl_Obj *cmdPtr);
/* 63 */
TCLAPI int		TclObjInterpProc(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 64 */
TCLAPI int		TclObjInvoke(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* Slot 65 is reserved */
/* Slot 66 is reserved */
/* Slot 67 is reserved */
/* Slot 68 is reserved */
/* 69 */
TCLAPI char *		TclpAlloc(unsigned int size);
/* Slot 70 is reserved */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
/* 74 */
TCLAPI void		TclpFree(char *ptr);
/* 75 */
TCLAPI unsigned long	TclpGetClicks(void);
/* 76 */
TCLAPI unsigned long	TclpGetSeconds(void);
/* Slot 77 is reserved */
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
/* 81 */
TCLAPI char *		TclpRealloc(char *ptr, unsigned int size);
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* Slot 88 is reserved */
/* 89 */
TCLAPI int		TclPreventAliasLoop(Tcl_Interp *interp,
				Tcl_Interp *cmdInterp, Tcl_Command cmd);
/* Slot 90 is reserved */
/* 91 */
TCLAPI void		TclProcCleanupProc(Proc *procPtr);
/* 92 */
TCLAPI int		TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
				Tcl_Obj *bodyPtr, Namespace *nsPtr,
				const char *description,
				const char *procName);
/* 93 */
TCLAPI void		TclProcDeleteProc(ClientData clientData);
/* Slot 94 is reserved */
/* Slot 95 is reserved */
/* 96 */
TCLAPI int		TclRenameCommand(Tcl_Interp *interp,
				const char *oldName, const char *newName);
/* 97 */
TCLAPI void		TclResetShadowedCmdRefs(Tcl_Interp *interp,







|



|



















|










|





|

|

|





|



















|







137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
/* 50 */
TCLAPI void		TclInitCompiledLocals(Tcl_Interp *interp,
				CallFrame *framePtr, Namespace *nsPtr);
/* 51 */
TCLAPI int		TclInterpInit(Tcl_Interp *interp);
/* Slot 52 is reserved */
/* 53 */
TCLAPI int		TclInvokeObjectCommand(void *clientData,
				Tcl_Interp *interp, int argc,
				const char **argv);
/* 54 */
TCLAPI int		TclInvokeStringCommand(void *clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 55 */
TCLAPI Proc *		TclIsProc(Command *cmdPtr);
/* Slot 56 is reserved */
/* Slot 57 is reserved */
/* 58 */
TCLAPI Var *		TclLookupVar(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags,
				const char *msg, int createPart1,
				int createPart2, Var **arrayPtrPtr);
/* Slot 59 is reserved */
/* 60 */
TCLAPI int		TclNeedSpace(const char *start, const char *end);
/* 61 */
TCLAPI Tcl_Obj *	TclNewProcBodyObj(Proc *procPtr);
/* 62 */
TCLAPI int		TclObjCommandComplete(Tcl_Obj *cmdPtr);
/* 63 */
TCLAPI int		TclObjInterpProc(void *clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 64 */
TCLAPI int		TclObjInvoke(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* Slot 65 is reserved */
/* Slot 66 is reserved */
/* Slot 67 is reserved */
/* Slot 68 is reserved */
/* 69 */
TCLAPI void *		TclpAlloc(size_t size);
/* Slot 70 is reserved */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
/* 74 */
TCLAPI void		TclpFree(void *ptr);
/* 75 */
TCLAPI Tcl_WideUInt	TclpGetClicks(void);
/* 76 */
TCLAPI Tcl_WideUInt	TclpGetSeconds(void);
/* Slot 77 is reserved */
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
/* 81 */
TCLAPI void *		TclpRealloc(void *ptr, size_t size);
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* Slot 88 is reserved */
/* 89 */
TCLAPI int		TclPreventAliasLoop(Tcl_Interp *interp,
				Tcl_Interp *cmdInterp, Tcl_Command cmd);
/* Slot 90 is reserved */
/* 91 */
TCLAPI void		TclProcCleanupProc(Proc *procPtr);
/* 92 */
TCLAPI int		TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
				Tcl_Obj *bodyPtr, Namespace *nsPtr,
				const char *description,
				const char *procName);
/* 93 */
TCLAPI void		TclProcDeleteProc(void *clientData);
/* Slot 94 is reserved */
/* Slot 95 is reserved */
/* 96 */
TCLAPI int		TclRenameCommand(Tcl_Interp *interp,
				const char *oldName, const char *newName);
/* 97 */
TCLAPI void		TclResetShadowedCmdRefs(Tcl_Interp *interp,
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
/* Slot 139 is reserved */
/* Slot 140 is reserved */
/* 141 */
TCLAPI const char *	TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 142 */
TCLAPI int		TclSetByteCodeFromAny(Tcl_Interp *interp,
				Tcl_Obj *objPtr, CompileHookProc *hookProc,
				ClientData clientData);
/* 143 */
TCLAPI int		TclAddLiteralObj(struct CompileEnv *envPtr,
				Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
/* 144 */
TCLAPI void		TclHideLiteral(Tcl_Interp *interp,
				struct CompileEnv *envPtr, int index);
/* 145 */
TCLAPI const struct AuxDataType * TclGetAuxDataType(const char *typeName);
/* 146 */
TCLAPI TclHandle	TclHandleCreate(void *ptr);
/* 147 */
TCLAPI void		TclHandleFree(TclHandle handle);
/* 148 */
TCLAPI TclHandle	TclHandlePreserve(TclHandle handle);
/* 149 */
TCLAPI void		TclHandleRelease(TclHandle handle);
/* 150 */
TCLAPI int		TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
/* 151 */
TCLAPI void		TclRegExpRangeUniChar(Tcl_RegExp re, int index,
				int *startPtr, int *endPtr);
/* 152 */
TCLAPI void		TclSetLibraryPath(Tcl_Obj *pathPtr);
/* 153 */
TCLAPI Tcl_Obj *	TclGetLibraryPath(void);
/* Slot 154 is reserved */
/* Slot 155 is reserved */
/* 156 */
TCLAPI void		TclRegError(Tcl_Interp *interp, const char *msg,
				int status);
/* 157 */
TCLAPI Var *		TclVarTraceExists(Tcl_Interp *interp,
				const char *varName);
/* Slot 158 is reserved */
/* Slot 159 is reserved */
/* Slot 160 is reserved */
/* 161 */
TCLAPI int		TclChannelTransform(Tcl_Interp *interp,
				Tcl_Channel chan, Tcl_Obj *cmdObjPtr);
/* 162 */
TCLAPI void		TclChannelEventScriptInvoker(ClientData clientData,
				int flags);
/* 163 */
TCLAPI const void *	TclGetInstructionTable(void);
/* 164 */
TCLAPI void		TclExpandCodeArray(void *envPtr);
/* 165 */
TCLAPI void		TclpSetInitialEncodings(void);
/* 166 */
TCLAPI int		TclListObjSetElement(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int index,
				Tcl_Obj *valuePtr);
/* Slot 167 is reserved */
/* Slot 168 is reserved */
/* 169 */
TCLAPI int		TclpUtfNcmp2(const char *s1, const char *s2,
				unsigned long n);
/* 170 */
TCLAPI int		TclCheckInterpTraces(Tcl_Interp *interp,
				const char *command, int numChars,
				Command *cmdPtr, int result, int traceFlags,
				int objc, Tcl_Obj *const objv[]);
/* 171 */
TCLAPI int		TclCheckExecutionTraces(Tcl_Interp *interp,
				const char *command, int numChars,
				Command *cmdPtr, int result, int traceFlags,
				int objc, Tcl_Obj *const objv[]);
/* 172 */
TCLAPI int		TclInThreadExit(void);
/* 173 */
TCLAPI int		TclUniCharMatch(const Tcl_UniChar *string,
				int strLen, const Tcl_UniChar *pattern,
				int ptnLen, int flags);
/* Slot 174 is reserved */
/* 175 */
TCLAPI int		TclCallVarTraces(Interp *iPtr, Var *arrayPtr,
				Var *varPtr, const char *part1,
				const char *part2, int flags,
				int leaveErrMsg);
/* 176 */







|



















|




















|















|


|




|






|
|







301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
/* Slot 139 is reserved */
/* Slot 140 is reserved */
/* 141 */
TCLAPI const char *	TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 142 */
TCLAPI int		TclSetByteCodeFromAny(Tcl_Interp *interp,
				Tcl_Obj *objPtr, CompileHookProc *hookProc,
				void *clientData);
/* 143 */
TCLAPI int		TclAddLiteralObj(struct CompileEnv *envPtr,
				Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
/* 144 */
TCLAPI void		TclHideLiteral(Tcl_Interp *interp,
				struct CompileEnv *envPtr, int index);
/* 145 */
TCLAPI const struct AuxDataType * TclGetAuxDataType(const char *typeName);
/* 146 */
TCLAPI TclHandle	TclHandleCreate(void *ptr);
/* 147 */
TCLAPI void		TclHandleFree(TclHandle handle);
/* 148 */
TCLAPI TclHandle	TclHandlePreserve(TclHandle handle);
/* 149 */
TCLAPI void		TclHandleRelease(TclHandle handle);
/* 150 */
TCLAPI int		TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
/* 151 */
TCLAPI void		TclRegExpRangeUniChar(Tcl_RegExp re, size_t index,
				int *startPtr, int *endPtr);
/* 152 */
TCLAPI void		TclSetLibraryPath(Tcl_Obj *pathPtr);
/* 153 */
TCLAPI Tcl_Obj *	TclGetLibraryPath(void);
/* Slot 154 is reserved */
/* Slot 155 is reserved */
/* 156 */
TCLAPI void		TclRegError(Tcl_Interp *interp, const char *msg,
				int status);
/* 157 */
TCLAPI Var *		TclVarTraceExists(Tcl_Interp *interp,
				const char *varName);
/* Slot 158 is reserved */
/* Slot 159 is reserved */
/* Slot 160 is reserved */
/* 161 */
TCLAPI int		TclChannelTransform(Tcl_Interp *interp,
				Tcl_Channel chan, Tcl_Obj *cmdObjPtr);
/* 162 */
TCLAPI void		TclChannelEventScriptInvoker(void *clientData,
				int flags);
/* 163 */
TCLAPI const void *	TclGetInstructionTable(void);
/* 164 */
TCLAPI void		TclExpandCodeArray(void *envPtr);
/* 165 */
TCLAPI void		TclpSetInitialEncodings(void);
/* 166 */
TCLAPI int		TclListObjSetElement(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int index,
				Tcl_Obj *valuePtr);
/* Slot 167 is reserved */
/* Slot 168 is reserved */
/* 169 */
TCLAPI int		TclpUtfNcmp2(const char *s1, const char *s2,
				size_t n);
/* 170 */
TCLAPI int		TclCheckInterpTraces(Tcl_Interp *interp,
				const char *command, size_t numChars,
				Command *cmdPtr, int result, int traceFlags,
				int objc, Tcl_Obj *const objv[]);
/* 171 */
TCLAPI int		TclCheckExecutionTraces(Tcl_Interp *interp,
				const char *command, size_t numChars,
				Command *cmdPtr, int result, int traceFlags,
				int objc, Tcl_Obj *const objv[]);
/* 172 */
TCLAPI int		TclInThreadExit(void);
/* 173 */
TCLAPI int		TclUniCharMatch(const Tcl_UniChar *string,
				size_t strLen, const Tcl_UniChar *pattern,
				size_t ptnLen, int flags);
/* Slot 174 is reserved */
/* 175 */
TCLAPI int		TclCallVarTraces(Interp *iPtr, Var *arrayPtr,
				Var *varPtr, const char *part1,
				const char *part2, int flags,
				int leaveErrMsg);
/* 176 */
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
TCLAPI void		TclpFindExecutable(const char *argv0);
/* 213 */
TCLAPI Tcl_Obj *	TclGetObjNameOfExecutable(void);
/* 214 */
TCLAPI void		TclSetObjNameOfExecutable(Tcl_Obj *name,
				Tcl_Encoding encoding);
/* 215 */
TCLAPI void *		TclStackAlloc(Tcl_Interp *interp, int numBytes);
/* 216 */
TCLAPI void		TclStackFree(Tcl_Interp *interp, void *freePtr);
/* 217 */
TCLAPI int		TclPushStackFrame(Tcl_Interp *interp,
				Tcl_CallFrame **framePtrPtr,
				Tcl_Namespace *namespacePtr,
				int isProcCallFrame);







|







445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
TCLAPI void		TclpFindExecutable(const char *argv0);
/* 213 */
TCLAPI Tcl_Obj *	TclGetObjNameOfExecutable(void);
/* 214 */
TCLAPI void		TclSetObjNameOfExecutable(Tcl_Obj *name,
				Tcl_Encoding encoding);
/* 215 */
TCLAPI void *		TclStackAlloc(Tcl_Interp *interp, size_t numBytes);
/* 216 */
TCLAPI void		TclStackFree(Tcl_Interp *interp, void *freePtr);
/* 217 */
TCLAPI int		TclPushStackFrame(Tcl_Interp *interp,
				Tcl_CallFrame **framePtrPtr,
				Tcl_Namespace *namespacePtr,
				int isProcCallFrame);
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
/* 225 */
TCLAPI Tcl_Obj *	TclTraceDictPath(Tcl_Interp *interp,
				Tcl_Obj *rootPtr, int keyc,
				Tcl_Obj *const keyv[], int flags);
/* 226 */
TCLAPI int		TclObjBeingDeleted(Tcl_Obj *objPtr);
/* 227 */
TCLAPI void		TclSetNsPath(Namespace *nsPtr, int pathLength,
				Tcl_Namespace *pathAry[]);
/* Slot 228 is reserved */
/* 229 */
TCLAPI int		TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
				const char *myName, int myFlags, int index);
/* 230 */
TCLAPI Var *		TclObjLookupVar(Tcl_Interp *interp,







|







469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
/* 225 */
TCLAPI Tcl_Obj *	TclTraceDictPath(Tcl_Interp *interp,
				Tcl_Obj *rootPtr, int keyc,
				Tcl_Obj *const keyv[], int flags);
/* 226 */
TCLAPI int		TclObjBeingDeleted(Tcl_Obj *objPtr);
/* 227 */
TCLAPI void		TclSetNsPath(Namespace *nsPtr, size_t pathLength,
				Tcl_Namespace *pathAry[]);
/* Slot 228 is reserved */
/* 229 */
TCLAPI int		TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
				const char *myName, int myFlags, int index);
/* 230 */
TCLAPI Var *		TclObjLookupVar(Tcl_Interp *interp,
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
/* 235 */
TCLAPI void		TclInitVarHashTable(TclVarHashTable *tablePtr,
				Namespace *nsPtr);
/* Slot 236 is reserved */
/* 237 */
TCLAPI int		TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
TCLAPI int		TclNRInterpProc(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 239 */
TCLAPI int		TclNRInterpProcCore(Tcl_Interp *interp,
				Tcl_Obj *procNameObj, int skip,
				ProcErrorProc *errorProc);
/* 240 */
TCLAPI int		TclNRRunCallbacks(Tcl_Interp *interp, int result,
				struct NRE_callback *rootPtr);







|
<
|







499
500
501
502
503
504
505
506

507
508
509
510
511
512
513
514
/* 235 */
TCLAPI void		TclInitVarHashTable(TclVarHashTable *tablePtr,
				Namespace *nsPtr);
/* Slot 236 is reserved */
/* 237 */
TCLAPI int		TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
TCLAPI int		TclNRInterpProc(void *clientData, Tcl_Interp *interp,

				int objc, Tcl_Obj *const objv[]);
/* 239 */
TCLAPI int		TclNRInterpProcCore(Tcl_Interp *interp,
				Tcl_Obj *procNameObj, int skip,
				ProcErrorProc *errorProc);
/* 240 */
TCLAPI int		TclNRRunCallbacks(Tcl_Interp *interp, int result,
				struct NRE_callback *rootPtr);
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
TCLAPI void		TclDbDumpActiveObjects(FILE *outFile);
/* 244 */
TCLAPI Tcl_HashTable *	TclGetNamespaceChildTable(Tcl_Namespace *nsPtr);
/* 245 */
TCLAPI Tcl_HashTable *	TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr);
/* 246 */
TCLAPI int		TclInitRewriteEnsemble(Tcl_Interp *interp,
				int numRemoved, int numInserted,
				Tcl_Obj *const *objv);
/* 247 */
TCLAPI void		TclResetRewriteEnsemble(Tcl_Interp *interp,
				int isRootEnsemble);
/* 248 */
TCLAPI int		TclCopyChannel(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
/* 249 */
TCLAPI char *		TclDoubleDigits(double dv, int ndigits, int flags,
				int *decpt, int *signum, char **endPtr);
/* 250 */
TCLAPI void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
				int force);
/* 251 */
TCLAPI int		TclRegisterLiteral(void *envPtr, const char *bytes,
				int length, int flags);
/* 252 */
TCLAPI Tcl_Obj *	TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, const int flags);
/* 253 */
TCLAPI Tcl_Obj *	TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,







|
















|







523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
TCLAPI void		TclDbDumpActiveObjects(FILE *outFile);
/* 244 */
TCLAPI Tcl_HashTable *	TclGetNamespaceChildTable(Tcl_Namespace *nsPtr);
/* 245 */
TCLAPI Tcl_HashTable *	TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr);
/* 246 */
TCLAPI int		TclInitRewriteEnsemble(Tcl_Interp *interp,
				size_t numRemoved, size_t numInserted,
				Tcl_Obj *const *objv);
/* 247 */
TCLAPI void		TclResetRewriteEnsemble(Tcl_Interp *interp,
				int isRootEnsemble);
/* 248 */
TCLAPI int		TclCopyChannel(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
/* 249 */
TCLAPI char *		TclDoubleDigits(double dv, int ndigits, int flags,
				int *decpt, int *signum, char **endPtr);
/* 250 */
TCLAPI void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
				int force);
/* 251 */
TCLAPI int		TclRegisterLiteral(void *envPtr, const char *bytes,
				size_t length, int flags);
/* 252 */
TCLAPI Tcl_Obj *	TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, const int flags);
/* 253 */
TCLAPI Tcl_Obj *	TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
    void (*reserved0)(void);
    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*tclAllocateFreeObjects) (void); /* 3 */
    void (*reserved4)(void);
    int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
    void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
    int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
    void (*reserved8)(void);
    int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
    int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
    void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
    void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */
    void (*reserved13)(void);
    int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */
    void (*reserved15)(void);
    void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */
    void (*reserved17)(void);
    void (*reserved18)(void);
    void (*reserved19)(void);
    void (*reserved20)(void);
    void (*reserved21)(void);
    int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */
    Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */
    int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */
    void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
    void (*reserved26)(void);
    void (*reserved27)(void);
    Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */
    void (*reserved29)(void);
    void (*reserved30)(void);
    const char * (*tclGetExtension) (const char *name); /* 31 */







|






|







|

|







575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
    void (*reserved0)(void);
    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*tclAllocateFreeObjects) (void); /* 3 */
    void (*reserved4)(void);
    int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
    void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
    size_t (*tclCopyAndCollapse) (size_t count, const char *src, char *dst); /* 7 */
    void (*reserved8)(void);
    int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
    int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
    void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
    void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */
    void (*reserved13)(void);
    int (*tclDumpMemoryInfo) (void *clientData, int flags); /* 14 */
    void (*reserved15)(void);
    void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */
    void (*reserved17)(void);
    void (*reserved18)(void);
    void (*reserved19)(void);
    void (*reserved20)(void);
    void (*reserved21)(void);
    int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, size_t *sizePtr, int *bracePtr); /* 22 */
    Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */
    size_t (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */
    void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
    void (*reserved26)(void);
    void (*reserved27)(void);
    Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */
    void (*reserved29)(void);
    void (*reserved30)(void);
    const char * (*tclGetExtension) (const char *name); /* 31 */
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
    int (*tclInExit) (void); /* 46 */
    void (*reserved47)(void);
    void (*reserved48)(void);
    void (*reserved49)(void);
    void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
    int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
    void (*reserved52)(void);
    int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */
    int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */
    Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
    void (*reserved56)(void);
    void (*reserved57)(void);
    Var * (*tclLookupVar) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 58 */
    void (*reserved59)(void);
    int (*tclNeedSpace) (const char *start, const char *end); /* 60 */
    Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */
    int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */
    int (*tclObjInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */
    int (*tclObjInvoke) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 64 */
    void (*reserved65)(void);
    void (*reserved66)(void);
    void (*reserved67)(void);
    void (*reserved68)(void);
    char * (*tclpAlloc) (unsigned int size); /* 69 */
    void (*reserved70)(void);
    void (*reserved71)(void);
    void (*reserved72)(void);
    void (*reserved73)(void);
    void (*tclpFree) (char *ptr); /* 74 */
    unsigned long (*tclpGetClicks) (void); /* 75 */
    unsigned long (*tclpGetSeconds) (void); /* 76 */
    void (*reserved77)(void);
    void (*reserved78)(void);
    void (*reserved79)(void);
    void (*reserved80)(void);
    char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
    void (*reserved82)(void);
    void (*reserved83)(void);
    void (*reserved84)(void);
    void (*reserved85)(void);
    void (*reserved86)(void);
    void (*reserved87)(void);
    void (*reserved88)(void);
    int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
    void (*reserved90)(void);
    void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
    int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 92 */
    void (*tclProcDeleteProc) (ClientData clientData); /* 93 */
    void (*reserved94)(void);
    void (*reserved95)(void);
    int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */
    void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
    int (*tclServiceIdle) (void); /* 98 */
    void (*reserved99)(void);
    void (*reserved100)(void);







|
|








|





|




|
|
|




|











|







621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
    int (*tclInExit) (void); /* 46 */
    void (*reserved47)(void);
    void (*reserved48)(void);
    void (*reserved49)(void);
    void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
    int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
    void (*reserved52)(void);
    int (*tclInvokeObjectCommand) (void *clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */
    int (*tclInvokeStringCommand) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */
    Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
    void (*reserved56)(void);
    void (*reserved57)(void);
    Var * (*tclLookupVar) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 58 */
    void (*reserved59)(void);
    int (*tclNeedSpace) (const char *start, const char *end); /* 60 */
    Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */
    int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */
    int (*tclObjInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */
    int (*tclObjInvoke) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 64 */
    void (*reserved65)(void);
    void (*reserved66)(void);
    void (*reserved67)(void);
    void (*reserved68)(void);
    void * (*tclpAlloc) (size_t size); /* 69 */
    void (*reserved70)(void);
    void (*reserved71)(void);
    void (*reserved72)(void);
    void (*reserved73)(void);
    void (*tclpFree) (void *ptr); /* 74 */
    Tcl_WideUInt (*tclpGetClicks) (void); /* 75 */
    Tcl_WideUInt (*tclpGetSeconds) (void); /* 76 */
    void (*reserved77)(void);
    void (*reserved78)(void);
    void (*reserved79)(void);
    void (*reserved80)(void);
    void * (*tclpRealloc) (void *ptr, size_t size); /* 81 */
    void (*reserved82)(void);
    void (*reserved83)(void);
    void (*reserved84)(void);
    void (*reserved85)(void);
    void (*reserved86)(void);
    void (*reserved87)(void);
    void (*reserved88)(void);
    int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
    void (*reserved90)(void);
    void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
    int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 92 */
    void (*tclProcDeleteProc) (void *clientData); /* 93 */
    void (*reserved94)(void);
    void (*reserved95)(void);
    int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */
    void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
    int (*tclServiceIdle) (void); /* 98 */
    void (*reserved99)(void);
    void (*reserved100)(void);
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
    void (*reserved135)(void);
    void (*reserved136)(void);
    void (*reserved137)(void);
    const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
    void (*reserved139)(void);
    void (*reserved140)(void);
    const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
    int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */
    int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
    void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
    const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */
    TclHandle (*tclHandleCreate) (void *ptr); /* 146 */
    void (*tclHandleFree) (TclHandle handle); /* 147 */
    TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */
    void (*tclHandleRelease) (TclHandle handle); /* 149 */
    int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */
    void (*tclRegExpRangeUniChar) (Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 151 */
    void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */
    Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */
    void (*reserved154)(void);
    void (*reserved155)(void);
    void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
    Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
    void (*reserved158)(void);
    void (*reserved159)(void);
    void (*reserved160)(void);
    int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
    void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
    const void * (*tclGetInstructionTable) (void); /* 163 */
    void (*tclExpandCodeArray) (void *envPtr); /* 164 */
    void (*tclpSetInitialEncodings) (void); /* 165 */
    int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
    void (*reserved167)(void);
    void (*reserved168)(void);
    int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */
    int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
    int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
    int (*tclInThreadExit) (void); /* 172 */
    int (*tclUniCharMatch) (const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags); /* 173 */
    void (*reserved174)(void);
    int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
    void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
    void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
    void (*reserved178)(void);
    void (*reserved179)(void);
    void (*reserved180)(void);







|








|










|






|
|
|

|







710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
    void (*reserved135)(void);
    void (*reserved136)(void);
    void (*reserved137)(void);
    const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
    void (*reserved139)(void);
    void (*reserved140)(void);
    const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
    int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData); /* 142 */
    int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
    void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
    const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */
    TclHandle (*tclHandleCreate) (void *ptr); /* 146 */
    void (*tclHandleFree) (TclHandle handle); /* 147 */
    TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */
    void (*tclHandleRelease) (TclHandle handle); /* 149 */
    int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */
    void (*tclRegExpRangeUniChar) (Tcl_RegExp re, size_t index, int *startPtr, int *endPtr); /* 151 */
    void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */
    Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */
    void (*reserved154)(void);
    void (*reserved155)(void);
    void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
    Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
    void (*reserved158)(void);
    void (*reserved159)(void);
    void (*reserved160)(void);
    int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
    void (*tclChannelEventScriptInvoker) (void *clientData, int flags); /* 162 */
    const void * (*tclGetInstructionTable) (void); /* 163 */
    void (*tclExpandCodeArray) (void *envPtr); /* 164 */
    void (*tclpSetInitialEncodings) (void); /* 165 */
    int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
    void (*reserved167)(void);
    void (*reserved168)(void);
    int (*tclpUtfNcmp2) (const char *s1, const char *s2, size_t n); /* 169 */
    int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
    int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
    int (*tclInThreadExit) (void); /* 172 */
    int (*tclUniCharMatch) (const Tcl_UniChar *string, size_t strLen, const Tcl_UniChar *pattern, size_t ptnLen, int flags); /* 173 */
    void (*reserved174)(void);
    int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
    void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
    void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
    void (*reserved178)(void);
    void (*reserved179)(void);
    void (*reserved180)(void);
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
    Tcl_Channel (*tclpOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* 208 */
    void (*reserved209)(void);
    void (*reserved210)(void);
    void (*reserved211)(void);
    void (*tclpFindExecutable) (const char *argv0); /* 212 */
    Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
    void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
    void * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */
    void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */
    int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
    void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
    void (*reserved219)(void);
    void (*reserved220)(void);
    void (*reserved221)(void);
    void (*reserved222)(void);
    void (*reserved223)(void);
    TclPlatformType * (*tclGetPlatform) (void); /* 224 */
    Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 225 */
    int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */
    void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */
    void (*reserved228)(void);
    int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */
    Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */
    int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
    int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
    void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
    Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
    void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
    void (*reserved236)(void);
    int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
    int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
    int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
    int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
    int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
    int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
    void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
    void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
    int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */
    Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
    Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
    Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
    int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
    int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
} TclIntStubs;








|











|










|







|




|







783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
    Tcl_Channel (*tclpOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* 208 */
    void (*reserved209)(void);
    void (*reserved210)(void);
    void (*reserved211)(void);
    void (*tclpFindExecutable) (const char *argv0); /* 212 */
    Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
    void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
    void * (*tclStackAlloc) (Tcl_Interp *interp, size_t numBytes); /* 215 */
    void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */
    int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
    void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
    void (*reserved219)(void);
    void (*reserved220)(void);
    void (*reserved221)(void);
    void (*reserved222)(void);
    void (*reserved223)(void);
    TclPlatformType * (*tclGetPlatform) (void); /* 224 */
    Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 225 */
    int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */
    void (*tclSetNsPath) (Namespace *nsPtr, size_t pathLength, Tcl_Namespace *pathAry[]); /* 227 */
    void (*reserved228)(void);
    int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */
    Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */
    int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
    int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
    void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
    Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
    void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
    void (*reserved236)(void);
    int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
    int (*tclNRInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
    int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
    int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
    int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
    int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
    void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, size_t numRemoved, size_t numInserted, Tcl_Obj *const *objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
    void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
    int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t length, int flags); /* 251 */
    Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
    Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
    Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
    int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
    int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
} TclIntStubs;

Changes to generic/tclIntPlatDecls.h.
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
/* 4 */
TCLAPI HINSTANCE	TclWinGetTclInstance(void);
/* 5 */
TCLAPI int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* Slot 6 is reserved */
/* Slot 7 is reserved */
/* 8 */
TCLAPI int		TclpGetPid(Tcl_Pid pid);
/* Slot 9 is reserved */
/* Slot 10 is reserved */
/* 11 */
TCLAPI void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 12 */
TCLAPI int		TclpCloseFile(TclFile file);







|







93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
/* 4 */
TCLAPI HINSTANCE	TclWinGetTclInstance(void);
/* 5 */
TCLAPI int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* Slot 6 is reserved */
/* Slot 7 is reserved */
/* 8 */
TCLAPI size_t		TclpGetPid(Tcl_Pid pid);
/* Slot 9 is reserved */
/* Slot 10 is reserved */
/* 11 */
TCLAPI void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 12 */
TCLAPI int		TclpCloseFile(TclFile file);
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 18 */
TCLAPI TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
TCLAPI TclFile		TclpOpenFile(const char *fname, int mode);
/* 20 */
TCLAPI void		TclWinAddProcess(HANDLE hProcess, DWORD id);
/* Slot 21 is reserved */
/* 22 */
TCLAPI TclFile		TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
TCLAPI char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */







|







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 18 */
TCLAPI TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
TCLAPI TclFile		TclpOpenFile(const char *fname, int mode);
/* 20 */
TCLAPI void		TclWinAddProcess(HANDLE hProcess, size_t id);
/* Slot 21 is reserved */
/* 22 */
TCLAPI TclFile		TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
TCLAPI char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*reserved3)(void);
    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
    void (*reserved6)(void);
    void (*reserved7)(void);
    int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    void (*reserved9)(void);
    void (*reserved10)(void);
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    int (*tclpIsAtty) (int fd); /* 16 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
    void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*tclWinFlushDirtyChannels) (void); /* 27 */







|











|







259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*reserved3)(void);
    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
    void (*reserved6)(void);
    void (*reserved7)(void);
    size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    void (*reserved9)(void);
    void (*reserved10)(void);
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    int (*tclpIsAtty) (int fd); /* 16 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
    void (*tclWinAddProcess) (HANDLE hProcess, size_t id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
484
485
486
487
488
489
490
491
492
493
494

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if !defined(_WIN32)
#   undef TclpGetPid
#   define TclpGetPid(pid) ((unsigned long) (pid))
#endif

#endif /* _TCLINTPLATDECLS */







|



484
485
486
487
488
489
490
491
492
493
494

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if !defined(_WIN32)
#   undef TclpGetPid
#   define TclpGetPid(pid) ((size_t) (pid))
#endif

#endif /* _TCLINTPLATDECLS */
Changes to generic/tclInterp.c.
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
			    Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,
			    Tcl_Obj *const objv[]);
static int		AliasDelete(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, Tcl_Obj *namePtr);
static int		AliasDescribe(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, Tcl_Obj *objPtr);
static int		AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
static int		AliasObjCmd(ClientData dummy,
			    Tcl_Interp *currentInterp, int objc,
			    Tcl_Obj *const objv[]);
static int		AliasNRCmd(ClientData dummy,
			    Tcl_Interp *currentInterp, int objc,
			    Tcl_Obj *const objv[]);
static void		AliasObjCmdDeleteProc(ClientData clientData);
static Tcl_Interp *	GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static Tcl_Interp *	GetInterp2(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);







<
<
<







218
219
220
221
222
223
224



225
226
227
228
229
230
231
			    Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,
			    Tcl_Obj *const objv[]);
static int		AliasDelete(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, Tcl_Obj *namePtr);
static int		AliasDescribe(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, Tcl_Obj *objPtr);
static int		AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);



static int		AliasNRCmd(ClientData dummy,
			    Tcl_Interp *currentInterp, int objc,
			    Tcl_Obj *const objv[]);
static void		AliasObjCmdDeleteProc(ClientData clientData);
static Tcl_Interp *	GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static Tcl_Interp *	GetInterp2(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
			    Tcl_Interp *slaveInterp);
static int		SlaveInvokeHidden(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp,
			    const char *namespaceName,
			    int objc, Tcl_Obj *const objv[]);
static int		SlaveMarkTrusted(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp);
static int		SlaveObjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static void		SlaveObjCmdDeleteProc(ClientData clientData);
static int		SlaveRecursionLimit(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int objc,
			    Tcl_Obj *const objv[]);
static int		SlaveCommandLimitCmd(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int consumedObjc,
			    int objc, Tcl_Obj *const objv[]);







<
<







250
251
252
253
254
255
256


257
258
259
260
261
262
263
			    Tcl_Interp *slaveInterp);
static int		SlaveInvokeHidden(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp,
			    const char *namespaceName,
			    int objc, Tcl_Obj *const objv[]);
static int		SlaveMarkTrusted(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp);


static void		SlaveObjCmdDeleteProc(ClientData clientData);
static int		SlaveRecursionLimit(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int objc,
			    Tcl_Obj *const objv[]);
static int		SlaveCommandLimitCmd(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int consumedObjc,
			    int objc, Tcl_Obj *const objv[]);
410
411
412
413
414
415
416

417
418
419
420
421
422
423
"file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
"	}\n"
"	if {[info exists tclDefaultLibrary]} {\n"
"	    lappend scripts {set tclDefaultLibrary}\n"
"	} else {\n"
"	    lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
"	}\n"

"	lappend scripts {\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
"set grandParentDir [file dirname $parentDir]\n"
"file join $parentDir lib tcl[info tclversion]} \\\n"
"	{file join $grandParentDir lib tcl[info tclversion]} \\\n"
"	{file join $parentDir library} \\\n"
"	{file join $grandParentDir library} \\\n"







>







405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
"file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
"	}\n"
"	if {[info exists tclDefaultLibrary]} {\n"
"	    lappend scripts {set tclDefaultLibrary}\n"
"	} else {\n"
"	    lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
"	}\n"
"	lappend scripts {::tcl::zipfs::tcl_library_init}\n"
"	lappend scripts {\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
"set grandParentDir [file dirname $parentDir]\n"
"file join $parentDir lib tcl[info tclversion]} \\\n"
"	{file join $grandParentDir lib tcl[info tclversion]} \\\n"
"	{file join $parentDir library} \\\n"
"	{file join $grandParentDir library} \\\n"
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
TclInterpInit(
    Tcl_Interp *interp)		/* Interpreter to initialize. */
{
    InterpInfo *interpInfoPtr;
    Master *masterPtr;
    Slave *slavePtr;

    interpInfoPtr = ckalloc(sizeof(InterpInfo));
    ((Interp *) interp)->interpInfo = interpInfoPtr;

    masterPtr = &interpInfoPtr->master;
    Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);
    masterPtr->targetsPtr = NULL;

    slavePtr = &interpInfoPtr->slave;







|







481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
TclInterpInit(
    Tcl_Interp *interp)		/* Interpreter to initialize. */
{
    InterpInfo *interpInfoPtr;
    Master *masterPtr;
    Slave *slavePtr;

    interpInfoPtr = Tcl_Alloc(sizeof(InterpInfo));
    ((Interp *) interp)->interpInfo = interpInfoPtr;

    masterPtr = &interpInfoPtr->master;
    Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);
    masterPtr->targetsPtr = NULL;

    slavePtr = &interpInfoPtr->slave;
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
     */

    if (slavePtr->aliasTable.numEntries != 0) {
	Tcl_Panic("InterpInfoDeleteProc: still exist aliases");
    }
    Tcl_DeleteHashTable(&slavePtr->aliasTable);

    ckfree(interpInfoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InterpObjCmd --
 *







|







578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
     */

    if (slavePtr->aliasTable.numEntries != 0) {
	Tcl_Panic("InterpInfoDeleteProc: still exist aliases");
    }
    Tcl_DeleteHashTable(&slavePtr->aliasTable);

    Tcl_Free(interpInfoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InterpObjCmd --
 *
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
	*targetNamePtr = TclGetString(objv[0]);
    }
    if (argcPtr != NULL) {
	*argcPtr = objc - 1;
    }
    if (argvPtr != NULL) {
	*argvPtr = (const char **)
		ckalloc(sizeof(const char *) * (objc - 1));
	for (i = 1; i < objc; i++) {
	    (*argvPtr)[i - 1] = TclGetString(objv[i]);
	}
    }
    return TCL_OK;
}








|







1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
	*targetNamePtr = TclGetString(objv[0]);
    }
    if (argcPtr != NULL) {
	*argcPtr = objc - 1;
    }
    if (argvPtr != NULL) {
	*argvPtr = (const char **)
		Tcl_Alloc(sizeof(const char *) * (objc - 1));
	for (i = 1; i < objc; i++) {
	    (*argvPtr)[i - 1] = TclGetString(objv[i]);
	}
    }
    return TCL_OK;
}

1414
1415
1416
1417
1418
1419
1420
1421

1422
1423
1424
1425
1426
1427
1428
    Command *aliasCmdPtr;

    /*
     * If we are not creating or renaming an alias, then it is always OK to
     * create or rename the command.
     */

    if (cmdPtr->objProc != AliasObjCmd) {

	return TCL_OK;
    }

    /*
     * OK, we are dealing with an alias, so traverse the chain of aliases. If
     * we encounter the alias we are defining (or renaming to) any in the
     * chain then we have a loop.







|
>







1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
    Command *aliasCmdPtr;

    /*
     * If we are not creating or renaming an alias, then it is always OK to
     * create or rename the command.
     */

    if (cmdPtr->objProc != TclAliasObjCmd
	    && cmdPtr->objProc != TclLocalAliasObjCmd) {
	return TCL_OK;
    }

    /*
     * OK, we are dealing with an alias, so traverse the chain of aliases. If
     * we encounter the alias we are defining (or renaming to) any in the
     * chain then we have a loop.
1469
1470
1471
1472
1473
1474
1475
1476

1477
1478
1479
1480
1481
1482
1483

	/*
	 * Otherwise, follow the chain one step further. See if the target
	 * command is an alias - if so, follow the loop to its target command.
	 * Otherwise we do not have a loop.
	 */

	if (aliasCmdPtr->objProc != AliasObjCmd) {

	    return TCL_OK;
	}
	nextAliasPtr = aliasCmdPtr->objClientData;
    }

    /* NOTREACHED */
}







|
>







1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481

	/*
	 * Otherwise, follow the chain one step further. See if the target
	 * command is an alias - if so, follow the loop to its target command.
	 * Otherwise we do not have a loop.
	 */

	if (aliasCmdPtr->objProc != TclAliasObjCmd
		&& aliasCmdPtr->objProc != TclLocalAliasObjCmd) {
	    return TCL_OK;
	}
	nextAliasPtr = aliasCmdPtr->objClientData;
    }

    /* NOTREACHED */
}
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
    Tcl_HashEntry *hPtr;
    Target *targetPtr;
    Slave *slavePtr;
    Master *masterPtr;
    Tcl_Obj **prefv;
    int isNew, i;

    aliasPtr = ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
    aliasPtr->token = namePtr;
    Tcl_IncrRefCount(aliasPtr->token);
    aliasPtr->targetInterp = masterInterp;

    aliasPtr->objc = objc + 1;
    prefv = &aliasPtr->objPtr;

    *prefv = targetNamePtr;
    Tcl_IncrRefCount(targetNamePtr);
    for (i = 0; i < objc; i++) {
	*(++prefv) = objv[i];
	Tcl_IncrRefCount(objv[i]);
    }

    Tcl_Preserve(slaveInterp);
    Tcl_Preserve(masterInterp);

    if (slaveInterp == masterInterp) {
	aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp,
		TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr,
		AliasObjCmdDeleteProc);
    } else {
    aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
	    TclGetString(namePtr), AliasObjCmd, aliasPtr,
	    AliasObjCmdDeleteProc);
    }

    if (TclPreventAliasLoop(interp, slaveInterp,
	    aliasPtr->slaveCmd) != TCL_OK) {
	/*
	 * Found an alias loop! The last call to Tcl_CreateObjCommand made the
	 * alias point to itself. Delete the command and its alias record. Be







|



















|
|

|
|
|







1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
    Tcl_HashEntry *hPtr;
    Target *targetPtr;
    Slave *slavePtr;
    Master *masterPtr;
    Tcl_Obj **prefv;
    int isNew, i;

    aliasPtr = Tcl_Alloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
    aliasPtr->token = namePtr;
    Tcl_IncrRefCount(aliasPtr->token);
    aliasPtr->targetInterp = masterInterp;

    aliasPtr->objc = objc + 1;
    prefv = &aliasPtr->objPtr;

    *prefv = targetNamePtr;
    Tcl_IncrRefCount(targetNamePtr);
    for (i = 0; i < objc; i++) {
	*(++prefv) = objv[i];
	Tcl_IncrRefCount(objv[i]);
    }

    Tcl_Preserve(slaveInterp);
    Tcl_Preserve(masterInterp);

    if (slaveInterp == masterInterp) {
	aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp,
		TclGetString(namePtr), TclLocalAliasObjCmd, AliasNRCmd,
		aliasPtr, AliasObjCmdDeleteProc);
    } else {
	aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
		TclGetString(namePtr), TclAliasObjCmd, aliasPtr,
		AliasObjCmdDeleteProc);
    }

    if (TclPreventAliasLoop(interp, slaveInterp,
	    aliasPtr->slaveCmd) != TCL_OK) {
	/*
	 * Found an alias loop! The last call to Tcl_CreateObjCommand made the
	 * alias point to itself. Delete the command and its alias record. Be
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580

	cmdPtr = (Command *) aliasPtr->slaveCmd;
	cmdPtr->clientData = NULL;
	cmdPtr->deleteProc = NULL;
	cmdPtr->deleteData = NULL;
	Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);

	ckfree(aliasPtr);

	/*
	 * The result was already set by TclPreventAliasLoop.
	 */

	Tcl_Release(slaveInterp);
	Tcl_Release(masterInterp);







|







1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578

	cmdPtr = (Command *) aliasPtr->slaveCmd;
	cmdPtr->clientData = NULL;
	cmdPtr->deleteProc = NULL;
	cmdPtr->deleteData = NULL;
	Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);

	Tcl_Free(aliasPtr);

	/*
	 * The result was already set by TclPreventAliasLoop.
	 */

	Tcl_Release(slaveInterp);
	Tcl_Release(masterInterp);
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
     * because the alias may be pointing at a renamed alias, as in:
     *
     * interp alias {} foo {} bar		# Create an alias "foo"
     * rename foo zop				# Now rename the alias
     * interp alias {} foo {} zop		# Now recreate "foo"...
     */

    targetPtr = ckalloc(sizeof(Target));
    targetPtr->slaveCmd = aliasPtr->slaveCmd;
    targetPtr->slaveInterp = slaveInterp;

    masterPtr = &((InterpInfo*) ((Interp*) masterInterp)->interpInfo)->master;
    targetPtr->nextPtr = masterPtr->targetsPtr;
    targetPtr->prevPtr = NULL;
    if (masterPtr->targetsPtr != NULL) {







|







1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
     * because the alias may be pointing at a renamed alias, as in:
     *
     * interp alias {} foo {} bar		# Create an alias "foo"
     * rename foo zop				# Now rename the alias
     * interp alias {} foo {} zop		# Now recreate "foo"...
     */

    targetPtr = Tcl_Alloc(sizeof(Target));
    targetPtr->slaveCmd = aliasPtr->slaveCmd;
    targetPtr->slaveInterp = slaveInterp;

    masterPtr = &((InterpInfo*) ((Interp*) masterInterp)->interpInfo)->master;
    targetPtr->nextPtr = masterPtr->targetsPtr;
    targetPtr->prevPtr = NULL;
    if (masterPtr->targetsPtr != NULL) {
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789





1790
1791
1792
1793
1794
1795
1796
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AliasObjCmd --
 *
 *	This is the function that services invocations of aliases in a slave
 *	interpreter. One such command exists for each alias. When invoked,
 *	this function redirects the invocation to the target command in the
 *	master interpreter as designated by the Alias record associated with
 *	this command.





 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Causes forwarding of the invocation; all possible side effects may
 *	occur as a result of invoking the command to which the invocation is







|






>
>
>
>
>







1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclAliasObjCmd, TclLocalAliasObjCmd --
 *
 *	This is the function that services invocations of aliases in a slave
 *	interpreter. One such command exists for each alias. When invoked,
 *	this function redirects the invocation to the target command in the
 *	master interpreter as designated by the Alias record associated with
 *	this command.
 *
 *	TclLocalAliasObjCmd is a stripped down version used when the source
 *	and target interpreters of the alias are the same. That lets a number
 *	of safety precautions be avoided: the state is much more precisely
 *	known.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Causes forwarding of the invocation; all possible side effects may
 *	occur as a result of invoking the command to which the invocation is
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
    if (TclInitRewriteEnsemble(interp, 1, prefc, objv)) {
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
    }
    TclSkipTailcall(interp);
    return Tcl_NREvalObj(interp, listPtr, flags);
}

static int
AliasObjCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = clientData;







|
|







1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
    if (TclInitRewriteEnsemble(interp, 1, prefc, objv)) {
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
    }
    TclSkipTailcall(interp);
    return Tcl_NREvalObj(interp, listPtr, flags);
}

int
TclAliasObjCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = clientData;
1933
1934
1935
1936
1937
1938
1939



































































1940
1941
1942
1943
1944
1945
1946
    }
    if (cmdv != cmdArr) {
	TclStackFree(interp, cmdv);
    }
    return result;
#undef ALIAS_CMDV_PREALLOC
}




































































/*
 *----------------------------------------------------------------------
 *
 * AliasObjCmdDeleteProc --
 *
 *	Is invoked when an alias command is deleted in a slave. Cleans up all







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
    }
    if (cmdv != cmdArr) {
	TclStackFree(interp, cmdv);
    }
    return result;
#undef ALIAS_CMDV_PREALLOC
}

int
TclLocalAliasObjCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = clientData;
    int result, prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;
    Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
    Interp *iPtr = (Interp *) interp;
    int isRootEnsemble;

    /*
     * Append the arguments to the command prefix and invoke the command in
     * the global namespace.
     */

    prefc = aliasPtr->objc;
    prefv = &aliasPtr->objPtr;
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
    }

    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

    /*
     * Use the ensemble rewriting machinery to ensure correct error messages:
     * only the source command should show, not the full target prefix.
     */

    isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)iPtr, 1, prefc, objv);

    /*
     * Execute the target command in the target interpreter.
     */

    result = Tcl_EvalObjv(interp, cmdc, cmdv, TCL_EVAL_INVOKE);

    /*
     * Clean up the ensemble rewrite info if we set it in the first place.
     */

    if (isRootEnsemble) {
	TclResetRewriteEnsemble((Tcl_Interp *)iPtr, 1);
    }

    for (i=0; i<cmdc; i++) {
	Tcl_DecrRefCount(cmdv[i]);
    }
    if (cmdv != cmdArr) {
	TclStackFree(interp, cmdv);
    }
    return result;
#undef ALIAS_CMDV_PREALLOC
}

/*
 *----------------------------------------------------------------------
 *
 * AliasObjCmdDeleteProc --
 *
 *	Is invoked when an alias command is deleted in a slave. Cleans up all
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000

	masterPtr->targetsPtr = targetPtr->nextPtr;
    }
    if (targetPtr->nextPtr != NULL) {
	targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
    }

    ckfree(targetPtr);
    ckfree(aliasPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateSlave --
 *







|
|







2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070

	masterPtr->targetsPtr = targetPtr->nextPtr;
    }
    if (targetPtr->nextPtr != NULL) {
	targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
    }

    Tcl_Free(targetPtr);
    Tcl_Free(aliasPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateSlave --
 *
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386

    slaveInterp = Tcl_CreateInterp();
    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
    slavePtr->masterInterp = masterInterp;
    slavePtr->slaveEntryPtr = hPtr;
    slavePtr->slaveInterp = slaveInterp;
    slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
	    SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
    Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
    Tcl_SetHashValue(hPtr, slavePtr);
    Tcl_SetVar2(slaveInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY);

    /*
     * Inherit the recursion limit.
     */







|







2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456

    slaveInterp = Tcl_CreateInterp();
    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
    slavePtr->masterInterp = masterInterp;
    slavePtr->slaveEntryPtr = hPtr;
    slavePtr->slaveInterp = slaveInterp;
    slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
	    TclSlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
    Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
    Tcl_SetHashValue(hPtr, slavePtr);
    Tcl_SetVar2(slaveInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY);

    /*
     * Inherit the recursion limit.
     */
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469

    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * SlaveObjCmd --
 *
 *	Command to manipulate an interpreter, e.g. to send commands to it to
 *	be evaluated. One such command exists for each slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

static int
SlaveObjCmd(
    ClientData clientData,	/* Slave interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRSlaveCmd, clientData, objc, objv);
}







|













|
|







2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539

    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSlaveObjCmd --
 *
 *	Command to manipulate an interpreter, e.g. to send commands to it to
 *	be evaluated. One such command exists for each slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

int
TclSlaveObjCmd(
    ClientData clientData,	/* Slave interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRSlaveCmd, clientData, objc, objv);
}
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_DEBUG,
	OPT_EVAL,	OPT_EXPOSE,	OPT_HIDE,	OPT_HIDDEN,
	OPT_ISSAFE,	OPT_INVOKEHIDDEN, OPT_LIMIT,	OPT_MARKTRUSTED,
	OPT_RECLIMIT
    };

    if (slaveInterp == NULL) {
	Tcl_Panic("SlaveObjCmd: interpreter has been deleted");
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,







|







2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_DEBUG,
	OPT_EVAL,	OPT_EXPOSE,	OPT_HIDE,	OPT_HIDDEN,
	OPT_ISSAFE,	OPT_INVOKEHIDDEN, OPT_LIMIT,	OPT_MARKTRUSTED,
	OPT_RECLIMIT
    };

    if (slaveInterp == NULL) {
	Tcl_Panic("TclSlaveObjCmd: interpreter has been deleted");
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
	 * LIMIT_HANDLER_DELETED flag.
	 */

	if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    ckfree(handlerPtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *







|







3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
	 * LIMIT_HANDLER_DELETED flag.
	 */

	if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
    LimitHandler *handlerPtr;

    /*
     * Convert everything into a real deletion callback.
     */

    if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) {
	deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free;
    }

    /*
     * Allocate a handler record.
     */

    handlerPtr = ckalloc(sizeof(LimitHandler));
    handlerPtr->flags = 0;
    handlerPtr->handlerProc = handlerProc;
    handlerPtr->clientData = clientData;
    handlerPtr->deleteProc = deleteProc;
    handlerPtr->prevPtr = NULL;

    /*







|






|







3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
    LimitHandler *handlerPtr;

    /*
     * Convert everything into a real deletion callback.
     */

    if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) {
	deleteProc = (Tcl_LimitHandlerDeleteProc *) TclpFree;
    }

    /*
     * Allocate a handler record.
     */

    handlerPtr = Tcl_Alloc(sizeof(LimitHandler));
    handlerPtr->flags = 0;
    handlerPtr->handlerProc = handlerProc;
    handlerPtr->clientData = clientData;
    handlerPtr->deleteProc = deleteProc;
    handlerPtr->prevPtr = NULL;

    /*
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    ckfree(handlerPtr);
	}
	return;
    }
}

/*
 *----------------------------------------------------------------------







|







3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	}
	return;
    }
}

/*
 *----------------------------------------------------------------------
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    ckfree(handlerPtr);
	}
    }

    /*
     * Delete all time-limit handlers.
     */








|







3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	}
    }

    /*
     * Delete all time-limit handlers.
     */

3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    ckfree(handlerPtr);
	}
    }

    /*
     * Delete the timer callback that is used to trap limits that occur in
     * [vwait]s...
     */







|







3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	}
    }

    /*
     * Delete the timer callback that is used to trap limits that occur in
     * [vwait]s...
     */
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
{
    ScriptLimitCallback *limitCBPtr = clientData;

    Tcl_DecrRefCount(limitCBPtr->scriptObj);
    if (limitCBPtr->entryPtr != NULL) {
	Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
    }
    ckfree(limitCBPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CallScriptLimitCallback --
 *







|







4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
{
    ScriptLimitCallback *limitCBPtr = clientData;

    Tcl_DecrRefCount(limitCBPtr->scriptObj);
    if (limitCBPtr->entryPtr != NULL) {
	Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
    }
    Tcl_Free(limitCBPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CallScriptLimitCallback --
 *
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
    if (!isNew) {
	limitCBPtr = Tcl_GetHashValue(hashPtr);
	limitCBPtr->entryPtr = NULL;
	Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
		limitCBPtr);
    }

    limitCBPtr = ckalloc(sizeof(ScriptLimitCallback));
    limitCBPtr->interp = interp;
    limitCBPtr->scriptObj = scriptObj;
    limitCBPtr->entryPtr = hashPtr;
    limitCBPtr->type = type;
    Tcl_IncrRefCount(scriptObj);

    Tcl_LimitAddHandler(targetInterp, type, CallScriptLimitCallback,







|







4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
    if (!isNew) {
	limitCBPtr = Tcl_GetHashValue(hashPtr);
	limitCBPtr->entryPtr = NULL;
	Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
		limitCBPtr);
    }

    limitCBPtr = Tcl_Alloc(sizeof(ScriptLimitCallback));
    limitCBPtr->interp = interp;
    limitCBPtr->scriptObj = scriptObj;
    limitCBPtr->entryPtr = hashPtr;
    limitCBPtr->type = type;
    Tcl_IncrRefCount(scriptObj);

    Tcl_LimitAddHandler(targetInterp, type, CallScriptLimitCallback,
Changes to generic/tclLink.c.
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
	    TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL);
    if (linkPtr != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"variable '%s' is already linked", varName));
	return TCL_ERROR;
    }

    linkPtr = ckalloc(sizeof(Link));
    linkPtr->interp = interp;
    linkPtr->varName = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(linkPtr->varName);
    linkPtr->addr = addr;
    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
    if (type & TCL_LINK_READ_ONLY) {
	linkPtr->flags = LINK_READ_ONLY;
    } else {
	linkPtr->flags = 0;
    }
    objPtr = ObjValue(linkPtr);
    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DecrRefCount(linkPtr->varName);
	ckfree(linkPtr);
	return TCL_ERROR;
    }
    code = Tcl_TraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    if (code != TCL_OK) {
	Tcl_DecrRefCount(linkPtr->varName);
	ckfree(linkPtr);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *







|














|







|







121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
	    TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL);
    if (linkPtr != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"variable '%s' is already linked", varName));
	return TCL_ERROR;
    }

    linkPtr = Tcl_Alloc(sizeof(Link));
    linkPtr->interp = interp;
    linkPtr->varName = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(linkPtr->varName);
    linkPtr->addr = addr;
    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
    if (type & TCL_LINK_READ_ONLY) {
	linkPtr->flags = LINK_READ_ONLY;
    } else {
	linkPtr->flags = 0;
    }
    objPtr = ObjValue(linkPtr);
    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DecrRefCount(linkPtr->varName);
	Tcl_Free(linkPtr);
	return TCL_ERROR;
    }
    code = Tcl_TraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    if (code != TCL_OK) {
	Tcl_DecrRefCount(linkPtr->varName);
	Tcl_Free(linkPtr);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
    if (linkPtr == NULL) {
	return;
    }
    Tcl_UntraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    Tcl_DecrRefCount(linkPtr->varName);
    ckfree(linkPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UpdateLinkedVar --
 *







|







182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
    if (linkPtr == NULL) {
	return;
    }
    Tcl_UntraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    Tcl_DecrRefCount(linkPtr->varName);
    Tcl_Free(linkPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UpdateLinkedVar --
 *
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
     * If the variable is being unset, then just re-create it (with a trace)
     * unless the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if (Tcl_InterpDeleted(interp)) {
	    Tcl_DecrRefCount(linkPtr->varName);
	    ckfree(linkPtr);
	} else if (flags & TCL_TRACE_DESTROYED) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL,
		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
		    |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
	}







|







277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
     * If the variable is being unset, then just re-create it (with a trace)
     * unless the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if (Tcl_InterpDeleted(interp)) {
	    Tcl_DecrRefCount(linkPtr->varName);
	    Tcl_Free(linkPtr);
	} else if (flags & TCL_TRACE_DESTROYED) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL,
		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
		    |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
	}
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
	break;

    case TCL_LINK_STRING:
	value = TclGetString(valueObj);
	valueLength = valueObj->length + 1;
	pp = (char **) linkPtr->addr;

	*pp = ckrealloc(*pp, valueLength);
	memcpy(*pp, value, valueLength);
	break;

    default:
	return (char *) "internal error: bad linked variable type";
    }
    return NULL;







|







536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
	break;

    case TCL_LINK_STRING:
	value = TclGetString(valueObj);
	valueLength = valueObj->length + 1;
	pp = (char **) linkPtr->addr;

	*pp = Tcl_Realloc(*pp, valueLength);
	memcpy(*pp, value, valueLength);
	break;

    default:
	return (char *) "internal error: bad linked variable type";
    }
    return NULL;
Changes to generic/tclListObj.c.
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
	if (p) {
	    Tcl_Panic("max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX);
	}
	return NULL;
    }

    listRepPtr = attemptckalloc(LIST_SIZE(objc));
    if (listRepPtr == NULL) {
	if (p) {
	    Tcl_Panic("list creation failed: unable to alloc %u bytes",
		    LIST_SIZE(objc));
	}
	return NULL;
    }







|







98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
	if (p) {
	    Tcl_Panic("max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX);
	}
	return NULL;
    }

    listRepPtr = Tcl_AttemptAlloc(LIST_SIZE(objc));
    if (listRepPtr == NULL) {
	if (p) {
	    Tcl_Panic("list creation failed: unable to alloc %u bytes",
		    LIST_SIZE(objc));
	}
	return NULL;
    }
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
    if (needGrow && !isShared) {
	/*
	 * Need to grow + unshared intrep => try to realloc
	 */

	attempt = 2 * numRequired;
	if (attempt <= LIST_MAX) {
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = 0;
	}
    }







|






|



|







662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
    if (needGrow && !isShared) {
	/*
	 * Need to grow + unshared intrep => try to realloc
	 */

	attempt = 2 * numRequired;
	if (attempt <= LIST_MAX) {
	    newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = 0;
	}
    }
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
	    listRepPtr->refCount--;
	} else {
	    /*
	     * Old intrep to be freed, re-use refCounts.
	     */

	    memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *));
	    ckfree(listRepPtr);
	}
	listRepPtr = newPtr;
    }
    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;

    /*
     * Add objPtr to the end of listPtr's array of element pointers. Increment







|







731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
	    listRepPtr->refCount--;
	} else {
	    /*
	     * Old intrep to be freed, re-use refCounts.
	     */

	    memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *));
	    Tcl_Free(listRepPtr);
	}
	listRepPtr = newPtr;
    }
    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;

    /*
     * Add objPtr to the end of listPtr's array of element pointers. Increment
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
    }

    if (needGrow && !isShared) {
	/* Try to use realloc */
	List *newPtr = NULL;
	int attempt = 2 * numRequired;
	if (attempt <= LIST_MAX) {
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
	    elemPtrs = &listRepPtr->elements;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = numRequired > listRepPtr->maxElemCount;







|






|



|







984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
    }

    if (needGrow && !isShared) {
	/* Try to use realloc */
	List *newPtr = NULL;
	int attempt = 2 * numRequired;
	if (attempt <= LIST_MAX) {
	    newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
	    elemPtrs = &listRepPtr->elements;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = numRequired > listRepPtr->maxElemCount;
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
	    start = first + count;
	    numAfterLast = numElems - start;
	    if (numAfterLast > 0) {
		memcpy(elemPtrs + first + objc, oldPtrs + start,
			(size_t) numAfterLast * sizeof(Tcl_Obj *));
	    }

	    ckfree(oldListRepPtr);
	}
    }

    /*
     * Insert the new elements into elemPtrs before "first".
     */








|







1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
	    start = first + count;
	    numAfterLast = numElems - start;
	    if (numAfterLast > 0) {
		memcpy(elemPtrs + first + objc, oldPtrs + start,
			(size_t) numAfterLast * sizeof(Tcl_Obj *));
	    }

	    Tcl_Free(oldListRepPtr);
	}
    }

    /*
     * Insert the new elements into elemPtrs before "first".
     */

1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
    if (listRepPtr->refCount-- <= 1) {
	Tcl_Obj **elemPtrs = &listRepPtr->elements;
	int i, numElems = listRepPtr->elemCount;

	for (i = 0;  i < numElems;  i++) {
	    Tcl_DecrRefCount(elemPtrs[i]);
	}
	ckfree(listRepPtr);
    }

    listPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------







|







1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
    if (listRepPtr->refCount-- <= 1) {
	Tcl_Obj **elemPtrs = &listRepPtr->elements;
	int i, numElems = listRepPtr->elemCount;

	for (i = 0;  i < numElems;  i++) {
	    Tcl_DecrRefCount(elemPtrs[i]);
	}
	Tcl_Free(listRepPtr);
    }

    listPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
1941
1942
1943
1944
1945
1946
1947

1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974

	/*
	 * Each iteration, parse and store a list element.
	 */

	while (nextElem < limit) {
	    const char *elemStart;

	    int elemSize, literal;

	    if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
		    &elemStart, &nextElem, &elemSize, &literal)) {
		while (--elemPtrs >= &listRepPtr->elements) {
		    Tcl_DecrRefCount(*elemPtrs);
		}
		ckfree(listRepPtr);
		return TCL_ERROR;
	    }
	    if (elemStart == limit) {
		break;
	    }

	    /* TODO: replace panic with error on alloc failure? */
	    if (literal) {
		TclNewStringObj(*elemPtrs, elemStart, elemSize);
	    } else {
		TclNewObj(*elemPtrs);
		(*elemPtrs)->bytes = ckalloc((unsigned) elemSize + 1);
		(*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart,
			(*elemPtrs)->bytes);
	    }

	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
	}








>
|






|











|







1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975

	/*
	 * Each iteration, parse and store a list element.
	 */

	while (nextElem < limit) {
	    const char *elemStart;
	    size_t elemSize;
	    int literal;

	    if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
		    &elemStart, &nextElem, &elemSize, &literal)) {
		while (--elemPtrs >= &listRepPtr->elements) {
		    Tcl_DecrRefCount(*elemPtrs);
		}
		Tcl_Free(listRepPtr);
		return TCL_ERROR;
	    }
	    if (elemStart == limit) {
		break;
	    }

	    /* TODO: replace panic with error on alloc failure? */
	    if (literal) {
		TclNewStringObj(*elemPtrs, elemStart, elemSize);
	    } else {
		TclNewObj(*elemPtrs);
		(*elemPtrs)->bytes = Tcl_Alloc((unsigned) elemSize + 1);
		(*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart,
			(*elemPtrs)->bytes);
	    }

	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
	}

2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/*
	 * We know numElems <= LIST_MAX, so this is safe.
	 */

	flagPtr = ckalloc(numElems);
    }
    elemPtrs = &listRepPtr->elements;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    }
    if (bytesNeeded > INT_MAX - numElems + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    listPtr->length = bytesNeeded - 1;
    listPtr->bytes = ckalloc(bytesNeeded);
    dst = listPtr->bytes;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';
    }
    listPtr->bytes[listPtr->length] = '\0';

    if (flagPtr != localFlags) {
	ckfree(flagPtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|




















|










|










2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/*
	 * We know numElems <= LIST_MAX, so this is safe.
	 */

	flagPtr = Tcl_Alloc(numElems);
    }
    elemPtrs = &listRepPtr->elements;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    }
    if (bytesNeeded > INT_MAX - numElems + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    listPtr->length = bytesNeeded - 1;
    listPtr->bytes = Tcl_Alloc(bytesNeeded);
    dst = listPtr->bytes;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';
    }
    listPtr->bytes[listPtr->length] = '\0';

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclLiteral.c.
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
/*
 * Function prototypes for static functions in this file:
 */

static int		AddLocalLiteralEntry(CompileEnv *envPtr,
			    Tcl_Obj *objPtr, int localHash);
static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
static unsigned		HashString(const char *string, int length);
#ifdef TCL_COMPILE_DEBUG
static LiteralEntry *	LookupLiteralEntry(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
static void		RebuildLiteralTable(LiteralTable *tablePtr);

/*







|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
/*
 * Function prototypes for static functions in this file:
 */

static int		AddLocalLiteralEntry(CompileEnv *envPtr,
			    Tcl_Obj *objPtr, int localHash);
static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
static size_t		HashString(const char *string, size_t length);
#ifdef TCL_COMPILE_DEBUG
static LiteralEntry *	LookupLiteralEntry(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
static void		RebuildLiteralTable(LiteralTable *tablePtr);

/*
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
TclDeleteLiteralTable(
    Tcl_Interp *interp,		/* Interpreter containing shared literals
				 * referenced by the table to delete. */
    LiteralTable *tablePtr)	/* Points to the literal table to delete. */
{
    LiteralEntry *entryPtr, *nextPtr;
    Tcl_Obj *objPtr;
    int i;

    /*
     * Release remaining literals in the table. Note that releasing a literal
     * might release other literals, modifying the table, so we restart the
     * search from the bucket chain we last found an entry.
     */








|







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
TclDeleteLiteralTable(
    Tcl_Interp *interp,		/* Interpreter containing shared literals
				 * referenced by the table to delete. */
    LiteralTable *tablePtr)	/* Points to the literal table to delete. */
{
    LiteralEntry *entryPtr, *nextPtr;
    Tcl_Obj *objPtr;
    size_t i;

    /*
     * Release remaining literals in the table. Note that releasing a literal
     * might release other literals, modifying the table, so we restart the
     * search from the bucket chain we last found an entry.
     */

127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151

    for (i=0 ; i<tablePtr->numBuckets ; i++) {
	entryPtr = tablePtr->buckets[i];
	while (entryPtr != NULL) {
	    objPtr = entryPtr->objPtr;
	    TclDecrRefCount(objPtr);
	    nextPtr = entryPtr->nextPtr;
	    ckfree(entryPtr);
	    entryPtr = nextPtr;
	}
    }

    /*
     * Free up the table's bucket array if it was dynamically allocated.
     */

    if (tablePtr->buckets != tablePtr->staticBuckets) {
	ckfree(tablePtr->buckets);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateLiteral --







|









|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151

    for (i=0 ; i<tablePtr->numBuckets ; i++) {
	entryPtr = tablePtr->buckets[i];
	while (entryPtr != NULL) {
	    objPtr = entryPtr->objPtr;
	    TclDecrRefCount(objPtr);
	    nextPtr = entryPtr->nextPtr;
	    Tcl_Free(entryPtr);
	    entryPtr = nextPtr;
	}
    }

    /*
     * Free up the table's bucket array if it was dynamically allocated.
     */

    if (tablePtr->buckets != tablePtr->staticBuckets) {
	Tcl_Free(tablePtr->buckets);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateLiteral --
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
 */

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    const char *bytes,	/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    int length,			/* Number of bytes in the string. */
    unsigned hash,		/* The string's hash. If -1, it will be
				 * computed here. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    unsigned int globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (hash == (unsigned) -1) {
	hash = HashString(bytes, length);
    }
    globalHash = (hash & globalTablePtr->mask);
    for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
	    globalPtr = globalPtr->nextPtr) {
	objPtr = globalPtr->objPtr;
	if ((globalPtr->nsPtr == nsPtr)
		&& (objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
	    /*
	     * A literal was found: return it
	     */

	    if (newPtr) {
		*newPtr = 0;
	    }
	    if (globalPtrPtr) {
		*globalPtrPtr = globalPtr;
	    }
	    if ((flags & LITERAL_ON_HEAP)) {
		ckfree(bytes);
	    }
	    globalPtr->refCount++;
	    return objPtr;
	}
    }
    if (!newPtr) {
	if ((flags & LITERAL_ON_HEAP)) {
	    ckfree(bytes);
	}
	return NULL;
    }

    /*
     * The literal is new to the interpreter.
     */







|
|








|






|







|

|











|







|







172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
 */

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    const char *bytes,	/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    size_t length,		/* Number of bytes in the string. */
    size_t hash,		/* The string's hash. If -1, it will be
				 * computed here. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    size_t globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (hash == (size_t) -1) {
	hash = HashString(bytes, length);
    }
    globalHash = (hash & globalTablePtr->mask);
    for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
	    globalPtr = globalPtr->nextPtr) {
	objPtr = globalPtr->objPtr;
	if ((globalPtr->nsPtr == nsPtr)
		&& ((size_t)objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
	    /*
	     * A literal was found: return it
	     */

	    if (newPtr) {
		*newPtr = 0;
	    }
	    if (globalPtrPtr) {
		*globalPtrPtr = globalPtr;
	    }
	    if ((flags & LITERAL_ON_HEAP)) {
		Tcl_Free((void *)bytes);
	    }
	    globalPtr->refCount++;
	    return objPtr;
	}
    }
    if (!newPtr) {
	if ((flags & LITERAL_ON_HEAP)) {
	    Tcl_Free((void *)bytes);
	}
	return NULL;
    }

    /*
     * The literal is new to the interpreter.
     */
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273

    /*
     * Yes, add it to the global literal table.
     */
#ifdef TCL_COMPILE_DEBUG
    if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
	Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
		"TclRegisterLiteral", (length>60? 60 : length), bytes);
    }
#endif

    globalPtr = ckalloc(sizeof(LiteralEntry));
    globalPtr->objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    globalPtr->refCount = 1;
    globalPtr->nsPtr = nsPtr;
    globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
    globalTablePtr->buckets[globalHash] = globalPtr;
    globalTablePtr->numEntries++;







|



|







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273

    /*
     * Yes, add it to the global literal table.
     */
#ifdef TCL_COMPILE_DEBUG
    if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
	Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
		"TclRegisterLiteral", (length>60? 60 : (int)length), bytes);
    }
#endif

    globalPtr = Tcl_Alloc(sizeof(LiteralEntry));
    globalPtr->objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    globalPtr->refCount = 1;
    globalPtr->nsPtr = nsPtr;
    globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
    globalTablePtr->buckets[globalHash] = globalPtr;
    globalTablePtr->numEntries++;
281
282
283
284
285
286
287
288

289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
	RebuildLiteralTable(globalTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyGlobalLiteralTable(iPtr);
    {
	LiteralEntry *entryPtr;
	int found, i;


	found = 0;
	for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	    for (entryPtr=globalTablePtr->buckets[i]; entryPtr!=NULL ;
		    entryPtr=entryPtr->nextPtr) {
		if ((entryPtr == globalPtr) && (entryPtr->objPtr == objPtr)) {
		    found = 1;
		}
	    }
	}
	if (!found) {
	    Tcl_Panic("%s: literal \"%.*s\" wasn't global",
		    "TclRegisterLiteral", (length>60? 60 : length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

#ifdef TCL_COMPILE_STATS
    iPtr->stats.numLiteralsCreated++;
    iPtr->stats.totalLitStringBytes += (double) (length + 1);







|
>












|







281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
	RebuildLiteralTable(globalTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyGlobalLiteralTable(iPtr);
    {
	LiteralEntry *entryPtr;
	int found;
	size_t i;

	found = 0;
	for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	    for (entryPtr=globalTablePtr->buckets[i]; entryPtr!=NULL ;
		    entryPtr=entryPtr->nextPtr) {
		if ((entryPtr == globalPtr) && (entryPtr->objPtr == objPtr)) {
		    found = 1;
		}
	    }
	}
	if (!found) {
	    Tcl_Panic("%s: literal \"%.*s\" wasn't global",
		    "TclRegisterLiteral", (length>60? 60 : (int)length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

#ifdef TCL_COMPILE_STATS
    iPtr->stats.numLiteralsCreated++;
    iPtr->stats.totalLitStringBytes += (double) (length + 1);
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclFetchLiteral(
    CompileEnv *envPtr,		/* Points to the CompileEnv from which to
				 * fetch the registered literal value. */
    unsigned int index)		/* Index of the desired literal, as returned
				 * by prior call to TclRegisterLiteral() */
{
    if (index >= (unsigned int) envPtr->literalArrayNext) {
	return NULL;
    }
    return envPtr->literalArrayPtr[index].objPtr;
}

/*
 *----------------------------------------------------------------------







|


|







332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclFetchLiteral(
    CompileEnv *envPtr,		/* Points to the CompileEnv from which to
				 * fetch the registered literal value. */
    size_t index)		/* Index of the desired literal, as returned
				 * by prior call to TclRegisterLiteral() */
{
    if (index >= (size_t) envPtr->literalArrayNext) {
	return NULL;
    }
    return envPtr->literalArrayPtr[index].objPtr;
}

/*
 *----------------------------------------------------------------------
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
int
TclRegisterLiteral(
    void *ePtr,		/* Points to the CompileEnv in whose object
				 * array an object is found or created. */
    register const char *bytes,	/* Points to string for which to find or
				 * create an object in CompileEnv's object
				 * array. */
    int length,			/* Number of bytes in the string. If < 0, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * the literal should not be shared accross
				 * namespaces. */
{
    CompileEnv *envPtr = ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;
    unsigned hash;
    unsigned int localHash;
    int objIndex, new;
    Namespace *nsPtr;

    if (length < 0) {
	length = (bytes ? strlen(bytes) : 0);
    }
    hash = HashString(bytes, length);

    /*
     * Is the literal already in the CompileEnv's local literal array? If so,
     * just return its index.
     */

    localHash = (hash & localTablePtr->mask);
    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
	    localPtr = localPtr->nextPtr) {
	objPtr = localPtr->objPtr;
	if ((objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
	    if ((flags & LITERAL_ON_HEAP)) {
		ckfree(bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/

	    return objIndex;







|













<
|
|


|













|

|

|







375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395

396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
int
TclRegisterLiteral(
    void *ePtr,		/* Points to the CompileEnv in whose object
				 * array an object is found or created. */
    register const char *bytes,	/* Points to string for which to find or
				 * create an object in CompileEnv's object
				 * array. */
    size_t length,			/* Number of bytes in the string. If -1, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * the literal should not be shared accross
				 * namespaces. */
{
    CompileEnv *envPtr = ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;

    size_t hash, localHash, objIndex;
    int new;
    Namespace *nsPtr;

    if (length == (size_t)-1) {
	length = (bytes ? strlen(bytes) : 0);
    }
    hash = HashString(bytes, length);

    /*
     * Is the literal already in the CompileEnv's local literal array? If so,
     * just return its index.
     */

    localHash = (hash & localTablePtr->mask);
    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
	    localPtr = localPtr->nextPtr) {
	objPtr = localPtr->objPtr;
	if (((size_t)objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
	    if ((flags & LITERAL_ON_HEAP)) {
		Tcl_Free((void *)bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/

	    return objIndex;
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466

    globalPtr = NULL;
    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags,
	    &globalPtr);
    objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);

#ifdef TCL_COMPILE_DEBUG
    if (globalPtr != NULL && globalPtr->refCount < 1) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
		"TclRegisterLiteral", (length>60? 60 : length), bytes,
		globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
}

#ifdef TCL_COMPILE_DEBUG







|

|
|







449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466

    globalPtr = NULL;
    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags,
	    &globalPtr);
    objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);

#ifdef TCL_COMPILE_DEBUG
    if (globalPtr != NULL && (globalPtr->refCount < 1 || globalPtr->refCount == (size_t)-1)) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
		"TclRegisterLiteral", (length>60? 60 : (int)length), bytes,
		(int)globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
}

#ifdef TCL_COMPILE_DEBUG
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
				 * that was previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    register LiteralEntry *entryPtr;
    const char *bytes;
    int length, globalHash;

    bytes = TclGetStringFromObj(objPtr, &length);
    globalHash = (HashString(bytes, length) & globalTablePtr->mask);
    for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
	    entryPtr=entryPtr->nextPtr) {
	if (entryPtr->objPtr == objPtr) {
	    return entryPtr;
	}
    }
    return NULL;







|

|
|







489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
				 * that was previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    register LiteralEntry *entryPtr;
    const char *bytes;
    size_t globalHash;

    bytes = TclGetString(objPtr);
    globalHash = (HashString(bytes, objPtr->length) & globalTablePtr->mask);
    for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
	    entryPtr=entryPtr->nextPtr) {
	if (entryPtr->objPtr == objPtr) {
	    return entryPtr;
	}
    }
    return NULL;
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560

561
562
563
564
565
566
567
    register CompileEnv *envPtr,/* Points to CompileEnv whose literal array
				 * contains the entry being hidden. */
    int index)			/* The index of the entry in the literal
				 * array. */
{
    LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    unsigned int localHash;
    int length;
    const char *bytes;
    Tcl_Obj *newObjPtr;

    lPtr = &envPtr->literalArrayPtr[index];

    /*
     * To avoid unwanted sharing we need to copy the object and remove it from
     * the local and global literal tables. It still has a slot in the literal
     * array so it can be referred to by byte codes, but it will not be
     * matched by literal searches.
     */

    newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
    Tcl_IncrRefCount(newObjPtr);
    TclReleaseLiteral(interp, lPtr->objPtr);
    lPtr->objPtr = newObjPtr;

    bytes = TclGetStringFromObj(newObjPtr, &length);

    localHash = HashString(bytes, length) & localTablePtr->mask;
    nextPtrPtr = &localTablePtr->buckets[localHash];

    for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
	if (entryPtr == lPtr) {
	    *nextPtrPtr = lPtr->nextPtr;
	    lPtr->nextPtr = NULL;







|
|

















|
>







534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
    register CompileEnv *envPtr,/* Points to CompileEnv whose literal array
				 * contains the entry being hidden. */
    int index)			/* The index of the entry in the literal
				 * array. */
{
    LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    size_t localHash;
    size_t length;
    const char *bytes;
    Tcl_Obj *newObjPtr;

    lPtr = &envPtr->literalArrayPtr[index];

    /*
     * To avoid unwanted sharing we need to copy the object and remove it from
     * the local and global literal tables. It still has a slot in the literal
     * array so it can be referred to by byte codes, but it will not be
     * matched by literal searches.
     */

    newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
    Tcl_IncrRefCount(newObjPtr);
    TclReleaseLiteral(interp, lPtr->objPtr);
    lPtr->objPtr = newObjPtr;

    bytes = TclGetString(newObjPtr);
    length = newObjPtr->length;
    localHash = HashString(bytes, length) & localTablePtr->mask;
    nextPtrPtr = &localTablePtr->buckets[localHash];

    for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
	if (entryPtr == lPtr) {
	    *nextPtrPtr = lPtr->nextPtr;
	    lPtr->nextPtr = NULL;
672
673
674
675
676
677
678

679
680
681
682
683
684
685
686
687
688
689
690
691
692

693
694
695
696
697
698
699
700
701
	RebuildLiteralTable(localTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyLocalLiteralTable(envPtr);
    {
	char *bytes;

	int length, found, i;

	found = 0;
	for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	    for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ;
		    localPtr=localPtr->nextPtr) {
		if (localPtr->objPtr == objPtr) {
		    found = 1;
		}
	    }
	}

	if (!found) {
	    bytes = TclGetStringFromObj(objPtr, &length);

	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;
}








>
|












|
>

|







673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
	RebuildLiteralTable(localTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyLocalLiteralTable(envPtr);
    {
	char *bytes;
	int found;
	size_t length, i;

	found = 0;
	for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	    for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ;
		    localPtr=localPtr->nextPtr) {
		if (localPtr->objPtr == objPtr) {
		    found = 1;
		}
	    }
	}

	if (!found) {
	    bytes = TclGetString(objPtr);
	    length = objPtr->length;
	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;
}

726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
{
    /*
     * The current allocated local literal entries are stored between elements
     * 0 and (envPtr->literalArrayNext - 1) [inclusive].
     */

    LiteralTable *localTablePtr = &envPtr->localLitTable;
    int currElems = envPtr->literalArrayNext;
    size_t currBytes = (currElems * sizeof(LiteralEntry));
    LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
    LiteralEntry *newArrayPtr;
    int i;
    unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX;

    if (currBytes == newSize) {
	Tcl_Panic("max size of Tcl literal array (%d literals) exceeded",
		currElems);
    }

    if (envPtr->mallocedLiteralArray) {
	newArrayPtr = ckrealloc(currArrayPtr, newSize);
    } else {
	/*
	 * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
	 * code a ckrealloc equivalent for ourselves.
	 */

	newArrayPtr = ckalloc(newSize);
	memcpy(newArrayPtr, currArrayPtr, currBytes);
	envPtr->mallocedLiteralArray = 1;
    }

    /*
     * Update the local literal table's bucket array.
     */







|



|
|


|




|


|
|


|







729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
{
    /*
     * The current allocated local literal entries are stored between elements
     * 0 and (envPtr->literalArrayNext - 1) [inclusive].
     */

    LiteralTable *localTablePtr = &envPtr->localLitTable;
    size_t currElems = envPtr->literalArrayNext;
    size_t currBytes = (currElems * sizeof(LiteralEntry));
    LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
    LiteralEntry *newArrayPtr;
    size_t i;
    size_t newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX;

    if (currBytes == newSize) {
	Tcl_Panic("max size of Tcl literal array (%" TCL_Z_MODIFIER "u literals) exceeded",
		currElems);
    }

    if (envPtr->mallocedLiteralArray) {
	newArrayPtr = Tcl_Realloc(currArrayPtr, newSize);
    } else {
	/*
	 * envPtr->literalArrayPtr isn't a Tcl_Alloc'd pointer, so we must
	 * code a Tcl_Realloc equivalent for ourselves.
	 */

	newArrayPtr = Tcl_Alloc(newSize);
	memcpy(newArrayPtr, currArrayPtr, currBytes);
	envPtr->mallocedLiteralArray = 1;
    }

    /*
     * Update the local literal table's bucket array.
     */
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822

823
824
825
826
827
828
829
830
				 * previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr;
    register LiteralEntry *entryPtr, *prevPtr;
    const char *bytes;
    int length;
    unsigned int index;

    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = TclGetStringFromObj(objPtr, &length);

    index = (HashString(bytes, length) & globalTablePtr->mask);

    /*
     * Check to see if the object is in the global literal table and remove
     * this reference. The object may not be in the table if it is a hidden
     * local literal.
     */








|
<






|
>
|







810
811
812
813
814
815
816
817

818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
				 * previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr;
    register LiteralEntry *entryPtr, *prevPtr;
    const char *bytes;
    size_t length, index;


    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = TclGetString(objPtr);
    length = objPtr->length;
    index = HashString(bytes, length) & globalTablePtr->mask;

    /*
     * Check to see if the object is in the global literal table and remove
     * this reference. The object may not be in the table if it is a hidden
     * local literal.
     */

839
840
841
842
843
844
845
846
847
848
849
850
851
852
853

	    if (entryPtr->refCount-- <= 1) {
		if (prevPtr == NULL) {
		    globalTablePtr->buckets[index] = entryPtr->nextPtr;
		} else {
		    prevPtr->nextPtr = entryPtr->nextPtr;
		}
		ckfree(entryPtr);
		globalTablePtr->numEntries--;

		TclDecrRefCount(objPtr);

#ifdef TCL_COMPILE_STATS
		iPtr->stats.currentLitStringBytes -= (double) (length + 1);
#endif /*TCL_COMPILE_STATS*/







|







842
843
844
845
846
847
848
849
850
851
852
853
854
855
856

	    if (entryPtr->refCount-- <= 1) {
		if (prevPtr == NULL) {
		    globalTablePtr->buckets[index] = entryPtr->nextPtr;
		} else {
		    prevPtr->nextPtr = entryPtr->nextPtr;
		}
		Tcl_Free(entryPtr);
		globalTablePtr->numEntries--;

		TclDecrRefCount(objPtr);

#ifdef TCL_COMPILE_STATS
		iPtr->stats.currentLitStringBytes -= (double) (length + 1);
#endif /*TCL_COMPILE_STATS*/
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static unsigned
HashString(
    register const char *string,	/* String for which to compute hash value. */
    int length)			/* Number of bytes in the string. */
{
    register unsigned int result = 0;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:







|


|

|







880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
HashString(
    register const char *string,	/* String for which to compute hash value. */
    size_t length)			/* Number of bytes in the string. */
{
    register size_t result = 0;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994

995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
				/* Local or global table to enlarge. */
{
    LiteralEntry **oldBuckets;
    register LiteralEntry **oldChainPtr, **newChainPtr;
    register LiteralEntry *entryPtr;
    LiteralEntry **bucketPtr;
    const char *bytes;
    unsigned int oldSize, index;
    int count, length;

    oldSize = tablePtr->numBuckets;
    oldBuckets = tablePtr->buckets;

    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
     */

    if (oldSize > UINT_MAX/(4 * sizeof(LiteralEntry *))) {
	/*
	 * Memory allocator limitations will not let us create the
	 * next larger table size.  Best option is to limp along
	 * with what we have.
	 */

	return;
    }

    tablePtr->numBuckets *= 4;
    tablePtr->buckets = ckalloc(tablePtr->numBuckets * sizeof(LiteralEntry*));
    for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
	    count>0 ; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;
    tablePtr->mask = (tablePtr->mask << 2) + 3;

    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) {
	for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) {
	    bytes = TclGetStringFromObj(entryPtr->objPtr, &length);

	    index = (HashString(bytes, length) & tablePtr->mask);

	    *oldChainPtr = entryPtr->nextPtr;
	    bucketPtr = &tablePtr->buckets[index];
	    entryPtr->nextPtr = *bucketPtr;
	    *bucketPtr = entryPtr;
	}
    }

    /*
     * Free up the old bucket array, if it was dynamically allocated.
     */

    if (oldBuckets != tablePtr->staticBuckets) {
	ckfree(oldBuckets);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvalidateCmdLiteral --







|
<




















|













|
>














|







954
955
956
957
958
959
960
961

962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
				/* Local or global table to enlarge. */
{
    LiteralEntry **oldBuckets;
    register LiteralEntry **oldChainPtr, **newChainPtr;
    register LiteralEntry *entryPtr;
    LiteralEntry **bucketPtr;
    const char *bytes;
    size_t oldSize, count, index, length;


    oldSize = tablePtr->numBuckets;
    oldBuckets = tablePtr->buckets;

    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
     */

    if (oldSize > UINT_MAX/(4 * sizeof(LiteralEntry *))) {
	/*
	 * Memory allocator limitations will not let us create the
	 * next larger table size.  Best option is to limp along
	 * with what we have.
	 */

	return;
    }

    tablePtr->numBuckets *= 4;
    tablePtr->buckets = Tcl_Alloc(tablePtr->numBuckets * sizeof(LiteralEntry*));
    for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
	    count>0 ; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;
    tablePtr->mask = (tablePtr->mask << 2) + 3;

    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) {
	for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) {
	    bytes = TclGetString(entryPtr->objPtr);
	    length = entryPtr->objPtr->length;
	    index = (HashString(bytes, length) & tablePtr->mask);

	    *oldChainPtr = entryPtr->nextPtr;
	    bucketPtr = &tablePtr->buckets[index];
	    entryPtr->nextPtr = *bucketPtr;
	    *bucketPtr = entryPtr;
	}
    }

    /*
     * Free up the old bucket array, if it was dynamically allocated.
     */

    if (oldBuckets != tablePtr->staticBuckets) {
	Tcl_Free(oldBuckets);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvalidateCmdLiteral --
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = ckalloc(NUM_COUNTERS*60 + 300);
    sprintf(result, "%d entries in table, %d buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i=0 ; i<NUM_COUNTERS ; i++) {
	sprintf(p, "number of buckets with %d entries: %d\n",
		i, count[i]);
	p += strlen(p);
    }







|
|







1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = Tcl_Alloc(NUM_COUNTERS*60 + 300);
    sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i=0 ; i<NUM_COUNTERS ; i++) {
	sprintf(p, "number of buckets with %d entries: %d\n",
		i, count[i]);
	p += strlen(p);
    }
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167

1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
TclVerifyLocalLiteralTable(
    CompileEnv *envPtr)		/* Points to CompileEnv whose literal table is
				 * to be validated. */
{
    register LiteralTable *localTablePtr = &envPtr->localLitTable;
    register LiteralEntry *localPtr;
    char *bytes;
    register int i;
    int length, count;

    count = 0;
    for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
		localPtr=localPtr->nextPtr) {
	    count++;
	    if (localPtr->refCount != -1) {
		bytes = TclGetStringFromObj(localPtr->objPtr, &length);

		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : length), bytes, localPtr->refCount);
	    }
	    if (localPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyLocalLiteralTable");
	    }
	}
    }







<
|

<





|
>
|

|







1154
1155
1156
1157
1158
1159
1160

1161
1162

1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
TclVerifyLocalLiteralTable(
    CompileEnv *envPtr)		/* Points to CompileEnv whose literal table is
				 * to be validated. */
{
    register LiteralTable *localTablePtr = &envPtr->localLitTable;
    register LiteralEntry *localPtr;
    char *bytes;

    size_t i, length, count = 0;


    for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
		localPtr=localPtr->nextPtr) {
	    count++;
	    if (localPtr->refCount != -1) {
		bytes = TclGetString(localPtr->objPtr);
		length = localPtr->objPtr->length;
		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : (int) length), bytes, localPtr->refCount);
	    }
	    if (localPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyLocalLiteralTable");
	    }
	}
    }
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218

1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
TclVerifyGlobalLiteralTable(
    Interp *iPtr)		/* Points to interpreter whose global literal
				 * table is to be validated. */
{
    register LiteralTable *globalTablePtr = &iPtr->literalTable;
    register LiteralEntry *globalPtr;
    char *bytes;
    register int i;
    int length, count;

    count = 0;
    for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
		globalPtr=globalPtr->nextPtr) {
	    count++;
	    if (globalPtr->refCount < 1) {
		bytes = TclGetStringFromObj(globalPtr->objPtr, &length);

		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
			"TclVerifyGlobalLiteralTable",
			(length>60? 60 : length), bytes, globalPtr->refCount);
	    }
	    if (globalPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyGlobalLiteralTable");
	    }
	}
    }







<
|

<





|
>


|







1204
1205
1206
1207
1208
1209
1210

1211
1212

1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
TclVerifyGlobalLiteralTable(
    Interp *iPtr)		/* Points to interpreter whose global literal
				 * table is to be validated. */
{
    register LiteralTable *globalTablePtr = &iPtr->literalTable;
    register LiteralEntry *globalPtr;
    char *bytes;

    size_t i, length, count = 0;


    for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
		globalPtr=globalPtr->nextPtr) {
	    count++;
	    if (globalPtr->refCount < 1) {
		bytes = TclGetString(globalPtr->objPtr);
		length = globalPtr->objPtr->length;
		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
			"TclVerifyGlobalLiteralTable",
			(length>60? 60 : (int)length), bytes, globalPtr->refCount);
	    }
	    if (globalPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyGlobalLiteralTable");
	    }
	}
    }
Changes to generic/tclLoad.c.
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 */

	pkgPtr = ckalloc(sizeof(LoadedPackage));
	len = strlen(fullFileName) + 1;
	pkgPtr->fileName	   = ckalloc(len);
	memcpy(pkgPtr->fileName, fullFileName, len);
	len = (unsigned) Tcl_DStringLength(&pkgName) + 1;
	pkgPtr->packageName	   = ckalloc(len);
	memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
	pkgPtr->loadHandle	   = loadHandle;
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeInitName));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc *)







|

|


|







397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 */

	pkgPtr = Tcl_Alloc(sizeof(LoadedPackage));
	len = strlen(fullFileName) + 1;
	pkgPtr->fileName	   = Tcl_Alloc(len);
	memcpy(pkgPtr->fileName, fullFileName, len);
	len = (unsigned) Tcl_DStringLength(&pkgName) + 1;
	pkgPtr->packageName	   = Tcl_Alloc(len);
	memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
	pkgPtr->loadHandle	   = loadHandle;
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeInitName));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc *)
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516

    /*
     * Refetch ipFirstPtr: loading the package may have introduced additional
     * static packages at the head of the linked list!
     */

    ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
    ipPtr = ckalloc(sizeof(InterpPackage));
    ipPtr->pkgPtr = pkgPtr;
    ipPtr->nextPtr = ipFirstPtr;
    Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&initName);







|







502
503
504
505
506
507
508
509
510
511
512
513
514
515
516

    /*
     * Refetch ipFirstPtr: loading the package may have introduced additional
     * static packages at the head of the linked list!
     */

    ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
    ipPtr = Tcl_Alloc(sizeof(InterpPackage));
    ipPtr->pkgPtr = pkgPtr;
    ipPtr->nextPtr = ipFirstPtr;
    Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&initName);
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
			    ipPrevPtr->nextPtr = ipPtr->nextPtr;
			    break;
			}
		    }
		}
		Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
			ipFirstPtr);
		ckfree(defaultPtr->fileName);
		ckfree(defaultPtr->packageName);
		ckfree(defaultPtr);
		ckfree(ipPtr);
		Tcl_MutexUnlock(&packageMutex);
	    } else {
		code = TCL_ERROR;
	    }
	}
#else
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|
|
|
|







886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
			    ipPrevPtr->nextPtr = ipPtr->nextPtr;
			    break;
			}
		    }
		}
		Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
			ipFirstPtr);
		Tcl_Free(defaultPtr->fileName);
		Tcl_Free(defaultPtr->packageName);
		Tcl_Free(defaultPtr);
		Tcl_Free(ipPtr);
		Tcl_MutexUnlock(&packageMutex);
	    } else {
		code = TCL_ERROR;
	    }
	}
#else
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993

    /*
     * If the package is not yet recorded as being loaded statically, add it
     * to the list now.
     */

    if (pkgPtr == NULL) {
	pkgPtr = ckalloc(sizeof(LoadedPackage));
	pkgPtr->fileName	= ckalloc(1);
	pkgPtr->fileName[0]	= 0;
	pkgPtr->packageName	= ckalloc(strlen(pkgName) + 1);
	strcpy(pkgPtr->packageName, pkgName);
	pkgPtr->loadHandle	= NULL;
	pkgPtr->initProc	= initProc;
	pkgPtr->safeInitProc	= safeInitProc;
	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		= firstPackagePtr;
	firstPackagePtr		= pkgPtr;







|
|

|







976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993

    /*
     * If the package is not yet recorded as being loaded statically, add it
     * to the list now.
     */

    if (pkgPtr == NULL) {
	pkgPtr = Tcl_Alloc(sizeof(LoadedPackage));
	pkgPtr->fileName	= Tcl_Alloc(1);
	pkgPtr->fileName[0]	= 0;
	pkgPtr->packageName	= Tcl_Alloc(strlen(pkgName) + 1);
	strcpy(pkgPtr->packageName, pkgName);
	pkgPtr->loadHandle	= NULL;
	pkgPtr->initProc	= initProc;
	pkgPtr->safeInitProc	= safeInitProc;
	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		= firstPackagePtr;
	firstPackagePtr		= pkgPtr;
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
	}

	/*
	 * Package isn't loaded in the current interp yet. Mark it as now being
	 * loaded.
	 */

	ipPtr = ckalloc(sizeof(InterpPackage));
	ipPtr->pkgPtr = pkgPtr;
	ipPtr->nextPtr = ipFirstPtr;
	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
    }
}

/*







|







1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
	}

	/*
	 * Package isn't loaded in the current interp yet. Mark it as now being
	 * loaded.
	 */

	ipPtr = Tcl_Alloc(sizeof(InterpPackage));
	ipPtr->pkgPtr = pkgPtr;
	ipPtr->nextPtr = ipFirstPtr;
	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
    }
}

/*
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
    Tcl_Interp *interp)		/* Interpreter that is being deleted. */
{
    InterpPackage *ipPtr, *nextPtr;

    ipPtr = clientData;
    while (ipPtr != NULL) {
	nextPtr = ipPtr->nextPtr;
	ckfree(ipPtr);
	ipPtr = nextPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
    Tcl_Interp *interp)		/* Interpreter that is being deleted. */
{
    InterpPackage *ipPtr, *nextPtr;

    ipPtr = clientData;
    while (ipPtr != NULL) {
	nextPtr = ipPtr->nextPtr;
	Tcl_Free(ipPtr);
	ipPtr = nextPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
	 */

	if (pkgPtr->fileName[0] != '\0') {
	    Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
	}
#endif

	ckfree(pkgPtr->fileName);
	ckfree(pkgPtr->packageName);
	ckfree(pkgPtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|
|
|










1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
	 */

	if (pkgPtr->fileName[0] != '\0') {
	    Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
	}
#endif

	Tcl_Free(pkgPtr->fileName);
	Tcl_Free(pkgPtr->packageName);
	Tcl_Free(pkgPtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclMain.c.
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
	    is.prompt = PROMPT_START;

	    /*
	     * The final newline is syntactically redundant, and causes some
	     * error messages troubles deeper in, so lop it back off.
	     */

	    TclGetStringFromObj(is.commandPtr, &length);
	    Tcl_SetObjLength(is.commandPtr, --length);
	    code = Tcl_RecordAndEvalObj(interp, is.commandPtr,
		    TCL_EVAL_GLOBAL);
	    is.input = Tcl_GetStdChannel(TCL_STDIN);
	    Tcl_DecrRefCount(is.commandPtr);
	    is.commandPtr = Tcl_NewObj();
	    Tcl_IncrRefCount(is.commandPtr);
	    if (code != TCL_OK) {
		chan = Tcl_GetStdChannel(TCL_STDERR);
		if (chan) {
		    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
		    Tcl_WriteChars(chan, "\n", 1);
		}
	    } else if (is.tty) {
		resultPtr = Tcl_GetObjResult(interp);
		Tcl_IncrRefCount(resultPtr);
		TclGetStringFromObj(resultPtr, &length);
		chan = Tcl_GetStdChannel(TCL_STDOUT);
		if ((length > 0) && chan) {
		    Tcl_WriteObj(chan, resultPtr);
		    Tcl_WriteChars(chan, "\n", 1);
		}
		Tcl_DecrRefCount(resultPtr);
	    }







|
















|







528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
	    is.prompt = PROMPT_START;

	    /*
	     * The final newline is syntactically redundant, and causes some
	     * error messages troubles deeper in, so lop it back off.
	     */

	    (void)TclGetStringFromObj(is.commandPtr, &length);
	    Tcl_SetObjLength(is.commandPtr, --length);
	    code = Tcl_RecordAndEvalObj(interp, is.commandPtr,
		    TCL_EVAL_GLOBAL);
	    is.input = Tcl_GetStdChannel(TCL_STDIN);
	    Tcl_DecrRefCount(is.commandPtr);
	    is.commandPtr = Tcl_NewObj();
	    Tcl_IncrRefCount(is.commandPtr);
	    if (code != TCL_OK) {
		chan = Tcl_GetStdChannel(TCL_STDERR);
		if (chan) {
		    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
		    Tcl_WriteChars(chan, "\n", 1);
		}
	    } else if (is.tty) {
		resultPtr = Tcl_GetObjResult(interp);
		Tcl_IncrRefCount(resultPtr);
		(void)TclGetStringFromObj(resultPtr, &length);
		chan = Tcl_GetStdChannel(TCL_STDOUT);
		if ((length > 0) && chan) {
		    Tcl_WriteObj(chan, resultPtr);
		    Tcl_WriteChars(chan, "\n", 1);
		}
		Tcl_DecrRefCount(resultPtr);
	    }
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
    }
    Tcl_AppendToObj(commandPtr, "\n", 1);
    if (!TclObjCommandComplete(commandPtr)) {
	isPtr->prompt = PROMPT_CONTINUE;
	goto prompt;
    }
    isPtr->prompt = PROMPT_START;
    TclGetStringFromObj(commandPtr, &length);
    Tcl_SetObjLength(commandPtr, --length);

    /*
     * Disable the stdin channel handler while evaluating the command;
     * otherwise if the command re-enters the event loop we might process
     * commands from stdin before the current command is finished. Among other
     * things, this will trash the text of the command being evaluated.







|







789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
    }
    Tcl_AppendToObj(commandPtr, "\n", 1);
    if (!TclObjCommandComplete(commandPtr)) {
	isPtr->prompt = PROMPT_CONTINUE;
	goto prompt;
    }
    isPtr->prompt = PROMPT_START;
    (void)TclGetStringFromObj(commandPtr, &length);
    Tcl_SetObjLength(commandPtr, --length);

    /*
     * Disable the stdin channel handler while evaluating the command;
     * otherwise if the command re-enters the event loop we might process
     * commands from stdin before the current command is finished. Among other
     * things, this will trash the text of the command being evaluated.
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
	    Tcl_WriteChars(chan, "\n", 1);
	}
    } else if (isPtr->tty) {
	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	chan = Tcl_GetStdChannel(TCL_STDOUT);

	Tcl_IncrRefCount(resultPtr);
	TclGetStringFromObj(resultPtr, &length);
	if ((length > 0) && (chan != NULL)) {
	    Tcl_WriteObj(chan, resultPtr);
	    Tcl_WriteChars(chan, "\n", 1);
	}
	Tcl_DecrRefCount(resultPtr);
    }








|







820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
	    Tcl_WriteChars(chan, "\n", 1);
	}
    } else if (isPtr->tty) {
	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	chan = Tcl_GetStdChannel(TCL_STDOUT);

	Tcl_IncrRefCount(resultPtr);
	(void)TclGetStringFromObj(resultPtr, &length);
	if ((length > 0) && (chan != NULL)) {
	    Tcl_WriteObj(chan, resultPtr);
	    Tcl_WriteChars(chan, "\n", 1);
	}
	Tcl_DecrRefCount(resultPtr);
    }

Changes to generic/tclNamesp.c.
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
			    const char *name2, int flags);
static char *		EstablishErrorInfoTraces(ClientData clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static void		FreeNsNameInternalRep(Tcl_Obj *objPtr);
static int		GetNamespaceFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
static int		InvokeImportedCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		InvokeImportedNRCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceChildrenCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceCodeCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceCurrentCmd(ClientData dummy,







<
<







85
86
87
88
89
90
91


92
93
94
95
96
97
98
			    const char *name2, int flags);
static char *		EstablishErrorInfoTraces(ClientData clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static void		FreeNsNameInternalRep(Tcl_Obj *objPtr);
static int		GetNamespaceFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);


static int		InvokeImportedNRCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceChildrenCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceCodeCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceCurrentCmd(ClientData dummy,
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
	iPtr->varFramePtr = framePtr->callerVarPtr;
    } else {
	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
    }

    if (framePtr->varTablePtr != NULL) {
	TclDeleteVars(iPtr, framePtr->varTablePtr);
	ckfree(framePtr->varTablePtr);
	framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals > 0) {
	TclDeleteCompiledLocalVars(iPtr, framePtr);
	if (framePtr->localCachePtr->refCount-- <= 1) {
	    TclFreeLocalCache(interp, framePtr->localCachePtr);
	}
	framePtr->localCachePtr = NULL;
    }

    /*
     * Decrement the namespace's count of active call frames. If the namespace
     * is "dying" and there are no more active call frames, call
     * Tcl_DeleteNamespace to destroy it.
     */

    nsPtr = framePtr->nsPtr;
    nsPtr->activationCount--;
    if ((nsPtr->flags & NS_DYING)
	    && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;

    if (framePtr->tailcallPtr) {
	TclSetTailcall(interp, framePtr->tailcallPtr);
    }







|

















|
|
<







391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417

418
419
420
421
422
423
424
	iPtr->varFramePtr = framePtr->callerVarPtr;
    } else {
	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
    }

    if (framePtr->varTablePtr != NULL) {
	TclDeleteVars(iPtr, framePtr->varTablePtr);
	Tcl_Free(framePtr->varTablePtr);
	framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals > 0) {
	TclDeleteCompiledLocalVars(iPtr, framePtr);
	if (framePtr->localCachePtr->refCount-- <= 1) {
	    TclFreeLocalCache(interp, framePtr->localCachePtr);
	}
	framePtr->localCachePtr = NULL;
    }

    /*
     * Decrement the namespace's count of active call frames. If the namespace
     * is "dying" and there are no more active call frames, call
     * Tcl_DeleteNamespace to destroy it.
     */

    nsPtr = framePtr->nsPtr;
    if ((--nsPtr->activationCount <= (nsPtr == iPtr->globalNsPtr))
	    && (nsPtr->flags & NS_DYING)) {

	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;

    if (framePtr->tailcallPtr) {
	TclSetTailcall(interp, framePtr->tailcallPtr);
    }
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782

    /*
     * Create the new namespace and root it in its parent. Increment the count
     * of namespaces created.
     */

  doCreate:
    nsPtr = ckalloc(sizeof(Namespace));
    nameLen = strlen(simpleName) + 1;
    nsPtr->name = ckalloc(nameLen);
    memcpy(nsPtr->name, simpleName, nameLen);
    nsPtr->fullName = NULL;		/* Set below. */
    nsPtr->clientData = clientData;
    nsPtr->deleteProc = deleteProc;
    nsPtr->parentPtr = parentPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);







|

|







763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779

    /*
     * Create the new namespace and root it in its parent. Increment the count
     * of namespaces created.
     */

  doCreate:
    nsPtr = Tcl_Alloc(sizeof(Namespace));
    nameLen = strlen(simpleName) + 1;
    nsPtr->name = Tcl_Alloc(nameLen);
    memcpy(nsPtr->name, simpleName, nameLen);
    nsPtr->fullName = NULL;		/* Set below. */
    nsPtr->clientData = clientData;
    nsPtr->deleteProc = deleteProc;
    nsPtr->parentPtr = parentPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
	    namePtr = buffPtr;
	    buffPtr = tempPtr;
	}
    }

    name = Tcl_DStringValue(namePtr);
    nameLen = Tcl_DStringLength(namePtr);
    nsPtr->fullName = ckalloc(nameLen + 1);
    memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);

    Tcl_DStringFree(&buffer1);
    Tcl_DStringFree(&buffer2);
    Tcl_DStringFree(&tmpBuffer);

    /*







|







853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
	    namePtr = buffPtr;
	    buffPtr = tempPtr;
	}
    }

    name = Tcl_DStringValue(namePtr);
    nameLen = Tcl_DStringLength(namePtr);
    nsPtr->fullName = Tcl_Alloc(nameLen + 1);
    memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);

    Tcl_DStringFree(&buffer1);
    Tcl_DStringFree(&buffer2);
    Tcl_DStringFree(&tmpBuffer);

    /*
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
     * namespace's commands and variables are deleted but the structure isn't
     * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the
     * namespace resolution code to recognize that the namespace is "deleted".
     * The structure's storage is freed by FreeNsNameInternalRep when its
     * refCount reaches 0.
     */

    if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
	nsPtr->flags |= NS_DYING;
	if (nsPtr->parentPtr != NULL) {
	    entryPtr = Tcl_FindHashEntry(
		    TclGetNamespaceChildTable((Tcl_Namespace *)
			    nsPtr->parentPtr), nsPtr->name);
	    if (entryPtr != NULL) {
		Tcl_DeleteHashEntry(entryPtr);







|







1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
     * namespace's commands and variables are deleted but the structure isn't
     * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the
     * namespace resolution code to recognize that the namespace is "deleted".
     * The structure's storage is freed by FreeNsNameInternalRep when its
     * refCount reaches 0.
     */

    if (nsPtr->activationCount > (nsPtr == globalNsPtr)) {
	nsPtr->flags |= NS_DYING;
	if (nsPtr->parentPtr != NULL) {
	    entryPtr = Tcl_FindHashEntry(
		    TclGetNamespaceChildTable((Tcl_Namespace *)
			    nsPtr->parentPtr), nsPtr->name);
	    if (entryPtr != NULL) {
		Tcl_DeleteHashEntry(entryPtr);
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
	    TclDeleteNamespaceVars(nsPtr);

#ifndef BREAK_NAMESPACE_COMPAT
	    Tcl_DeleteHashTable(&nsPtr->childTable);
#else
	    if (nsPtr->childTablePtr != NULL) {
		Tcl_DeleteHashTable(nsPtr->childTablePtr);
		ckfree(nsPtr->childTablePtr);
	    }
#endif
	    Tcl_DeleteHashTable(&nsPtr->cmdTable);

	    nsPtr ->flags |= NS_DEAD;
	} else {
	    /*







|







1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
	    TclDeleteNamespaceVars(nsPtr);

#ifndef BREAK_NAMESPACE_COMPAT
	    Tcl_DeleteHashTable(&nsPtr->childTable);
#else
	    if (nsPtr->childTablePtr != NULL) {
		Tcl_DeleteHashTable(nsPtr->childTablePtr);
		Tcl_Free(nsPtr->childTablePtr);
	    }
#endif
	    Tcl_DeleteHashTable(&nsPtr->cmdTable);

	    nsPtr ->flags |= NS_DEAD;
	} else {
	    /*
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
TclTeardownNamespace(
    register Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    int i;

    /*
     * Start by destroying the namespace's variable table, since variables
     * might trigger traces. Variable table should be cleared but not freed!
     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
     */

    TclDeleteNamespaceVars(nsPtr);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    /*
     * Delete all commands in this namespace. Be careful when traversing the
     * hash table: when each command is deleted, it removes itself from the
     * command table. Because of traces (and the desire to avoid the quadratic
     * problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * commands.
     */

    while (nsPtr->cmdTable.numEntries > 0) {
	int length = nsPtr->cmdTable.numEntries;
	Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Command *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {







|




















|







1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
TclTeardownNamespace(
    register Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    size_t i;

    /*
     * Start by destroying the namespace's variable table, since variables
     * might trigger traces. Variable table should be cleared but not freed!
     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
     */

    TclDeleteNamespaceVars(nsPtr);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    /*
     * Delete all commands in this namespace. Be careful when traversing the
     * hash table: when each command is deleted, it removes itself from the
     * command table. Because of traces (and the desire to avoid the quadratic
     * problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * commands.
     */

    while (nsPtr->cmdTable.numEntries > 0) {
	size_t length = nsPtr->cmdTable.numEntries;
	Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Command *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
     * namespaces.
     *
     * Important: leave the hash table itself still live.
     */

#ifndef BREAK_NAMESPACE_COMPAT
    while (nsPtr->childTable.numEntries > 0) {
	int length = nsPtr->childTable.numEntries;
	Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Namespace *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {







|







1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
     * namespaces.
     *
     * Important: leave the hash table itself still live.
     */

#ifndef BREAK_NAMESPACE_COMPAT
    while (nsPtr->childTable.numEntries > 0) {
	size_t length = nsPtr->childTable.numEntries;
	Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Namespace *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255

    /*
     * Free the namespace's export pattern array.
     */

    if (nsPtr->exportArrayPtr != NULL) {
	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
	    ckfree(nsPtr->exportArrayPtr[i]);
	}
	ckfree(nsPtr->exportArrayPtr);
	nsPtr->exportArrayPtr = NULL;
	nsPtr->numExportPatterns = 0;
	nsPtr->maxExportPatterns = 0;
    }

    /*
     * Free any client data associated with the namespace.







|

|







1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252

    /*
     * Free the namespace's export pattern array.
     */

    if (nsPtr->exportArrayPtr != NULL) {
	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
	    Tcl_Free(nsPtr->exportArrayPtr[i]);
	}
	Tcl_Free(nsPtr->exportArrayPtr);
	nsPtr->exportArrayPtr = NULL;
	nsPtr->numExportPatterns = 0;
	nsPtr->maxExportPatterns = 0;
    }

    /*
     * Free any client data associated with the namespace.
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
{
    /*
     * Most of the namespace's contents are freed when the namespace is
     * deleted by Tcl_DeleteNamespace. All that remains is to free its names
     * (for error messages), and the structure itself.
     */

    ckfree(nsPtr->name);
    ckfree(nsPtr->fullName);
    ckfree(nsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNsDecrRefCount --
 *







|
|
|







1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
{
    /*
     * Most of the namespace's contents are freed when the namespace is
     * deleted by Tcl_DeleteNamespace. All that remains is to free its names
     * (for error messages), and the structure itself.
     */

    Tcl_Free(nsPtr->name);
    Tcl_Free(nsPtr->fullName);
    Tcl_Free(nsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNsDecrRefCount --
 *
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
				 * list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
    Namespace *nsPtr, *exportNsPtr, *dummyPtr;
    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    const char *simplePattern;
    char *patternCpy;
    int neededElems, len, i;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) currNsPtr;
    } else {
	nsPtr = (Namespace *) namespacePtr;
    }

    /*
     * If resetListFirst is true (nonzero), clear the namespace's export
     * pattern list.
     */

    if (resetListFirst) {
	if (nsPtr->exportArrayPtr != NULL) {
	    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
		ckfree(nsPtr->exportArrayPtr[i]);
	    }
	    ckfree(nsPtr->exportArrayPtr);
	    nsPtr->exportArrayPtr = NULL;
	    TclInvalidateNsCmdLookup(nsPtr);
	    nsPtr->numExportPatterns = 0;
	    nsPtr->maxExportPatterns = 0;
	}
    }








|



















|

|







1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
				 * list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
    Namespace *nsPtr, *exportNsPtr, *dummyPtr;
    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    const char *simplePattern;
    char *patternCpy;
    size_t neededElems, len, i;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) currNsPtr;
    } else {
	nsPtr = (Namespace *) namespacePtr;
    }

    /*
     * If resetListFirst is true (nonzero), clear the namespace's export
     * pattern list.
     */

    if (resetListFirst) {
	if (nsPtr->exportArrayPtr != NULL) {
	    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
		Tcl_Free(nsPtr->exportArrayPtr[i]);
	    }
	    Tcl_Free(nsPtr->exportArrayPtr);
	    nsPtr->exportArrayPtr = NULL;
	    TclInvalidateNsCmdLookup(nsPtr);
	    nsPtr->numExportPatterns = 0;
	    nsPtr->maxExportPatterns = 0;
	}
    }

1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
     * pattern.
     */

    neededElems = nsPtr->numExportPatterns + 1;
    if (neededElems > nsPtr->maxExportPatterns) {
	nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ?
		2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS;
	nsPtr->exportArrayPtr = ckrealloc(nsPtr->exportArrayPtr,
		sizeof(char *) * nsPtr->maxExportPatterns);
    }

    /*
     * Add the pattern to the namespace's array of export patterns.
     */

    len = strlen(pattern);
    patternCpy = ckalloc(len + 1);
    memcpy(patternCpy, pattern, (unsigned) len + 1);

    nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
    nsPtr->numExportPatterns++;

    /*
     * The list of commands actually exported from the namespace might have







|








|







1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
     * pattern.
     */

    neededElems = nsPtr->numExportPatterns + 1;
    if (neededElems > nsPtr->maxExportPatterns) {
	nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ?
		2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS;
	nsPtr->exportArrayPtr = Tcl_Realloc(nsPtr->exportArrayPtr,
		sizeof(char *) * nsPtr->maxExportPatterns);
    }

    /*
     * Add the pattern to the namespace's array of export patterns.
     */

    len = strlen(pattern);
    patternCpy = Tcl_Alloc(len + 1);
    memcpy(patternCpy, pattern, (unsigned) len + 1);

    nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
    nsPtr->numExportPatterns++;

    /*
     * The list of commands actually exported from the namespace might have
1491
1492
1493
1494
1495
1496
1497

1498
1499
1500
1501
1502
1503
1504
1505
    Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
				 * pattern list is appended onto objPtr. NULL
				 * for the current namespace. */
    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
				 * export pattern list is appended. */
{
    Namespace *nsPtr;

    int i, result;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);







>
|







1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
    Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
				 * pattern list is appended onto objPtr. NULL
				 * for the current namespace. */
    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
				 * export pattern list is appended. */
{
    Namespace *nsPtr;
    size_t i;
    int result;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
    Namespace *nsPtr,
    Tcl_HashEntry *hPtr,
    const char *cmdName,
    const char *pattern,
    Namespace *importNsPtr,
    int allowOverwrite)
{
    int i = 0, exported = 0;
    Tcl_HashEntry *found;

    /*
     * The command cmdName in the source namespace matches the pattern. Check
     * whether it was exported. If it wasn't, we ignore it.
     */








|







1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
    Namespace *nsPtr,
    Tcl_HashEntry *hPtr,
    const char *cmdName,
    const char *pattern,
    Namespace *importNsPtr,
    int allowOverwrite)
{
    size_t i = 0, exported = 0;
    Tcl_HashEntry *found;

    /*
     * The command cmdName in the source namespace matches the pattern. Check
     * whether it was exported. If it wasn't, we ignore it.
     */

1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
		    Tcl_DStringFree(&ds);
		    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL);
		    return TCL_ERROR;
		}
	    }
	}

	dataPtr = ckalloc(sizeof(ImportedCmdData));
	importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
		InvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
		DeleteImportedCmd);
	dataPtr->realCmdPtr = cmdPtr;
	dataPtr->selfPtr = (Command *) importedCmd;
	dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
	Tcl_DStringFree(&ds);

	/*
	 * Create an ImportRef structure describing this new import command
	 * and add it to the import ref list in the "real" command.
	 */

	refPtr = ckalloc(sizeof(ImportRef));
	refPtr->importedCmdPtr = (Command *) importedCmd;
	refPtr->nextPtr = cmdPtr->importRefPtr;
	cmdPtr->importRefPtr = refPtr;
    } else {
	Command *overwrite = Tcl_GetHashValue(found);

	if (overwrite->deleteProc == DeleteImportedCmd) {







|

|











|







1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
		    Tcl_DStringFree(&ds);
		    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL);
		    return TCL_ERROR;
		}
	    }
	}

	dataPtr = Tcl_Alloc(sizeof(ImportedCmdData));
	importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
		TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
		DeleteImportedCmd);
	dataPtr->realCmdPtr = cmdPtr;
	dataPtr->selfPtr = (Command *) importedCmd;
	dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
	Tcl_DStringFree(&ds);

	/*
	 * Create an ImportRef structure describing this new import command
	 * and add it to the import ref list in the "real" command.
	 */

	refPtr = Tcl_Alloc(sizeof(ImportRef));
	refPtr->importedCmdPtr = (Command *) importedCmd;
	refPtr->nextPtr = cmdPtr->importRefPtr;
	cmdPtr->importRefPtr = refPtr;
    } else {
	Command *overwrite = Tcl_GetHashValue(found);

	if (overwrite->deleteProc == DeleteImportedCmd) {
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
    }
    return (Tcl_Command) cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeImportedCmd --
 *
 *	Invoked by Tcl whenever the user calls an imported command that was
 *	created by Tcl_Import. Finds the "real" command (in another
 *	namespace), and passes control to it.
 *
 * Results:
 *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.







|







1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
    }
    return (Tcl_Command) cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvokeImportedCmd --
 *
 *	Invoked by Tcl whenever the user calls an imported command that was
 *	created by Tcl_Import. Finds the "real" command (in another
 *	namespace), and passes control to it.
 *
 * Results:
 *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
    ImportedCmdData *dataPtr = clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;

    TclSkipTailcall(interp);
    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}

static int
InvokeImportedCmd(
    ClientData clientData,	/* Points to the imported command's
				 * ImportedCmdData structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    return Tcl_NRCallObjProc(interp, InvokeImportedNRCmd, clientData,







|
|







2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
    ImportedCmdData *dataPtr = clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;

    TclSkipTailcall(interp);
    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}

int
TclInvokeImportedCmd(
    ClientData clientData,	/* Points to the imported command's
				 * ImportedCmdData structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    return Tcl_NRCallObjProc(interp, InvokeImportedNRCmd, clientData,
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
	     */

	    if (prevPtr == NULL) { /* refPtr is first in list. */
		realCmdPtr->importRefPtr = refPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = refPtr->nextPtr;
	    }
	    ckfree(refPtr);
	    ckfree(dataPtr);
	    return;
	}
	prevPtr = refPtr;
    }

    Tcl_Panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
}







|
|







2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
	     */

	    if (prevPtr == NULL) { /* refPtr is first in list. */
		realCmdPtr->importRefPtr = refPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = refPtr->nextPtr;
	    }
	    Tcl_Free(refPtr);
	    Tcl_Free(dataPtr);
	    return;
	}
	prevPtr = refPtr;
    }

    Tcl_Panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
}
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
    /*
     * Find the namespace(s) that contain the command.
     */

    cmdPtr = NULL;
    if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)
	    && !(flags & TCL_NAMESPACE_ONLY)) {
	int i;
	Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;

	(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
		TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		&simpleName);
	if ((realNsPtr != NULL) && (simpleName != NULL)) {
	    if ((cxtNsPtr == realNsPtr)







|







2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
    /*
     * Find the namespace(s) that contain the command.
     */

    cmdPtr = NULL;
    if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)
	    && !(flags & TCL_NAMESPACE_ONLY)) {
	size_t i;
	Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;

	(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
		TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		&simpleName);
	if ((realNsPtr != NULL) && (simpleName != NULL)) {
	    if ((cxtNsPtr == realNsPtr)
4000
4001
4002
4003
4004
4005
4006

4007
4008
4009
4010
4011
4012
4013
4014
NamespacePathCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);

    int i, nsObjc, result = TCL_ERROR;
    Tcl_Obj **nsObjv;
    Tcl_Namespace **namespaceList = NULL;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
	return TCL_ERROR;
    }







>
|







3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
NamespacePathCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    size_t i;
    int nsObjc, result = TCL_ERROR;
    Tcl_Obj **nsObjv;
    Tcl_Namespace **namespaceList = NULL;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
	return TCL_ERROR;
    }
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
    if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
	goto badNamespace;
    }
    if (nsObjc != 0) {
	namespaceList = TclStackAlloc(interp,
		sizeof(Tcl_Namespace *) * nsObjc);

	for (i=0 ; i<nsObjc ; i++) {
	    if (TclGetNamespaceFromObj(interp, nsObjv[i],
		    &namespaceList[i]) != TCL_OK) {
		goto badNamespace;
	    }
	}
    }








|







4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
    if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
	goto badNamespace;
    }
    if (nsObjc != 0) {
	namespaceList = TclStackAlloc(interp,
		sizeof(Tcl_Namespace *) * nsObjc);

	for (i=0 ; i<(size_t)nsObjc ; i++) {
	    if (TclGetNamespaceFromObj(interp, nsObjv[i],
		    &namespaceList[i]) != TCL_OK) {
		goto badNamespace;
	    }
	}
    }

4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
 *
 *----------------------------------------------------------------------
 */

void
TclSetNsPath(
    Namespace *nsPtr,		/* Namespace whose path is to be set. */
    int pathLength,		/* Length of pathAry. */
    Tcl_Namespace *pathAry[])	/* Array of namespaces that are the path. */
{
    if (pathLength != 0) {
	NamespacePathEntry *tmpPathArray =
		ckalloc(sizeof(NamespacePathEntry) * pathLength);
	int i;

	for (i=0 ; i<pathLength ; i++) {
	    tmpPathArray[i].nsPtr = (Namespace *) pathAry[i];
	    tmpPathArray[i].creatorNsPtr = nsPtr;
	    tmpPathArray[i].prevPtr = NULL;
	    tmpPathArray[i].nextPtr =
		    tmpPathArray[i].nsPtr->commandPathSourceList;







|




|
|







4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
 *
 *----------------------------------------------------------------------
 */

void
TclSetNsPath(
    Namespace *nsPtr,		/* Namespace whose path is to be set. */
    size_t pathLength,		/* Length of pathAry. */
    Tcl_Namespace *pathAry[])	/* Array of namespaces that are the path. */
{
    if (pathLength != 0) {
	NamespacePathEntry *tmpPathArray =
		Tcl_Alloc(sizeof(NamespacePathEntry) * pathLength);
	size_t i;

	for (i=0 ; i<pathLength ; i++) {
	    tmpPathArray[i].nsPtr = (Namespace *) pathAry[i];
	    tmpPathArray[i].creatorNsPtr = nsPtr;
	    tmpPathArray[i].prevPtr = NULL;
	    tmpPathArray[i].nextPtr =
		    tmpPathArray[i].nsPtr->commandPathSourceList;
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
 *----------------------------------------------------------------------
 */

static void
UnlinkNsPath(
    Namespace *nsPtr)
{
    int i;
    for (i=0 ; i<nsPtr->commandPathLength ; i++) {
	NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i];

	if (nsPathPtr->prevPtr != NULL) {
	    nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr;
	}
	if (nsPathPtr->nextPtr != NULL) {
	    nsPathPtr->nextPtr->prevPtr = nsPathPtr->prevPtr;
	}
	if (nsPathPtr->nsPtr != NULL) {
	    if (nsPathPtr->nsPtr->commandPathSourceList == nsPathPtr) {
		nsPathPtr->nsPtr->commandPathSourceList = nsPathPtr->nextPtr;
	    }
	}
    }
    ckfree(nsPtr->commandPathArray);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvalidateNsPath --
 *







|















|







4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
 *----------------------------------------------------------------------
 */

static void
UnlinkNsPath(
    Namespace *nsPtr)
{
    size_t i;
    for (i=0 ; i<nsPtr->commandPathLength ; i++) {
	NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i];

	if (nsPathPtr->prevPtr != NULL) {
	    nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr;
	}
	if (nsPathPtr->nextPtr != NULL) {
	    nsPathPtr->nextPtr->prevPtr = nsPathPtr->prevPtr;
	}
	if (nsPathPtr->nsPtr != NULL) {
	    if (nsPathPtr->nsPtr->commandPathSourceList == nsPathPtr) {
		nsPathPtr->nsPtr->commandPathSourceList = nsPathPtr->nextPtr;
	    }
	}
    }
    Tcl_Free(nsPtr->commandPathArray);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvalidateNsPath --
 *
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
	/*
	 * Decrement the reference count for the cached namespace. If the
	 * namespace is dead, and there are no more references to it, free
	 * it.
	 */

	TclNsDecrRefCount(resNamePtr->nsPtr);
	ckfree(resNamePtr);
    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *







|







4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
	/*
	 * Decrement the reference count for the cached namespace. If the
	 * namespace is dead, and there are no more references to it, free
	 * it.
	 */

	TclNsDecrRefCount(resNamePtr->nsPtr);
	Tcl_Free(resNamePtr);
    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
	if (objPtr->typePtr == &nsNameType) {
	    TclFreeIntRep(objPtr);
	}
	return TCL_ERROR;
    }

    nsPtr->refCount++;
    resNamePtr = ckalloc(sizeof(ResolvedNsName));
    resNamePtr->nsPtr = nsPtr;
    if ((name[0] == ':') && (name[1] == ':')) {
	resNamePtr->refNsPtr = NULL;
    } else {
	resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }
    resNamePtr->refCount = 1;







|







4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
	if (objPtr->typePtr == &nsNameType) {
	    TclFreeIntRep(objPtr);
	}
	return TCL_ERROR;
    }

    nsPtr->refCount++;
    resNamePtr = Tcl_Alloc(sizeof(ResolvedNsName));
    resNamePtr->nsPtr = nsPtr;
    if ((name[0] == ':') && (name[1] == ':')) {
	resNamePtr->refNsPtr = NULL;
    } else {
	resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }
    resNamePtr->refCount = 1;
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
    Tcl_Namespace *nsPtr)
{
    Namespace *nPtr = (Namespace *) nsPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    return &nPtr->childTable;
#else
    if (nPtr->childTablePtr == NULL) {
	nPtr->childTablePtr = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS);
    }
    return nPtr->childTablePtr;
#endif
}

/*







|







4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
    Tcl_Namespace *nsPtr)
{
    Namespace *nPtr = (Namespace *) nsPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    return &nPtr->childTable;
#else
    if (nPtr->childTablePtr == NULL) {
	nPtr->childTablePtr = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS);
    }
    return nPtr->childTablePtr;
#endif
}

/*
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
void
TclLogCommandInfo(
    Tcl_Interp *interp,		/* Interpreter in which to log information. */
    const char *script,		/* First character in script containing
				 * command (must be <= command). */
    const char *command,	/* First character in command that generated
				 * the error. */
    int length,			/* Number of bytes in command (-1 means use
				 * all bytes up to first null byte). */
    const unsigned char *pc,    /* Current pc of bytecode execution context */
    Tcl_Obj **tosPtr)		/* Current stack of bytecode execution
				 * context */
{
    register const char *p;
    Interp *iPtr = (Interp *) interp;
    int overflow, limit = 150;







|
|







4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
void
TclLogCommandInfo(
    Tcl_Interp *interp,		/* Interpreter in which to log information. */
    const char *script,		/* First character in script containing
				 * command (must be <= command). */
    const char *command,	/* First character in command that generated
				 * the error. */
    size_t length,			/* Number of bytes in command ((size_t)-1 means
				 * use all bytes up to first null byte). */
    const unsigned char *pc,    /* Current pc of bytecode execution context */
    Tcl_Obj **tosPtr)		/* Current stack of bytecode execution
				 * context */
{
    register const char *p;
    Interp *iPtr = (Interp *) interp;
    int overflow, limit = 150;
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
	iPtr->errorLine = 1;
	for (p = script; p != command; p++) {
	    if (*p == '\n') {
		iPtr->errorLine++;
	    }
	}

	if (length < 0) {
	    length = strlen(command);
	}
	overflow = (length > limit);
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
		? "while executing" : "invoked from within"),
		(overflow ? limit : length), command,
		(overflow ? "..." : "")));

	varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
		NULL, 0, 0, &arrayPtr);
	if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
	    /*
	     * Should not happen.







|


|



|







4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
	iPtr->errorLine = 1;
	for (p = script; p != command; p++) {
	    if (*p == '\n') {
		iPtr->errorLine++;
	    }
	}

	if (length == (size_t)-1) {
	    length = strlen(command);
	}
	overflow = (length > (size_t)limit);
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
		? "while executing" : "invoked from within"),
		(overflow ? limit : (int)length), command,
		(overflow ? "..." : "")));

	varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
		NULL, 0, 0, &arrayPtr);
	if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
	    /*
	     * Should not happen.
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
 *----------------------------------------------------------------------
 */

void
TclErrorStackResetIf(
    Tcl_Interp *interp,
    const char *msg,
    int length)
{
    Interp *iPtr = (Interp *) interp;

    if (Tcl_IsShared(iPtr->errorStack)) {
	Tcl_Obj *newObj;

	newObj = Tcl_DuplicateObj(iPtr->errorStack);







|







5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
 *----------------------------------------------------------------------
 */

void
TclErrorStackResetIf(
    Tcl_Interp *interp,
    const char *msg,
    size_t length)
{
    Interp *iPtr = (Interp *) interp;

    if (Tcl_IsShared(iPtr->errorStack)) {
	Tcl_Obj *newObj;

	newObj = Tcl_DuplicateObj(iPtr->errorStack);
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
void
Tcl_LogCommandInfo(
    Tcl_Interp *interp,		/* Interpreter in which to log information. */
    const char *script,		/* First character in script containing
				 * command (must be <= command). */
    const char *command,	/* First character in command that generated
				 * the error. */
    int length)			/* Number of bytes in command (-1 means use
				 * all bytes up to first null byte). */
{
    TclLogCommandInfo(interp, script, command, length, NULL, NULL);
}


/*







|







5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
void
Tcl_LogCommandInfo(
    Tcl_Interp *interp,		/* Interpreter in which to log information. */
    const char *script,		/* First character in script containing
				 * command (must be <= command). */
    const char *command,	/* First character in command that generated
				 * the error. */
    size_t length)		/* Number of bytes in command ((size_t)-1 means use
				 * all bytes up to first null byte). */
{
    TclLogCommandInfo(interp, script, command, length, NULL, NULL);
}


/*
Changes to generic/tclNotify.c.
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
	return;		/* Notifier not initialized for the current thread */
    }

    Tcl_MutexLock(&(tsdPtr->queueMutex));
    for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
	hold = evPtr;
	evPtr = evPtr->nextPtr;
	ckfree(hold);
    }
    tsdPtr->firstEventPtr = NULL;
    tsdPtr->lastEventPtr = NULL;
    Tcl_MutexUnlock(&(tsdPtr->queueMutex));

    Tcl_MutexLock(&listLock);








|







177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
	return;		/* Notifier not initialized for the current thread */
    }

    Tcl_MutexLock(&(tsdPtr->queueMutex));
    for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
	hold = evPtr;
	evPtr = evPtr->nextPtr;
	Tcl_Free(hold);
    }
    tsdPtr->firstEventPtr = NULL;
    tsdPtr->lastEventPtr = NULL;
    Tcl_MutexUnlock(&(tsdPtr->queueMutex));

    Tcl_MutexLock(&listLock);

272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
    Tcl_EventCheckProc *checkProc,
				/* Function to call after waiting to see what
				 * happened. */
    ClientData clientData)	/* One-word argument to pass to setupProc and
				 * checkProc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    EventSource *sourcePtr = ckalloc(sizeof(EventSource));

    sourcePtr->setupProc = setupProc;
    sourcePtr->checkProc = checkProc;
    sourcePtr->clientData = clientData;
    sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr;
    tsdPtr->firstEventSourcePtr = sourcePtr;
}







|







272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
    Tcl_EventCheckProc *checkProc,
				/* Function to call after waiting to see what
				 * happened. */
    ClientData clientData)	/* One-word argument to pass to setupProc and
				 * checkProc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    EventSource *sourcePtr = Tcl_Alloc(sizeof(EventSource));

    sourcePtr->setupProc = setupProc;
    sourcePtr->checkProc = checkProc;
    sourcePtr->clientData = clientData;
    sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr;
    tsdPtr->firstEventSourcePtr = sourcePtr;
}
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
	    continue;
	}
	if (prevPtr == NULL) {
	    tsdPtr->firstEventSourcePtr = sourcePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = sourcePtr->nextPtr;
	}
	ckfree(sourcePtr);
	return;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
	    continue;
	}
	if (prevPtr == NULL) {
	    tsdPtr->firstEventSourcePtr = sourcePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = sourcePtr->nextPtr;
	}
	Tcl_Free(sourcePtr);
	return;
    }
}

/*
 *----------------------------------------------------------------------
 *
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
 *----------------------------------------------------------------------
 */

void
Tcl_QueueEvent(
    Tcl_Event *evPtr,		/* Event to add to queue. The storage space
				 * must have been allocated the caller with
				 * malloc (ckalloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
				 * TCL_QUEUE_MARK. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);








|







351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
 *----------------------------------------------------------------------
 */

void
Tcl_QueueEvent(
    Tcl_Event *evPtr,		/* Event to add to queue. The storage space
				 * must have been allocated the caller with
				 * malloc (Tcl_Alloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
				 * TCL_QUEUE_MARK. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
 */

void
Tcl_ThreadQueueEvent(
    Tcl_ThreadId threadId,	/* Identifier for thread to use. */
    Tcl_Event *evPtr,		/* Event to add to queue. The storage space
				 * must have been allocated the caller with
				 * malloc (ckalloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
				 * TCL_QUEUE_MARK. */
{
    ThreadSpecificData *tsdPtr;








|







383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
 */

void
Tcl_ThreadQueueEvent(
    Tcl_ThreadId threadId,	/* Identifier for thread to use. */
    Tcl_Event *evPtr,		/* Event to add to queue. The storage space
				 * must have been allocated the caller with
				 * malloc (Tcl_Alloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
				 * TCL_QUEUE_MARK. */
{
    ThreadSpecificData *tsdPtr;

408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
    /*
     * Queue the event if there was a notifier associated with the thread.
     */

    if (tsdPtr) {
	QueueEvent(tsdPtr, evPtr, position);
    } else {
	ckfree(evPtr);
    }
    Tcl_MutexUnlock(&listLock);
}

/*
 *----------------------------------------------------------------------
 *







|







408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
    /*
     * Queue the event if there was a notifier associated with the thread.
     */

    if (tsdPtr) {
	QueueEvent(tsdPtr, evPtr, position);
    } else {
	Tcl_Free(evPtr);
    }
    Tcl_MutexUnlock(&listLock);
}

/*
 *----------------------------------------------------------------------
 *
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454

static void
QueueEvent(
    ThreadSpecificData *tsdPtr,	/* Handle to thread local data that indicates
				 * which event queue to use. */
    Tcl_Event *evPtr,		/* Event to add to queue.  The storage space
				 * must have been allocated the caller with
				 * malloc (ckalloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
				 * TCL_QUEUE_MARK. */
{
    Tcl_MutexLock(&(tsdPtr->queueMutex));
    if (position == TCL_QUEUE_TAIL) {







|







440
441
442
443
444
445
446
447
448
449
450
451
452
453
454

static void
QueueEvent(
    ThreadSpecificData *tsdPtr,	/* Handle to thread local data that indicates
				 * which event queue to use. */
    Tcl_Event *evPtr,		/* Event to add to queue.  The storage space
				 * must have been allocated the caller with
				 * malloc (Tcl_Alloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
				 * TCL_QUEUE_MARK. */
{
    Tcl_MutexLock(&(tsdPtr->queueMutex));
    if (position == TCL_QUEUE_TAIL) {
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573

	    /*
	     * Delete the event data structure.
	     */

	    hold = evPtr;
	    evPtr = evPtr->nextPtr;
	    ckfree(hold);
	} else {
	    /*
	     * Event is to be retained.
	     */

	    prevPtr = evPtr;
	    evPtr = evPtr->nextPtr;







|







559
560
561
562
563
564
565
566
567
568
569
570
571
572
573

	    /*
	     * Delete the event data structure.
	     */

	    hold = evPtr;
	    evPtr = evPtr->nextPtr;
	    Tcl_Free(hold);
	} else {
	    /*
	     * Event is to be retained.
	     */

	    prevPtr = evPtr;
	    evPtr = evPtr->nextPtr;
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
			tsdPtr->markerEventPtr = prevPtr;
		    }
		} else {
		    evPtr = NULL;
		}
	    }
	    if (evPtr) {
		ckfree(evPtr);
	    }
	    Tcl_MutexUnlock(&(tsdPtr->queueMutex));
	    return 1;
	} else {
	    /*
	     * The event wasn't actually handled, so we have to restore the
	     * proc field to allow the event to be attempted again.







|







698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
			tsdPtr->markerEventPtr = prevPtr;
		    }
		} else {
		    evPtr = NULL;
		}
	    }
	    if (evPtr) {
		Tcl_Free(evPtr);
	    }
	    Tcl_MutexUnlock(&(tsdPtr->queueMutex));
	    return 1;
	} else {
	    /*
	     * The event wasn't actually handled, so we have to restore the
	     * proc field to allow the event to be attempted again.
Changes to generic/tclOO.c.
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

#define ALLOC_CHUNK 8

/*
 * Function declarations for things defined in this file.
 */

static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj);
static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
			    Namespace *nsPtr, const char *nsNameStr);
static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
			    Method *mPtr, Tcl_Obj *namePtr,
			    Method **newMPtrPtr);
static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
			    Method *mPtr, Tcl_Obj *namePtr);







<







55
56
57
58
59
60
61

62
63
64
65
66
67
68

#define ALLOC_CHUNK 8

/*
 * Function declarations for things defined in this file.
 */


static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
			    Namespace *nsPtr, const char *nsNameStr);
static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
			    Method *mPtr, Tcl_Obj *namePtr,
			    Method **newMPtrPtr);
static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
			    Method *mPtr, Tcl_Obj *namePtr);
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104




105
106
107
108
109
110
111
static void		KillFoundation(ClientData clientData,
			    Tcl_Interp *interp);
static void		MyDeleted(ClientData clientData);
static void		ObjectNamespaceDeleted(ClientData clientData);
static void		ObjectRenamedTrace(ClientData clientData,
			    Tcl_Interp *interp, const char *oldName,
			    const char *newName, int flags);
static void		ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
static void		DeleteDescendants(Tcl_Interp *interp,Object *oPtr);
static inline void	RemoveClass(Class **list, int num, int idx);
static inline void	RemoveObject(Object **list, int num, int idx);
static inline void	SquelchCachedName(Object *oPtr);

static int		PublicObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		PublicNRObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		PrivateObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		PrivateNRObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);





/*
 * Methods in the oo::object and oo::class classes. First, we define a helper
 * macro that makes building the method type declaration structure a lot
 * easier. No point in making life harder than it has to be!
 *
 * Note that the core methods don't need clone or free proc callbacks.







<
<




<
<
<



<
<
<



>
>
>
>







79
80
81
82
83
84
85


86
87
88
89



90
91
92



93
94
95
96
97
98
99
100
101
102
103
104
105
106
static void		KillFoundation(ClientData clientData,
			    Tcl_Interp *interp);
static void		MyDeleted(ClientData clientData);
static void		ObjectNamespaceDeleted(ClientData clientData);
static void		ObjectRenamedTrace(ClientData clientData,
			    Tcl_Interp *interp, const char *oldName,
			    const char *newName, int flags);


static inline void	RemoveClass(Class **list, int num, int idx);
static inline void	RemoveObject(Object **list, int num, int idx);
static inline void	SquelchCachedName(Object *oPtr);




static int		PublicNRObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);



static int		PrivateNRObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		MyClassNRObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static void		MyClassDeleted(ClientData clientData);

/*
 * Methods in the oo::object and oo::class classes. First, we define a helper
 * macro that makes building the method type declaration structure a lot
 * easier. No point in making life harder than it has to be!
 *
 * Note that the core methods don't need clone or free proc callbacks.
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
/* "tcl_findLibrary tcloo $oo::version $oo::version" */
/* " tcloo.tcl OO_LIBRARY oo::library;"; */

/*
 * The scripted part of the definitions of slots.
 */

static const char *slotScript =
"::oo::define ::oo::Slot {\n"
"    method Get {} {error unimplemented}\n"
"    method Set list {error unimplemented}\n"
"    method -set args {\n"
"        uplevel 1 [list [namespace which my] Set $args]\n"
"    }\n"
"    method -append args {\n"
"        uplevel 1 [list [namespace which my] Set [list"
"                {*}[uplevel 1 [list [namespace which my] Get]] {*}$args]]\n"
"    }\n"
"    method -clear {} {uplevel 1 [list [namespace which my] Set {}]}\n"
"    forward --default-operation my -append\n"
"    method unknown {args} {\n"
"        set def --default-operation\n"
"        if {[llength $args] == 0} {\n"
"            return [uplevel 1 [list [namespace which my] $def]]\n"
"        } elseif {![string match -* [lindex $args 0]]} {\n"
"            return [uplevel 1 [list [namespace which my] $def {*}$args]]\n"
"        }\n"
"        next {*}$args\n"
"    }\n"
"    export -set -append -clear\n"
"    unexport unknown destroy\n"
"}\n"
"::oo::objdefine ::oo::define::superclass forward --default-operation my -set\n"
"::oo::objdefine ::oo::define::mixin forward --default-operation my -set\n"
"::oo::objdefine ::oo::objdefine::mixin forward --default-operation my -set\n";

/*
 * The body of the <cloned> method of oo::object.
 */

static const char *clonedBody =
"foreach p [info procs [info object namespace $originObject]::*] {"
"    set args [info args $p];"
"    set idx -1;"
"    foreach a $args {"
"        lset args [incr idx] "
"            [if {[info default $p $a d]} {list $a $d} {list $a}]"
"    };"
"    set b [info body $p];"
"    set p [namespace tail $p];"
"    proc $p $args $b;"
"};"
"foreach v [info vars [info object namespace $originObject]::*] {"
"    upvar 0 $v vOrigin;"
"    namespace upvar [namespace current] [namespace tail $v] vNew;"
"    if {[info exists vOrigin]} {"
"        if {[array exists vOrigin]} {"
"            array set vNew [array get vOrigin];"
"        } else {"
"            set vNew $vOrigin;"
"        }"
"    }"
"}";

/*
 * The actual definition of the variable holding the TclOO stub table.
 */

MODULE_SCOPE const TclOOStubs tclOOStubs;








|


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







143
144
145
146
147
148
149
150
151
152




























153



























154
155
156
157
158
159
160
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
/* "tcl_findLibrary tcloo $oo::version $oo::version" */
/* " tcloo.tcl OO_LIBRARY oo::library;"; */

/*
 * The scripted part of the definitions of TclOO.
 */





























#include "tclOOScript.h"




























/*
 * The actual definition of the variable holding the TclOO stub table.
 */

MODULE_SCOPE const TclOOStubs tclOOStubs;

355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
static int
InitFoundation(
    Tcl_Interp *interp)
{
    static Tcl_ThreadDataKey tsdKey;
    ThreadLocalData *tsdPtr =
	    Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
    Foundation *fPtr = ckalloc(sizeof(Foundation));
    Tcl_Obj *namePtr, *argsPtr, *bodyPtr;
    Tcl_DString buffer;
    Command *cmdPtr;
    int i;

    /*
     * Initialize the structure that holds the OO system core. This is
     * attached to the interpreter via an assocData entry; not very efficient,







|
|







295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
static int
InitFoundation(
    Tcl_Interp *interp)
{
    static Tcl_ThreadDataKey tsdKey;
    ThreadLocalData *tsdPtr =
	    Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
    Foundation *fPtr = Tcl_Alloc(sizeof(Foundation));
    Tcl_Obj *namePtr;
    Tcl_DString buffer;
    Command *cmdPtr;
    int i;

    /*
     * Initialize the structure that holds the OO system core. This is
     * attached to the interpreter via an assocData entry; not very efficient,
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
    Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1);
    fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", fPtr,
	    DeletedDefineNamespace);
    fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr,
	    DeletedObjdefNamespace);
    fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
	    DeletedHelpersNamespace);
    fPtr->epoch = 0;
    fPtr->tsdPtr = tsdPtr;
    TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
    TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
    TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
    TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
    TclNewLiteralStringObj(fPtr->defineName, "::oo::define");
    Tcl_IncrRefCount(fPtr->unknownMethodNameObj);







|







318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
    Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1);
    fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", fPtr,
	    DeletedDefineNamespace);
    fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr,
	    DeletedObjdefNamespace);
    fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
	    DeletedHelpersNamespace);
    fPtr->epoch = 1;
    fPtr->tsdPtr = tsdPtr;
    TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
    TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
    TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
    TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
    TclNewLiteralStringObj(fPtr->defineName, "::oo::define");
    Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
    for (i=0 ; objMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
    }
    for (i=0 ; clsMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
    }

    /*
     * Create the default <cloned> method implementation, used when 'oo::copy'
     * is called to finish the copying of one object to another.
     */

    TclNewLiteralStringObj(argsPtr, "originObject");
    Tcl_IncrRefCount(argsPtr);
    bodyPtr = Tcl_NewStringObj(clonedBody, -1);
    TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr,
	    bodyPtr, NULL);
    TclDecrRefCount(argsPtr);

    /*
     * Finish setting up the class of classes by marking the 'new' method as
     * private; classes, unlike general objects, must have explicit names. We
     * also need to create the constructor for classes.
     */

    TclNewLiteralStringObj(namePtr, "new");







<
<
<
<
<
<
<
<
<
<
<
<







375
376
377
378
379
380
381












382
383
384
385
386
387
388
    for (i=0 ; objMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
    }
    for (i=0 ; clsMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
    }













    /*
     * Finish setting up the class of classes by marking the 'new' method as
     * private; classes, unlike general objects, must have explicit names. We
     * also need to create the constructor for classes.
     */

    TclNewLiteralStringObj(namePtr, "new");
487
488
489
490
491
492
493





494
495
496
497
498
499
500
501
    /*
     * Now make the class of slots.
     */

    if (TclOODefineSlots(fPtr) != TCL_OK) {
	return TCL_ERROR;
    }





    return Tcl_EvalEx(interp, slotScript, -1, 0);
}

/*
 * ----------------------------------------------------------------------
 *
 * InitClassSystemRoots --
 *







>
>
>
>
>
|







415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
    /*
     * Now make the class of slots.
     */

    if (TclOODefineSlots(fPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Evaluate the remaining definitions, which are a compiled-in Tcl script.
     */

    return Tcl_EvalEx(interp, tclOOSetupScript, -1, 0);
}

/*
 * ----------------------------------------------------------------------
 *
 * InitClassSystemRoots --
 *
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
    Foundation *fPtr)
{
    Class fakeCls;
    Object fakeObject;

    /* Stand up a phony class for bootstrapping. */
    fPtr->objectCls = &fakeCls;
    /* referenced in AllocClass to increment the refCount. */
    fakeCls.thisPtr = &fakeObject;

    fPtr->objectCls = AllocClass(interp,
	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
    /* Corresponding TclOODecrRefCount in KillFoudation */
    AddRef(fPtr->objectCls->thisPtr);

    /* This is why it is unnecessary in this routine to replace the
     * incremented reference count of fPtr->objectCls that was swallowed by
     * fakeObject. */
    fPtr->objectCls->superclasses.num = 0;
    ckfree(fPtr->objectCls->superclasses.list);
    fPtr->objectCls->superclasses.list = NULL;

    /* special initialization for the primordial objects */
    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
    fPtr->objectCls->flags |= ROOT_OBJECT;

    fPtr->classCls = AllocClass(interp,
	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
    /* Corresponding TclOODecrRefCount in KillFoudation */
    AddRef(fPtr->classCls->thisPtr);

    /*
     * Increment reference counts for each reference because these
     * relationships can be dynamically changed.







|


|








|






|







444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
    Foundation *fPtr)
{
    Class fakeCls;
    Object fakeObject;

    /* Stand up a phony class for bootstrapping. */
    fPtr->objectCls = &fakeCls;
    /* referenced in TclOOAllocClass to increment the refCount. */
    fakeCls.thisPtr = &fakeObject;

    fPtr->objectCls = TclOOAllocClass(interp,
	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
    /* Corresponding TclOODecrRefCount in KillFoudation */
    AddRef(fPtr->objectCls->thisPtr);

    /* This is why it is unnecessary in this routine to replace the
     * incremented reference count of fPtr->objectCls that was swallowed by
     * fakeObject. */
    fPtr->objectCls->superclasses.num = 0;
    Tcl_Free(fPtr->objectCls->superclasses.list);
    fPtr->objectCls->superclasses.list = NULL;

    /* special initialization for the primordial objects */
    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
    fPtr->objectCls->flags |= ROOT_OBJECT;

    fPtr->classCls = TclOOAllocClass(interp,
	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
    /* Corresponding TclOODecrRefCount in KillFoudation */
    AddRef(fPtr->classCls->thisPtr);

    /*
     * Increment reference counts for each reference because these
     * relationships can be dynamically changed.
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
    TclDecrRefCount(fPtr->constructorName);
    TclDecrRefCount(fPtr->destructorName);
    TclDecrRefCount(fPtr->clonedName);
    TclDecrRefCount(fPtr->defineName);
    TclOODecrRefCount(fPtr->objectCls->thisPtr);
    TclOODecrRefCount(fPtr->classCls->thisPtr);

    ckfree(fPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocObject --
 *







|







563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
    TclDecrRefCount(fPtr->constructorName);
    TclDecrRefCount(fPtr->destructorName);
    TclDecrRefCount(fPtr->clonedName);
    TclDecrRefCount(fPtr->defineName);
    TclOODecrRefCount(fPtr->objectCls->thisPtr);
    TclOODecrRefCount(fPtr->classCls->thisPtr);

    Tcl_Free(fPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocObject --
 *
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
				 * a namespace that already exists, the effect
				 * will be the same as if this was NULL. */
{
    Foundation *fPtr = GetFoundation(interp);
    Object *oPtr;
    Command *cmdPtr;
    CommandTrace *tracePtr;
    int creationEpoch;

    oPtr = ckalloc(sizeof(Object));
    memset(oPtr, 0, sizeof(Object));

    /*
     * Every object has a namespace; make one. Note that this also normally
     * computes the creation epoch value for the object, a sequence number
     * that is unique to the object (and which allows us to manage method
     * caching without comparing pointers).







|

|







601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
				 * a namespace that already exists, the effect
				 * will be the same as if this was NULL. */
{
    Foundation *fPtr = GetFoundation(interp);
    Object *oPtr;
    Command *cmdPtr;
    CommandTrace *tracePtr;
    size_t creationEpoch;

    oPtr = Tcl_Alloc(sizeof(Object));
    memset(oPtr, 0, sizeof(Object));

    /*
     * Every object has a namespace; make one. Note that this also normally
     * computes the creation epoch value for the object, a sequence number
     * that is unique to the object (and which allows us to manage method
     * caching without comparing pointers).
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
	}
	Tcl_ResetResult(interp);
    }

    while (1) {
	char objName[10 + TCL_INTEGER_SPACE];

	sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount);
	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL);
	if (oPtr->namespacePtr != NULL) {
	    creationEpoch = fPtr->tsdPtr->nsCount;
	    break;
	}

	/*







|







630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
	}
	Tcl_ResetResult(interp);
    }

    while (1) {
	char objName[10 + TCL_INTEGER_SPACE];

	sprintf(objName, "::oo::Obj%" TCL_Z_MODIFIER "u", ++fPtr->tsdPtr->nsCount);
	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL);
	if (oPtr->namespacePtr != NULL) {
	    creationEpoch = fPtr->tsdPtr->nsCount;
	    break;
	}

	/*
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799



800
801
802
803
804
805
806

    if (!nameStr) {
	nameStr = oPtr->namespacePtr->name;
	nsPtr = (Namespace *)oPtr->namespacePtr;
	if (nsPtr->parentPtr != NULL) {
	    nsPtr = nsPtr->parentPtr;
	}

    }
    oPtr->command = TclCreateObjCommandInNs(interp, nameStr,
	(Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL);

    /*
     * Add the NRE command and trace directly. While this breaks a number of
     * abstractions, it is faster and we're inside Tcl here so we're allowed.
     */

    cmdPtr = (Command *) oPtr->command;
    cmdPtr->nreProc = PublicNRObjectCmd;
    cmdPtr->tracePtr = tracePtr = ckalloc(sizeof(CommandTrace));
    tracePtr->traceProc = ObjectRenamedTrace;
    tracePtr->clientData = oPtr;
    tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE;
    tracePtr->nextPtr = NULL;
    tracePtr->refCount = 1;

    oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr,
	    PrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);



    return oPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * SquelchCachedName --







|
<

|








|







|
>
>
>







705
706
707
708
709
710
711
712

713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741

    if (!nameStr) {
	nameStr = oPtr->namespacePtr->name;
	nsPtr = (Namespace *)oPtr->namespacePtr;
	if (nsPtr->parentPtr != NULL) {
	    nsPtr = nsPtr->parentPtr;
	}
    }

    oPtr->command = TclCreateObjCommandInNs(interp, nameStr,
	(Tcl_Namespace *)nsPtr, TclOOPublicObjectCmd, oPtr, NULL);

    /*
     * Add the NRE command and trace directly. While this breaks a number of
     * abstractions, it is faster and we're inside Tcl here so we're allowed.
     */

    cmdPtr = (Command *) oPtr->command;
    cmdPtr->nreProc = PublicNRObjectCmd;
    cmdPtr->tracePtr = tracePtr = Tcl_Alloc(sizeof(CommandTrace));
    tracePtr->traceProc = ObjectRenamedTrace;
    tracePtr->clientData = oPtr;
    tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE;
    tracePtr->nextPtr = NULL;
    tracePtr->refCount = 1;

    oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr,
	    TclOOPrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
    oPtr->myclassCommand = TclNRCreateCommandInNs(interp, "myclass",
	    oPtr->namespacePtr, TclOOMyClassObjCmd, MyClassNRObjCmd, oPtr,
            MyClassDeleted);
    return oPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * SquelchCachedName --
820
821
822
823
824
825
826
827
828
829
830

831
832
833
834
835
836
837
838
839
840
841
842
843
844
845








846
847
848
849
850
851
852
	oPtr->cachedNameObj = NULL;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * MyDeleted --
 *
 *	This callback is triggered when the object's [my] command is deleted
 *	by any mechanism. It just marks the object as not having a [my]

 *	command, and so prevents cleanup of that when the object itself is
 *	deleted.
 *
 * ----------------------------------------------------------------------
 */

static void
MyDeleted(
    ClientData clientData)	/* Reference to the object whose [my] has been
				 * squelched. */
{
    register Object *oPtr = clientData;

    oPtr->myCommand = NULL;
}









/*
 * ----------------------------------------------------------------------
 *
 * ObjectRenamedTrace --
 *
 *	This callback is triggered when the object is deleted by any







|

|
|
>
|
<













>
>
>
>
>
>
>
>







755
756
757
758
759
760
761
762
763
764
765
766
767

768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
	oPtr->cachedNameObj = NULL;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * MyDeleted, MyClassDeleted --
 *
 *	These callbacks are triggered when the object's [my] or [myclass]
 *	commands are deleted by any mechanism. They just mark the object as
 *	not having a [my] command or [myclass] command, and so prevent cleanup
 *	of those commands when the object itself is deleted.

 *
 * ----------------------------------------------------------------------
 */

static void
MyDeleted(
    ClientData clientData)	/* Reference to the object whose [my] has been
				 * squelched. */
{
    register Object *oPtr = clientData;

    oPtr->myCommand = NULL;
}

static void
MyClassDeleted(
    ClientData clientData)
{
    Object *oPtr = clientData;
    oPtr->myclassCommand = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectRenamedTrace --
 *
 *	This callback is triggered when the object is deleted by any
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921

922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940

941

942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963

964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
    TclOODecrRefCount(oPtr);
    return;
}

/*
 * ----------------------------------------------------------------------
 *
 * DeleteDescendants --
 *
 *	Delete all descendants of a particular class.
 *
 * ----------------------------------------------------------------------
 */

static void
DeleteDescendants(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr;
    Object *instancePtr;

    /*
     * Squelch classes that this class has been mixed into.
     */

    if (clsPtr->mixinSubs.num > 0) {
	while (clsPtr->mixinSubs.num > 0) {
	    mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num-1];
	    /* This condition also covers the case where mixinSubclassPtr ==
	     * clsPtr
	     */
	    if (!Deleted(mixinSubclassPtr->thisPtr)) {

		Tcl_DeleteCommandFromToken(interp,
			mixinSubclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
	}
    }
    if (clsPtr->mixinSubs.size > 0) {
	ckfree(clsPtr->mixinSubs.list);
	clsPtr->mixinSubs.size = 0;
    }

    /*
     * Squelch subclasses of this class.
     */

    if (clsPtr->subclasses.num > 0) {
	while (clsPtr->subclasses.num > 0) {
	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {

		Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);

	    }
	    TclOORemoveFromSubclasses(subclassPtr, clsPtr);
	}
    }
    if (clsPtr->subclasses.size > 0) {
	ckfree(clsPtr->subclasses.list);
	clsPtr->subclasses.list = NULL;
	clsPtr->subclasses.size = 0;
    }

    /*
     * Squelch instances of this class (includes objects we're mixed into).
     */

    if (clsPtr->instances.num > 0) {
	while (clsPtr->instances.num > 0) {
	    instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];
	    /*
	     * This condition also covers the case where instancePtr == oPtr
	     */

	    if (!Deleted(instancePtr) && !IsRoot(instancePtr)) {

		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
	    }
	    TclOORemoveFromInstances(instancePtr, clsPtr);
	}
    }
    if (clsPtr->instances.size > 0) {
	ckfree(clsPtr->instances.list);
	clsPtr->instances.list = NULL;
	clsPtr->instances.size = 0;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * ReleaseClassContents --
 *
 *	Tear down the special class data structure, including deleting all
 *	dependent classes and objects.
 *
 * ----------------------------------------------------------------------
 */

static void
ReleaseClassContents(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    FOREACH_HASH_DECLS;
    int i;
    Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
    Method *mPtr;







|






|
|
















|
>







|










|
>
|
>





|















|
>






|








|







|
|







832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
    TclOODecrRefCount(oPtr);
    return;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteDescendants --
 *
 *	Delete all descendants of a particular class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOODeleteDescendants(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr;
    Object *instancePtr;

    /*
     * Squelch classes that this class has been mixed into.
     */

    if (clsPtr->mixinSubs.num > 0) {
	while (clsPtr->mixinSubs.num > 0) {
	    mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num-1];
	    /* This condition also covers the case where mixinSubclassPtr ==
	     * clsPtr
	     */
	    if (!Deleted(mixinSubclassPtr->thisPtr)
		    && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			mixinSubclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
	}
    }
    if (clsPtr->mixinSubs.size > 0) {
	Tcl_Free(clsPtr->mixinSubs.list);
	clsPtr->mixinSubs.size = 0;
    }

    /*
     * Squelch subclasses of this class.
     */

    if (clsPtr->subclasses.num > 0) {
	while (clsPtr->subclasses.num > 0) {
	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
		    && !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			subclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromSubclasses(subclassPtr, clsPtr);
	}
    }
    if (clsPtr->subclasses.size > 0) {
	Tcl_Free(clsPtr->subclasses.list);
	clsPtr->subclasses.list = NULL;
	clsPtr->subclasses.size = 0;
    }

    /*
     * Squelch instances of this class (includes objects we're mixed into).
     */

    if (clsPtr->instances.num > 0) {
	while (clsPtr->instances.num > 0) {
	    instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];
	    /*
	     * This condition also covers the case where instancePtr == oPtr
	     */

	    if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
		    !(instancePtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
	    }
	    TclOORemoveFromInstances(instancePtr, clsPtr);
	}
    }
    if (clsPtr->instances.size > 0) {
	Tcl_Free(clsPtr->instances.list);
	clsPtr->instances.list = NULL;
	clsPtr->instances.size = 0;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOReleaseClassContents --
 *
 *	Tear down the special class data structure, including deleting all
 *	dependent classes and objects.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOReleaseClassContents(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    FOREACH_HASH_DECLS;
    int i;
    Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
    Method *mPtr;
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
    if (!Deleted(oPtr)) {
	if (IsRootClass(oPtr)) {
	    Tcl_Panic("deleting class structure for non-deleted %s",
		    "::oo::class");
	} else if (IsRootObject(oPtr)) {
	    Tcl_Panic("deleting class structure for non-deleted %s",
		    "::oo::object");
	} else {
	    Tcl_Panic("deleting class structure for non-deleted %s",
		    "general object");
	}
    }

    /*
     * Squelch method implementation chain caches.
     */








<
<
<







951
952
953
954
955
956
957



958
959
960
961
962
963
964
    if (!Deleted(oPtr)) {
	if (IsRootClass(oPtr)) {
	    Tcl_Panic("deleting class structure for non-deleted %s",
		    "::oo::class");
	} else if (IsRootObject(oPtr)) {
	    Tcl_Panic("deleting class structure for non-deleted %s",
		    "::oo::object");



	}
    }

    /*
     * Squelch method implementation chain caches.
     */

1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115

1116
1117
1118
1119
1120
1121
1122
    if (clsPtr->classChainCache) {
	CallChain *callPtr;

	FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) {
	    TclOODeleteChain(callPtr);
	}
	Tcl_DeleteHashTable(clsPtr->classChainCache);
	ckfree(clsPtr->classChainCache);
	clsPtr->classChainCache = NULL;
    }

    /*
     * Squelch our filter list.
     */

    if (clsPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, clsPtr->filters) {
	    TclDecrRefCount(filterObj);
	}
	ckfree(clsPtr->filters.list);
	clsPtr->filters.list = NULL;
	clsPtr->filters.num = 0;
    }

    /*
     * Squelch our metadata.
     */

    if (clsPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(clsPtr->metadataPtr);
	ckfree(clsPtr->metadataPtr);
	clsPtr->metadataPtr = NULL;
    }

    if (clsPtr->mixins.num) {
	FOREACH(tmpClsPtr, clsPtr->mixins) {
	    TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
	    TclOODecrRefCount(tmpClsPtr->thisPtr);
	}
	ckfree(clsPtr->mixins.list);
	clsPtr->mixins.list = NULL;
	clsPtr->mixins.num = 0;
    }

    if (clsPtr->superclasses.num > 0) {
	FOREACH(tmpClsPtr, clsPtr->superclasses) {
	    TclOORemoveFromSubclasses(clsPtr, tmpClsPtr);
	    TclOODecrRefCount(tmpClsPtr->thisPtr);
	}
	ckfree(clsPtr->superclasses.list);
	clsPtr->superclasses.num = 0;
	clsPtr->superclasses.list = NULL;
    }

    FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
	TclOODelMethodRef(mPtr);
    }
    Tcl_DeleteHashTable(&clsPtr->classMethods);
    TclOODelMethodRef(clsPtr->constructorPtr);
    TclOODelMethodRef(clsPtr->destructorPtr);

    FOREACH(variableObj, clsPtr->variables) {
	TclDecrRefCount(variableObj);
    }
    if (i) {
	ckfree(clsPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	ckfree(clsPtr->privateVariables.list);
    }

    if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
    }

}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectNamespaceDeleted --
 *







|













|
















|








|









|















|







|





>







973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
    if (clsPtr->classChainCache) {
	CallChain *callPtr;

	FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) {
	    TclOODeleteChain(callPtr);
	}
	Tcl_DeleteHashTable(clsPtr->classChainCache);
	Tcl_Free(clsPtr->classChainCache);
	clsPtr->classChainCache = NULL;
    }

    /*
     * Squelch our filter list.
     */

    if (clsPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, clsPtr->filters) {
	    TclDecrRefCount(filterObj);
	}
	Tcl_Free(clsPtr->filters.list);
	clsPtr->filters.list = NULL;
	clsPtr->filters.num = 0;
    }

    /*
     * Squelch our metadata.
     */

    if (clsPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(clsPtr->metadataPtr);
	Tcl_Free(clsPtr->metadataPtr);
	clsPtr->metadataPtr = NULL;
    }

    if (clsPtr->mixins.num) {
	FOREACH(tmpClsPtr, clsPtr->mixins) {
	    TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
	    TclOODecrRefCount(tmpClsPtr->thisPtr);
	}
	Tcl_Free(clsPtr->mixins.list);
	clsPtr->mixins.list = NULL;
	clsPtr->mixins.num = 0;
    }

    if (clsPtr->superclasses.num > 0) {
	FOREACH(tmpClsPtr, clsPtr->superclasses) {
	    TclOORemoveFromSubclasses(clsPtr, tmpClsPtr);
	    TclOODecrRefCount(tmpClsPtr->thisPtr);
	}
	Tcl_Free(clsPtr->superclasses.list);
	clsPtr->superclasses.num = 0;
	clsPtr->superclasses.list = NULL;
    }

    FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
	TclOODelMethodRef(mPtr);
    }
    Tcl_DeleteHashTable(&clsPtr->classMethods);
    TclOODelMethodRef(clsPtr->constructorPtr);
    TclOODelMethodRef(clsPtr->destructorPtr);

    FOREACH(variableObj, clsPtr->variables) {
	TclDecrRefCount(variableObj);
    }
    if (i) {
	Tcl_Free(clsPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	Tcl_Free(clsPtr->privateVariables.list);
    }

    if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
    }
    oPtr->classPtr = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectNamespaceDeleted --
 *
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
     * records.  This is the flag that
     */

    oPtr->flags |= OBJECT_DELETED;

    /* Let the dominoes fall */
    if (oPtr->classPtr) {
	DeleteDescendants(interp, oPtr);
    }

    /*
     * We do not run destructors on the core class objects when the
     * interpreter is being deleted; their incestuous nature causes problems
     * in that case when the destructor is partially deleted before the uses
     * of it have gone. [Bug 2949397]







|







1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
     * records.  This is the flag that
     */

    oPtr->flags |= OBJECT_DELETED;

    /* Let the dominoes fall */
    if (oPtr->classPtr) {
	TclOODeleteDescendants(interp, oPtr);
    }

    /*
     * We do not run destructors on the core class objects when the
     * interpreter is being deleted; their incestuous nature causes problems
     * in that case when the destructor is partially deleted before the uses
     * of it have gone. [Bug 2949397]
1211
1212
1213
1214
1215
1216
1217



1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
	 * The namespace must have been deleted directly.  Delete the command
	 * as well.
	 */

	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
    }




    if (oPtr->myCommand) {
	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
    }

    /*
     * Splice the object out of its context. After this, we must *not* call
     * methods on the object.
     */

    /*
     * TODO: Should this be protected with a * !IsRoot() condition?
     */

    TclOORemoveFromInstances(oPtr, oPtr->selfCls);

    if (oPtr->mixins.num > 0) {
	FOREACH(mixinPtr, oPtr->mixins) {
	    TclOORemoveFromInstances(oPtr, mixinPtr);
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
	ckfree(oPtr->mixins.list);
    }

    FOREACH(filterObj, oPtr->filters) {
	TclDecrRefCount(filterObj);
    }
    if (i) {
	ckfree(oPtr->filters.list);
    }

    if (oPtr->methodsPtr) {
	FOREACH_HASH_VALUE(mPtr, oPtr->methodsPtr) {
	    TclOODelMethodRef(mPtr);
	}
	Tcl_DeleteHashTable(oPtr->methodsPtr);
	ckfree(oPtr->methodsPtr);
    }

    FOREACH(variableObj, oPtr->variables) {
	TclDecrRefCount(variableObj);
    }
    if (i) {
	ckfree(oPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, oPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	ckfree(oPtr->privateVariables.list);
    }

    if (oPtr->chainCache) {
	TclOODeleteChainCache(oPtr->chainCache);
    }

    SquelchCachedName(oPtr);

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(oPtr->metadataPtr);
	ckfree(oPtr->metadataPtr);
	oPtr->metadataPtr = NULL;
    }

    /*
     * Because an object can be a class that is an instance of itself, the
     * class object's class structure should only be cleaned after most of the
     * cleanup on the object is done.
     *
     * The class of objects needs some special care; if it is deleted (and
     * we're not killing the whole interpreter) we force the delete of the
     * class of classes now as well. Due to the incestuous nature of those two
     * classes, if one goes the other must too and yet the tangle can
     * sometimes not go away automatically; we force it here. [Bug 2962664]
     */

    if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr)
	    && !Tcl_InterpDeleted(interp)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
    }

    if (oPtr->classPtr != NULL) {
	ReleaseClassContents(interp, oPtr);
    }

    /*
     * Delete the object structure itself.
     */

    TclNsDecrRefCount((Namespace *)oPtr->namespacePtr);







>
>
>




















|






|







|






|







|
















|





|
|














|







1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
	 * The namespace must have been deleted directly.  Delete the command
	 * as well.
	 */

	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
    }

    if (oPtr->myclassCommand) {
	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myclassCommand);
    }
    if (oPtr->myCommand) {
	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
    }

    /*
     * Splice the object out of its context. After this, we must *not* call
     * methods on the object.
     */

    /*
     * TODO: Should this be protected with a * !IsRoot() condition?
     */

    TclOORemoveFromInstances(oPtr, oPtr->selfCls);

    if (oPtr->mixins.num > 0) {
	FOREACH(mixinPtr, oPtr->mixins) {
	    TclOORemoveFromInstances(oPtr, mixinPtr);
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
	Tcl_Free(oPtr->mixins.list);
    }

    FOREACH(filterObj, oPtr->filters) {
	TclDecrRefCount(filterObj);
    }
    if (i) {
	Tcl_Free(oPtr->filters.list);
    }

    if (oPtr->methodsPtr) {
	FOREACH_HASH_VALUE(mPtr, oPtr->methodsPtr) {
	    TclOODelMethodRef(mPtr);
	}
	Tcl_DeleteHashTable(oPtr->methodsPtr);
	Tcl_Free(oPtr->methodsPtr);
    }

    FOREACH(variableObj, oPtr->variables) {
	TclDecrRefCount(variableObj);
    }
    if (i) {
	Tcl_Free(oPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, oPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	Tcl_Free(oPtr->privateVariables.list);
    }

    if (oPtr->chainCache) {
	TclOODeleteChainCache(oPtr->chainCache);
    }

    SquelchCachedName(oPtr);

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(oPtr->metadataPtr);
	Tcl_Free(oPtr->metadataPtr);
	oPtr->metadataPtr = NULL;
    }

    /*
     * Because an object can be a class that is an instance of itself, the
     * class object's class structure should only be cleaned after most of
     * the cleanup on the object is done. 
     *
     * The class of objects needs some special care; if it is deleted (and
     * we're not killing the whole interpreter) we force the delete of the
     * class of classes now as well. Due to the incestuous nature of those two
     * classes, if one goes the other must too and yet the tangle can
     * sometimes not go away automatically; we force it here. [Bug 2962664]
     */

    if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr)
	    && !Tcl_InterpDeleted(interp)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
    }

    if (oPtr->classPtr != NULL) {
	TclOOReleaseClassContents(interp, oPtr);
    }

    /*
     * Delete the object structure itself.
     */

    TclNsDecrRefCount((Namespace *)oPtr->namespacePtr);
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
int
TclOODecrRefCount(
    Object *oPtr)
{
    if (oPtr->refCount-- <= 1) {

	if (oPtr->classPtr != NULL) {
	    ckfree(oPtr->classPtr);
	}
	ckfree(oPtr);
	return 1;
    }
    return 0;
}

/*
 * ----------------------------------------------------------------------







|

|







1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
int
TclOODecrRefCount(
    Object *oPtr)
{
    if (oPtr->refCount-- <= 1) {

	if (oPtr->classPtr != NULL) {
	    Tcl_Free(oPtr->classPtr);
	}
	Tcl_Free(oPtr);
	return 1;
    }
    return 0;
}

/*
 * ----------------------------------------------------------------------
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409































1410
1411
1412
1413
1414
1415
1416
    Class *clsPtr)		/* The class to add the instance to. It is
				 * assumed that the class is not already
				 * present as an instance in the class. */
{
    if (clsPtr->instances.num >= clsPtr->instances.size) {
	clsPtr->instances.size += ALLOC_CHUNK;
	if (clsPtr->instances.size == ALLOC_CHUNK) {
	    clsPtr->instances.list = ckalloc(sizeof(Object *) * ALLOC_CHUNK);
	} else {
	    clsPtr->instances.list = ckrealloc(clsPtr->instances.list,
		    sizeof(Object *) * clsPtr->instances.size);
	}
    }
    clsPtr->instances.list[clsPtr->instances.num++] = oPtr;
    AddRef(oPtr);
}
































/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromSubclasses --
 *
 *	Utility function to remove a class from the list of subclasses within







|

|






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
    Class *clsPtr)		/* The class to add the instance to. It is
				 * assumed that the class is not already
				 * present as an instance in the class. */
{
    if (clsPtr->instances.num >= clsPtr->instances.size) {
	clsPtr->instances.size += ALLOC_CHUNK;
	if (clsPtr->instances.size == ALLOC_CHUNK) {
	    clsPtr->instances.list = Tcl_Alloc(sizeof(Object *) * ALLOC_CHUNK);
	} else {
	    clsPtr->instances.list = Tcl_Realloc(clsPtr->instances.list,
		    sizeof(Object *) * clsPtr->instances.size);
	}
    }
    clsPtr->instances.list[clsPtr->instances.num++] = oPtr;
    AddRef(oPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromMixins --
 *
 *	Utility function to remove a class from the list of mixins within an
 *	object.
 *
 * ----------------------------------------------------------------------
 */

int
TclOORemoveFromMixins(
    Class *mixinPtr,		/* The mixin to remove. */
    Object *oPtr)		/* The object (possibly) containing the
				 * reference to the mixin. */
{
    int i, res = 0;
    Class *mixPtr;

    FOREACH(mixPtr, oPtr->mixins) {
	if (mixinPtr == mixPtr) {
	    RemoveItem(Class, oPtr->mixins, i);
	    TclOODecrRefCount(mixPtr->thisPtr);
	    res++;
	    break;
	}
    }
    return res;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromSubclasses --
 *
 *	Utility function to remove a class from the list of subclasses within
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
{
    if (Deleted(superPtr->thisPtr)) {
	return;
    }
    if (superPtr->subclasses.num >= superPtr->subclasses.size) {
	superPtr->subclasses.size += ALLOC_CHUNK;
	if (superPtr->subclasses.size == ALLOC_CHUNK) {
	    superPtr->subclasses.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
		    sizeof(Class *) * superPtr->subclasses.size);
	}
    }
    superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}








|

|







1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
{
    if (Deleted(superPtr->thisPtr)) {
	return;
    }
    if (superPtr->subclasses.num >= superPtr->subclasses.size) {
	superPtr->subclasses.size += ALLOC_CHUNK;
	if (superPtr->subclasses.size == ALLOC_CHUNK) {
	    superPtr->subclasses.list = Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->subclasses.list = Tcl_Realloc(superPtr->subclasses.list,
		    sizeof(Class *) * superPtr->subclasses.size);
	}
    }
    superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}

1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
{
    if (Deleted(superPtr->thisPtr)) {
	return;
    }
    if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
	superPtr->mixinSubs.size += ALLOC_CHUNK;
	if (superPtr->mixinSubs.size == ALLOC_CHUNK) {
	    superPtr->mixinSubs.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list,
		    sizeof(Class *) * superPtr->mixinSubs.size);
	}
    }
    superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocClass --
 *
 *	Allocate a basic class. Does not add class to its
 *	class's instance list.
 *
 * ----------------------------------------------------------------------
 */

static inline void
InitClassPath(
    Tcl_Interp *interp,







|

|










|

|
|







1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
{
    if (Deleted(superPtr->thisPtr)) {
	return;
    }
    if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
	superPtr->mixinSubs.size += ALLOC_CHUNK;
	if (superPtr->mixinSubs.size == ALLOC_CHUNK) {
	    superPtr->mixinSubs.list = Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->mixinSubs.list = Tcl_Realloc(superPtr->mixinSubs.list,
		    sizeof(Class *) * superPtr->mixinSubs.size);
	}
    }
    superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOAllocClass --
 *
 *	Allocate a basic class. Does not add class to its class's instance
 *	list.
 *
 * ----------------------------------------------------------------------
 */

static inline void
InitClassPath(
    Tcl_Interp *interp,
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
	TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path);
    } else {
	TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1,
		&fPtr->ooNs);
    }
}

static Class *
AllocClass(
    Tcl_Interp *interp,		/* Interpreter within which to allocate the
				 * class. */
    Object *useThisObj)		/* Object that is to act as the class
				 * representation. */
{
    Foundation *fPtr = GetFoundation(interp);
    Class *clsPtr = ckalloc(sizeof(Class));

    memset(clsPtr, 0, sizeof(Class));
    clsPtr->thisPtr = useThisObj;

    /*
     * Configure the namespace path for the class's object.
     */

    InitClassPath(interp, clsPtr);

    /*
     * Classes are subclasses of oo::object, i.e. the objects they create are
     * objects.
     */

    clsPtr->superclasses.num = 1;
    clsPtr->superclasses.list = ckalloc(sizeof(Class *));
    clsPtr->superclasses.list[0] = fPtr->objectCls;
    AddRef(fPtr->objectCls->thisPtr);

    /*
     * Finish connecting the class structure to the object structure.
     */








|
|






|
















|







1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
	TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path);
    } else {
	TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1,
		&fPtr->ooNs);
    }
}

Class *
TclOOAllocClass(
    Tcl_Interp *interp,		/* Interpreter within which to allocate the
				 * class. */
    Object *useThisObj)		/* Object that is to act as the class
				 * representation. */
{
    Foundation *fPtr = GetFoundation(interp);
    Class *clsPtr = Tcl_Alloc(sizeof(Class));

    memset(clsPtr, 0, sizeof(Class));
    clsPtr->thisPtr = useThisObj;

    /*
     * Configure the namespace path for the class's object.
     */

    InitClassPath(interp, clsPtr);

    /*
     * Classes are subclasses of oo::object, i.e. the objects they create are
     * objects.
     */

    clsPtr->superclasses.num = 1;
    clsPtr->superclasses.list = Tcl_Alloc(sizeof(Class *));
    clsPtr->superclasses.list[0] = fPtr->objectCls;
    AddRef(fPtr->objectCls->thisPtr);

    /*
     * Finish connecting the class structure to the object structure.
     */

1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
    /*
     * Check to see if we're really creating a class. If so, allocate the
     * class structure as well.
     */

    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
	/*
	 * Is a class, so attach a class structure. Note that the AllocClass
	 * function splices the structure into the object, so we don't have
	 * to. Once that's done, we need to repatch the object to have the
	 * right class since AllocClass interferes with that.
	 */

	AllocClass(interp, oPtr);
	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
    } else {
	oPtr->classPtr = NULL;
    }
    return oPtr;
}








|
|
|
|


|







1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
    /*
     * Check to see if we're really creating a class. If so, allocate the
     * class structure as well.
     */

    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
	/*
	 * Is a class, so attach a class structure. Note that the
	 * TclOOAllocClass function splices the structure into the object, so
	 * we don't have to. Once that's done, we need to repatch the object
	 * to have the right class since TclOOAllocClass interferes with that.
	 */

	TclOOAllocClass(interp, oPtr);
	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
    } else {
	oPtr->classPtr = NULL;
    }
    return oPtr;
}

1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
    if (o2Ptr->mixins.num != 0) {
	FOREACH(mixinPtr, o2Ptr->mixins) {
	    if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
		TclOORemoveFromInstances(o2Ptr, mixinPtr);
	    }
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
	ckfree(o2Ptr->mixins.list);
    }
    DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
    FOREACH(mixinPtr, o2Ptr->mixins) {
	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
	    TclOOAddToInstances(o2Ptr, mixinPtr);
	}
	/* For the reference just created in DUPLICATE */







|







1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
    if (o2Ptr->mixins.num != 0) {
	FOREACH(mixinPtr, o2Ptr->mixins) {
	    if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
		TclOORemoveFromInstances(o2Ptr, mixinPtr);
	    }
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
	Tcl_Free(o2Ptr->mixins.list);
    }
    DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
    FOREACH(mixinPtr, o2Ptr->mixins) {
	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
	    TclOOAddToInstances(o2Ptr, mixinPtr);
	}
	/* For the reference just created in DUPLICATE */
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
	 */

	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOORemoveFromSubclasses(cls2Ptr, superPtr);
	    TclOODecrRefCount(superPtr->thisPtr);
	}
	if (cls2Ptr->superclasses.num) {
	    cls2Ptr->superclasses.list = ckrealloc(cls2Ptr->superclasses.list,
		    sizeof(Class *) * clsPtr->superclasses.num);
	} else {
	    cls2Ptr->superclasses.list =
		    ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
	}
	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
		sizeof(Class *) * clsPtr->superclasses.num);
	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOOAddToSubclasses(cls2Ptr, superPtr);








|



|







2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
	 */

	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOORemoveFromSubclasses(cls2Ptr, superPtr);
	    TclOODecrRefCount(superPtr->thisPtr);
	}
	if (cls2Ptr->superclasses.num) {
	    cls2Ptr->superclasses.list = Tcl_Realloc(cls2Ptr->superclasses.list,
		    sizeof(Class *) * clsPtr->superclasses.num);
	} else {
	    cls2Ptr->superclasses.list =
		    Tcl_Alloc(sizeof(Class *) * clsPtr->superclasses.num);
	}
	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
		sizeof(Class *) * clsPtr->superclasses.num);
	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOOAddToSubclasses(cls2Ptr, superPtr);

2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
	 */

	if (cls2Ptr->mixins.num != 0) {
	    FOREACH(mixinPtr, cls2Ptr->mixins) {
		TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    ckfree(clsPtr->mixins.list);
	}
	DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
	FOREACH(mixinPtr, cls2Ptr->mixins) {
	    TclOOAddToMixinSubs(cls2Ptr, mixinPtr);
	    /* For the copy just created in DUPLICATE */
	    AddRef(mixinPtr->thisPtr);
	}







|







2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
	 */

	if (cls2Ptr->mixins.num != 0) {
	    FOREACH(mixinPtr, cls2Ptr->mixins) {
		TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    Tcl_Free(clsPtr->mixins.list);
	}
	DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
	FOREACH(mixinPtr, cls2Ptr->mixins) {
	    TclOOAddToMixinSubs(cls2Ptr, mixinPtr);
	    /* For the copy just created in DUPLICATE */
	    AddRef(mixinPtr->thisPtr);
	}
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
     * Attach the metadata store if not done already.
     */

    if (clsPtr->metadataPtr == NULL) {
	if (metadata == NULL) {
	    return;
	}
	clsPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS);
    }

    /*
     * If the metadata is NULL, we're deleting the metadata for the type.
     */








|







2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
     * Attach the metadata store if not done already.
     */

    if (clsPtr->metadataPtr == NULL) {
	if (metadata == NULL) {
	    return;
	}
	clsPtr->metadataPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS);
    }

    /*
     * If the metadata is NULL, we're deleting the metadata for the type.
     */

2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
     * Attach the metadata store if not done already.
     */

    if (oPtr->metadataPtr == NULL) {
	if (metadata == NULL) {
	    return;
	}
	oPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS);
    }

    /*
     * If the metadata is NULL, we're deleting the metadata for the type.
     */








|







2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
     * Attach the metadata store if not done already.
     */

    if (oPtr->metadataPtr == NULL) {
	if (metadata == NULL) {
	    return;
	}
	oPtr->metadataPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS);
    }

    /*
     * If the metadata is NULL, we're deleting the metadata for the type.
     */

2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
    }
    Tcl_SetHashValue(hPtr, metadata);
}

/*
 * ----------------------------------------------------------------------
 *
 * PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject --
 *
 *	Main entry point for object invocations. The Public* and Private*
 *	wrapper functions (implementations of both object instance commands
 *	and [my]) are just thin wrappers round the main TclOOObjectCmdCore
 *	function. Note that the core is function is NRE-aware.
 *
 * ----------------------------------------------------------------------
 */

static int
PublicObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv);
}

static int
PublicNRObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD,
	    NULL);
}

static int
PrivateObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv);
}







|









|
|



















|
|







2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
    }
    Tcl_SetHashValue(hPtr, metadata);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOPublicObjectCmd, TclOOPrivateObjectCmd, TclOOInvokeObject --
 *
 *	Main entry point for object invocations. The Public* and Private*
 *	wrapper functions (implementations of both object instance commands
 *	and [my]) are just thin wrappers round the main TclOOObjectCmdCore
 *	function. Note that the core is function is NRE-aware.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOPublicObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv);
}

static int
PublicNRObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD,
	    NULL);
}

int
TclOOPrivateObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv);
}
2530
2531
2532
2533
2534
2535
2536





































2537
2538
2539
2540
2541
2542
2543
	return TclOOObjectCmdCore((Object *) object, interp, objc, objv,
		PRIVATE_METHOD, (Class *) startCls);
    default:
	return TclOOObjectCmdCore((Object *) object, interp, objc, objv, 0,
		(Class *) startCls);
    }
}






































/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjectCmdCore, FinalizeObjectCall --
 *
 *	Main function for object invocations. Does call chain creation,







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
	return TclOOObjectCmdCore((Object *) object, interp, objc, objv,
		PRIVATE_METHOD, (Class *) startCls);
    default:
	return TclOOObjectCmdCore((Object *) object, interp, objc, objv, 0,
		(Class *) startCls);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOMyClassObjCmd, MyClassNRObjCmd --
 *
 *	Special trap door to allow an object to delegate simply to its class.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOMyClassObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, MyClassNRObjCmd, clientData, objc, objv);
}

static int
MyClassNRObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = clientData;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?");
	return TCL_ERROR;
    }
    return TclOOObjectCmdCore(oPtr->selfCls->thisPtr, interp, objc, objv, 0,
	    NULL);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjectCmdCore, FinalizeObjectCall --
 *
 *	Main function for object invocations. Does call chain creation,
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
				 * exactly the name of its public command. */
{
    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);

    if (cmdPtr == NULL) {
	goto notAnObject;
    }
    if (cmdPtr->objProc != PublicObjectCmd) {
	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
	if (cmdPtr == NULL || cmdPtr->objProc != PublicObjectCmd) {
	    goto notAnObject;
	}
    }
    return cmdPtr->objClientData;

  notAnObject:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|

|







2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
				 * exactly the name of its public command. */
{
    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);

    if (cmdPtr == NULL) {
	goto notAnObject;
    }
    if (cmdPtr->objProc != TclOOPublicObjectCmd) {
	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
	if (cmdPtr == NULL || cmdPtr->objProc != TclOOPublicObjectCmd) {
	    goto notAnObject;
	}
    }
    return cmdPtr->objClientData;

  notAnObject:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
Changes to generic/tclOO.decls.
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
    Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method)
}
declare 8 {
    int Tcl_MethodIsPublic(Tcl_Method method)
}
declare 9 {
    int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr,
	    ClientData *clientDataPtr)
}
declare 10 {
    Tcl_Obj *Tcl_MethodName(Tcl_Method method)
}
declare 11 {
    Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    ClientData clientData)
}
declare 12 {
    Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    ClientData clientData)
}
declare 13 {
    Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls,
	    const char *nameStr, const char *nsNameStr, int objc,
	    Tcl_Obj *const *objv, int skip)
}
declare 14 {







|







|




|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
    Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method)
}
declare 8 {
    int Tcl_MethodIsPublic(Tcl_Method method)
}
declare 9 {
    int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr,
	    void **clientDataPtr)
}
declare 10 {
    Tcl_Obj *Tcl_MethodName(Tcl_Method method)
}
declare 11 {
    Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    void *clientData)
}
declare 12 {
    Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    void *clientData)
}
declare 13 {
    Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls,
	    const char *nameStr, const char *nsNameStr, int objc,
	    Tcl_Obj *const *objv, int skip)
}
declare 14 {
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
declare 17 {
    Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context)
}
declare 18 {
    int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context)
}
declare 19 {
    ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 20 {
    void Tcl_ClassSetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr, ClientData metadata)
}
declare 21 {
    ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 22 {
    void Tcl_ObjectSetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr, ClientData metadata)
}
declare 23 {
    int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
	    Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv,
	    int skip)
}
declare 24 {







|




|


|




|







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
declare 17 {
    Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context)
}
declare 18 {
    int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context)
}
declare 19 {
    void *Tcl_ClassGetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 20 {
    void Tcl_ClassSetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr, void *metadata)
}
declare 21 {
    void *Tcl_ObjectGetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 22 {
    void Tcl_ObjectSetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr, void *metadata)
}
declare 23 {
    int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
	    Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv,
	    int skip)
}
declare 24 {
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161

declare 0 {
    Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp)
}
declare 1 {
    Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr,
	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
	    const Tcl_MethodType *typePtr, ClientData clientData,
	    Proc **procPtrPtr)
}
declare 2 {
    Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr,
	    int flags, Tcl_Obj *nameObj, const char *namePtr,
	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr,
	    ClientData clientData, Proc **procPtrPtr)
}
declare 3 {
    Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr,
	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
	    ProcedureMethod **pmPtrPtr)
}
declare 4 {







|






|







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161

declare 0 {
    Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp)
}
declare 1 {
    Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr,
	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
	    const Tcl_MethodType *typePtr, void *clientData,
	    Proc **procPtrPtr)
}
declare 2 {
    Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr,
	    int flags, Tcl_Obj *nameObj, const char *namePtr,
	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr,
	    void *clientData, Proc **procPtrPtr)
}
declare 3 {
    Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr,
	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
	    ProcedureMethod **pmPtrPtr)
}
declare 4 {
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    Method *TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr,
	    int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
}
declare 9 {
    Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
	    Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr,
	    TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc,
	    ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj,
	    Tcl_Obj *bodyObj, int flags, void **internalTokenPtr)
}
declare 10 {
    Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr,
	    TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr,
	    ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj,
	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags,
	    void **internalTokenPtr)
}
declare 11 {
    int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Class startCls, int publicPrivate, int objc,
	    Tcl_Obj *const *objv)







|





|







178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    Method *TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr,
	    int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
}
declare 9 {
    Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
	    Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr,
	    TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc,
	    void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj,
	    Tcl_Obj *bodyObj, int flags, void **internalTokenPtr)
}
declare 10 {
    Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr,
	    TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr,
	    ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj,
	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags,
	    void **internalTokenPtr)
}
declare 11 {
    int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Class startCls, int publicPrivate, int objc,
	    Tcl_Obj *const *objv)
Changes to generic/tclOO.h.
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

/*
 * Public datatypes for callbacks and structures used in the TIP#257 (OO)
 * implementation. These are used to implement custom types of method calls
 * and to allow the attachment of arbitrary data to objects and classes.
 */

typedef int (Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp,
	Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
typedef void (Tcl_MethodDeleteProc)(ClientData clientData);
typedef int (Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData,
	ClientData *newClientData);
typedef void (Tcl_ObjectMetadataDeleteProc)(ClientData clientData);
typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
	Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);

/*
 * The type of a method implementation. This describes how to call the method
 * implementation, how to delete it (when the object or class is deleted) and
 * how to create a clone of it (when the object or class is copied).







|

|
|
|
|







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

/*
 * Public datatypes for callbacks and structures used in the TIP#257 (OO)
 * implementation. These are used to implement custom types of method calls
 * and to allow the attachment of arbitrary data to objects and classes.
 */

typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
typedef void (Tcl_MethodDeleteProc)(void *clientData);
typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData,
	void **newClientData);
typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData);
typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
	Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);

/*
 * The type of a method implementation. This describes how to call the method
 * implementation, how to delete it (when the object or class is deleted) and
 * how to create a clone of it (when the object or class is copied).
Changes to generic/tclOOBasic.c.
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95











96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130



131
132
133
134








135


136


137
138
139
140
141
142
143
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    Tcl_Obj **invoke;

    if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"?definitionScript?");
	return TCL_ERROR;
    } else if (objc == Tcl_ObjectContextSkippedArgs(context)) {
	return TCL_OK;
    }












    /*
     * Delegate to [oo::define] to do the work.
     */

    invoke = ckalloc(3 * sizeof(Tcl_Obj *));
    invoke[0] = oPtr->fPtr->defineName;
    invoke[1] = TclOOObjectName(interp, oPtr);
    invoke[2] = objv[objc-1];

    /*
     * Must add references or errors in configuration script will cause
     * trouble.
     */

    Tcl_IncrRefCount(invoke[0]);
    Tcl_IncrRefCount(invoke[1]);
    Tcl_IncrRefCount(invoke[2]);
    TclNRAddCallback(interp, DecrRefsPostClassConstructor,
	    invoke, NULL, NULL, NULL);

    /*
     * Tricky point: do not want the extra reported level in the Tcl stack
     * trace, so use TCL_EVAL_NOERR.
     */

    return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
}

static int
DecrRefsPostClassConstructor(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **invoke = data[0];




    TclDecrRefCount(invoke[0]);
    TclDecrRefCount(invoke[1]);
    TclDecrRefCount(invoke[2]);








    ckfree(invoke);


    return result;


}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Class_Create --
 *







|









>
>
>
>
>
>
>
>
>
>
>




|













|
















>
>
>




>
>
>
>
>
>
>
>
|
>
>
|
>
>







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    Tcl_Obj **invoke, *nameObj;

    if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"?definitionScript?");
	return TCL_ERROR;
    } else if (objc == Tcl_ObjectContextSkippedArgs(context)) {
	return TCL_OK;
    }

    /*
     * Make the class definition delegate. This is special; it doesn't reenter
     * here (and the class definition delegate doesn't run any constructors).
     */

    nameObj = Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1);
    Tcl_AppendToObj(nameObj, ":: oo ::delegate", -1);
    Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->fPtr->classCls,
	    TclGetString(nameObj), NULL, -1, NULL, -1);
    Tcl_DecrRefCount(nameObj);

    /*
     * Delegate to [oo::define] to do the work.
     */

    invoke = Tcl_Alloc(3 * sizeof(Tcl_Obj *));
    invoke[0] = oPtr->fPtr->defineName;
    invoke[1] = TclOOObjectName(interp, oPtr);
    invoke[2] = objv[objc-1];

    /*
     * Must add references or errors in configuration script will cause
     * trouble.
     */

    Tcl_IncrRefCount(invoke[0]);
    Tcl_IncrRefCount(invoke[1]);
    Tcl_IncrRefCount(invoke[2]);
    TclNRAddCallback(interp, DecrRefsPostClassConstructor,
	    invoke, oPtr, NULL, NULL);

    /*
     * Tricky point: do not want the extra reported level in the Tcl stack
     * trace, so use TCL_EVAL_NOERR.
     */

    return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
}

static int
DecrRefsPostClassConstructor(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **invoke = data[0];
    Object *oPtr = data[1];
    Tcl_InterpState saved;
    int code;

    TclDecrRefCount(invoke[0]);
    TclDecrRefCount(invoke[1]);
    TclDecrRefCount(invoke[2]);
    invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", -1);
    invoke[1] = TclOOObjectName(interp, oPtr);
    Tcl_IncrRefCount(invoke[0]);
    Tcl_IncrRefCount(invoke[1]);
    saved = Tcl_SaveInterpState(interp, result);
    code = Tcl_EvalObjv(interp, 2, invoke, 0);
    TclDecrRefCount(invoke[0]);
    TclDecrRefCount(invoke[1]);
    Tcl_Free(invoke);
    if (code != TCL_OK) {
	Tcl_DiscardInterpState(saved);
	return code;
    }
    return Tcl_RestoreInterpState(interp, saved);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Class_Create --
 *
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    const char *objName;
    int len;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {







|







179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    const char *objName;
    size_t len;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
     */

    if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object name must not be empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }







|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
     */

    if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName ?arg ...?");
	return TCL_ERROR;
    }
    objName = TclGetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object name must not be empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
     */

    if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName namespaceName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object name must not be empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }
    nsName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)+1], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"namespace name must not be empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }







|







|







269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
     */

    if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName namespaceName ?arg ...?");
	return TCL_ERROR;
    }
    objName = TclGetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object name must not be empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }
    nsName = TclGetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)+1], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"namespace name must not be empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
	}
	Tcl_AppendToObj(errorMsg, methodNames[i], -1);
    }
    if (i) {
	Tcl_AppendToObj(errorMsg, " or ", -1);
    }
    Tcl_AppendToObj(errorMsg, methodNames[i], -1);
    ckfree(methodNames);
    Tcl_SetObjResult(interp, errorMsg);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
	    TclGetString(objv[skip]), NULL);
    return TCL_ERROR;
}

/*







|







601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
	}
	Tcl_AppendToObj(errorMsg, methodNames[i], -1);
    }
    if (i) {
	Tcl_AppendToObj(errorMsg, " or ", -1);
    }
    Tcl_AppendToObj(errorMsg, methodNames[i], -1);
    Tcl_Free(methodNames);
    Tcl_SetObjResult(interp, errorMsg);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
	    TclGetString(objv[skip]), NULL);
    return TCL_ERROR;
}

/*
Changes to generic/tclOOCall.c.
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213

    FOREACH_HASH_VALUE(callPtr, tablePtr) {
	if (callPtr) {
	    TclOODeleteChain(callPtr);
	}
    }
    Tcl_DeleteHashTable(tablePtr);
    ckfree(tablePtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteChain --
 *
 *	Destroys a method call-chain.
 *
 * ----------------------------------------------------------------------
 */

void
TclOODeleteChain(
    CallChain *callPtr)
{
    if (callPtr == NULL || callPtr->refCount-- > 1) {
	return;
    }
    if (callPtr->chain != callPtr->staticChain) {
	ckfree(callPtr->chain);
    }
    ckfree(callPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOStashContext --
 *







|




















|

|







176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213

    FOREACH_HASH_VALUE(callPtr, tablePtr) {
	if (callPtr) {
	    TclOODeleteChain(callPtr);
	}
    }
    Tcl_DeleteHashTable(tablePtr);
    Tcl_Free(tablePtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteChain --
 *
 *	Destroys a method call-chain.
 *
 * ----------------------------------------------------------------------
 */

void
TclOODeleteChain(
    CallChain *callPtr)
{
    if (callPtr == NULL || callPtr->refCount-- > 1) {
	return;
    }
    if (callPtr->chain != callPtr->staticChain) {
	Tcl_Free(callPtr->chain);
    }
    Tcl_Free(callPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOStashContext --
 *
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
    Tcl_HashTable *namesPtr,	/* The table of names; unsorted, but contains
				 * whether the names are wanted and under what
				 * circumstances. */
    int flags,			/* Whether we are looking for unexported
				 * methods. Full private methods are handled
				 * on insertion to the table. */
    const char ***stringsPtr)	/* Where to store the sorted list of strings
				 * that we produce. ckalloced() */
{
    const char **strings;
    FOREACH_HASH_DECLS;
    Tcl_Obj *namePtr;
    void *isWanted;
    int i = 0;








|







564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
    Tcl_HashTable *namesPtr,	/* The table of names; unsorted, but contains
				 * whether the names are wanted and under what
				 * circumstances. */
    int flags,			/* Whether we are looking for unexported
				 * methods. Full private methods are handled
				 * on insertion to the table. */
    const char ***stringsPtr)	/* Where to store the sorted list of strings
				 * that we produce. Tcl_Alloced() */
{
    const char **strings;
    FOREACH_HASH_DECLS;
    Tcl_Obj *namePtr;
    void *isWanted;
    int i = 0;

588
589
590
591
592
593
594
595
596
597
598
599
600
601
602

    /*
     * We need to build the list of methods to sort. We will be using qsort()
     * for this, because it is very unlikely that the list will be heavily
     * sorted when it is long enough to matter.
     */

    strings = ckalloc(sizeof(char *) * namesPtr->numEntries);
    FOREACH_HASH(namePtr, isWanted, namesPtr) {
	if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
	    if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
		continue;
	    }
	    strings[i++] = TclGetString(namePtr);
	}







|







588
589
590
591
592
593
594
595
596
597
598
599
600
601
602

    /*
     * We need to build the list of methods to sort. We will be using qsort()
     * for this, because it is very unlikely that the list will be heavily
     * sorted when it is long enough to matter.
     */

    strings = Tcl_Alloc(sizeof(char *) * namesPtr->numEntries);
    FOREACH_HASH(namePtr, isWanted, namesPtr) {
	if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
	    if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
		continue;
	    }
	    strings[i++] = TclGetString(namePtr);
	}
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624

    if (i > 0) {
	if (i > 1) {
	    qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
	}
	*stringsPtr = strings;
    } else {
	ckfree(strings);
	*stringsPtr = NULL;
    }
    return i;
}

/* Comparator for SortMethodNames */
static int







|







610
611
612
613
614
615
616
617
618
619
620
621
622
623
624

    if (i > 0) {
	if (i > 1) {
	    qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
	}
	*stringsPtr = strings;
    } else {
	Tcl_Free(strings);
	*stringsPtr = NULL;
    }
    return i;
}

/* Comparator for SortMethodNames */
static int
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
     * Need to really add the method. This is made a bit more complex by the
     * fact that we are using some "static" space initially, and only start
     * realloc-ing if the chain gets long.
     */

    if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
	callPtr->chain =
		ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
	memcpy(callPtr->chain, callPtr->staticChain,
		sizeof(struct MInvoke) * callPtr->numChain);
    } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
	callPtr->chain = ckrealloc(callPtr->chain,
		sizeof(struct MInvoke) * (callPtr->numChain + 1));
    }
    callPtr->chain[i].mPtr = mPtr;
    callPtr->chain[i].isFilter = (doneFilters != NULL);
    callPtr->chain[i].filterDeclarer = filterDecl;
    callPtr->numChain++;
}







|



|







1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
     * Need to really add the method. This is made a bit more complex by the
     * fact that we are using some "static" space initially, and only start
     * realloc-ing if the chain gets long.
     */

    if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
	callPtr->chain =
		Tcl_Alloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
	memcpy(callPtr->chain, callPtr->staticChain,
		sizeof(struct MInvoke) * callPtr->numChain);
    } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
	callPtr->chain = Tcl_Realloc(callPtr->chain,
		sizeof(struct MInvoke) * (callPtr->numChain + 1));
    }
    callPtr->chain[i].mPtr = mPtr;
    callPtr->chain[i].isFilter = (doneFilters != NULL);
    callPtr->chain[i].filterDeclarer = filterDecl;
    callPtr->numChain++;
}
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
	    Tcl_SetHashValue(hPtr, NULL);
	    TclOODeleteChain(callPtr);
	}

	doFilters = 1;
    }

    callPtr = ckalloc(sizeof(CallChain));
    InitCallChain(callPtr, oPtr, flags);

    cb.callChainPtr = callPtr;
    cb.filterLength = 0;
    cb.oPtr = oPtr;

    /*
     * If we're working with a forced use of unknown, do that now.
     */

    if (flags & FORCE_UNKNOWN) {
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
		NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = -1;
	if (callPtr->numChain == 0) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
	goto returnContext;
    }








|

















|







1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
	    Tcl_SetHashValue(hPtr, NULL);
	    TclOODeleteChain(callPtr);
	}

	doFilters = 1;
    }

    callPtr = Tcl_Alloc(sizeof(CallChain));
    InitCallChain(callPtr, oPtr, flags);

    cb.callChainPtr = callPtr;
    cb.filterLength = 0;
    cb.oPtr = oPtr;

    /*
     * If we're working with a forced use of unknown, do that now.
     */

    if (flags & FORCE_UNKNOWN) {
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
		NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = 0;
	if (callPtr->numChain == 0) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
	goto returnContext;
    }

1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
	}
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
		NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = -1;
	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else if (doFilters && !donePrivate) {
	if (hPtr == NULL) {
	    if (oPtr->flags & USE_CLASS_CACHE) {
		if (oPtr->selfCls->classChainCache == NULL) {
		    oPtr->selfCls->classChainCache =
			    ckalloc(sizeof(Tcl_HashTable));

		    Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
		}
		hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache,
			(char *) methodNameObj, &i);
	    } else {
		if (oPtr->chainCache == NULL) {
		    oPtr->chainCache = ckalloc(sizeof(Tcl_HashTable));

		    Tcl_InitObjHashTable(oPtr->chainCache);
		}
		hPtr = Tcl_CreateHashEntry(oPtr->chainCache,
			(char *) methodNameObj, &i);
	    }
	}







|









|







|







1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
	}
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
		NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = 0;
	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else if (doFilters && !donePrivate) {
	if (hPtr == NULL) {
	    if (oPtr->flags & USE_CLASS_CACHE) {
		if (oPtr->selfCls->classChainCache == NULL) {
		    oPtr->selfCls->classChainCache =
			    Tcl_Alloc(sizeof(Tcl_HashTable));

		    Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
		}
		hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache,
			(char *) methodNameObj, &i);
	    } else {
		if (oPtr->chainCache == NULL) {
		    oPtr->chainCache = Tcl_Alloc(sizeof(Tcl_HashTable));

		    Tcl_InitObjHashTable(oPtr->chainCache);
		}
		hPtr = Tcl_CreateHashEntry(oPtr->chainCache,
			(char *) methodNameObj, &i);
	    }
	}
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
	    Tcl_SetHashValue(hPtr, NULL);
	    TclOODeleteChain(callPtr);
	}
    } else {
	hPtr = NULL;
    }

    callPtr = ckalloc(sizeof(CallChain));
    memset(callPtr, 0, sizeof(CallChain));
    callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
    callPtr->epoch = fPtr->epoch;
    callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount;
    callPtr->objectEpoch = clsPtr->thisPtr->epoch;
    callPtr->refCount = 1;
    callPtr->chain = callPtr->staticChain;







|







1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
	    Tcl_SetHashValue(hPtr, NULL);
	    TclOODeleteChain(callPtr);
	}
    } else {
	hPtr = NULL;
    }

    callPtr = Tcl_Alloc(sizeof(CallChain));
    memset(callPtr, 0, sizeof(CallChain));
    callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
    callPtr->epoch = fPtr->epoch;
    callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount;
    callPtr->objectEpoch = clsPtr->thisPtr->epoch;
    callPtr->refCount = 1;
    callPtr->chain = callPtr->staticChain;
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490

    if (count == callPtr->numChain) {
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = -1;
	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else {
	if (hPtr == NULL) {
	    if (clsPtr->classChainCache == NULL) {
		clsPtr->classChainCache = ckalloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(clsPtr->classChainCache);
	    }
	    hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
		    (char *) methodNameObj, &i);
	}
	callPtr->refCount++;
	Tcl_SetHashValue(hPtr, callPtr);







|







|







1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490

    if (count == callPtr->numChain) {
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = 0;
	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else {
	if (hPtr == NULL) {
	    if (clsPtr->classChainCache == NULL) {
		clsPtr->classChainCache = Tcl_Alloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(clsPtr->classChainCache);
	    }
	    hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
		    (char *) methodNameObj, &i);
	}
	callPtr->refCount++;
	Tcl_SetHashValue(hPtr, callPtr);
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
		methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN,
		filterDecl);
    }

    if (flags & CONSTRUCTOR) {
	AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
		filterDecl, flags);

    } else if (flags & DESTRUCTOR) {
	AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
		filterDecl, flags);
    } else {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
		(char *) methodNameObj);








<







1700
1701
1702
1703
1704
1705
1706

1707
1708
1709
1710
1711
1712
1713
		methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN,
		filterDecl);
    }

    if (flags & CONSTRUCTOR) {
	AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
		filterDecl, flags);

    } else if (flags & DESTRUCTOR) {
	AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
		filterDecl, flags);
    } else {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
		(char *) methodNameObj);

Changes to generic/tclOODecls.h.
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
/* 7 */
TCLAPI Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
/* 8 */
TCLAPI int		Tcl_MethodIsPublic(Tcl_Method method);
/* 9 */
TCLAPI int		Tcl_MethodIsType(Tcl_Method method,
				const Tcl_MethodType *typePtr,
				ClientData *clientDataPtr);
/* 10 */
TCLAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
/* 11 */
TCLAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
				Tcl_Object object, Tcl_Obj *nameObj,
				int flags, const Tcl_MethodType *typePtr,
				ClientData clientData);
/* 12 */
TCLAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
				Tcl_Obj *nameObj, int flags,
				const Tcl_MethodType *typePtr,
				ClientData clientData);
/* 13 */
TCLAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
				Tcl_Class cls, const char *nameStr,
				const char *nsNameStr, int objc,
				Tcl_Obj *const *objv, int skip);
/* 14 */
TCLAPI int		Tcl_ObjectDeleted(Tcl_Object object);
/* 15 */
TCLAPI int		Tcl_ObjectContextIsFiltering(
				Tcl_ObjectContext context);
/* 16 */
TCLAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
/* 17 */
TCLAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
/* 18 */
TCLAPI int		Tcl_ObjectContextSkippedArgs(
				Tcl_ObjectContext context);
/* 19 */
TCLAPI ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr);
/* 20 */
TCLAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr,
				ClientData metadata);
/* 21 */
TCLAPI ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr);
/* 22 */
TCLAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr,
				ClientData metadata);
/* 23 */
TCLAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
				Tcl_ObjectContext context, int objc,
				Tcl_Obj *const *objv, int skip);
/* 24 */
TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
				Tcl_Object object);







|






|




|


















|




|

|




|







52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
/* 7 */
TCLAPI Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
/* 8 */
TCLAPI int		Tcl_MethodIsPublic(Tcl_Method method);
/* 9 */
TCLAPI int		Tcl_MethodIsType(Tcl_Method method,
				const Tcl_MethodType *typePtr,
				void **clientDataPtr);
/* 10 */
TCLAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
/* 11 */
TCLAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
				Tcl_Object object, Tcl_Obj *nameObj,
				int flags, const Tcl_MethodType *typePtr,
				void *clientData);
/* 12 */
TCLAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
				Tcl_Obj *nameObj, int flags,
				const Tcl_MethodType *typePtr,
				void *clientData);
/* 13 */
TCLAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
				Tcl_Class cls, const char *nameStr,
				const char *nsNameStr, int objc,
				Tcl_Obj *const *objv, int skip);
/* 14 */
TCLAPI int		Tcl_ObjectDeleted(Tcl_Object object);
/* 15 */
TCLAPI int		Tcl_ObjectContextIsFiltering(
				Tcl_ObjectContext context);
/* 16 */
TCLAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
/* 17 */
TCLAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
/* 18 */
TCLAPI int		Tcl_ObjectContextSkippedArgs(
				Tcl_ObjectContext context);
/* 19 */
TCLAPI void *		Tcl_ClassGetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr);
/* 20 */
TCLAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr,
				void *metadata);
/* 21 */
TCLAPI void *		Tcl_ObjectGetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr);
/* 22 */
TCLAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr,
				void *metadata);
/* 23 */
TCLAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
				Tcl_ObjectContext context, int objc,
				Tcl_Obj *const *objv, int skip);
/* 24 */
TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
				Tcl_Object object);
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
    Tcl_Class (*tcl_GetObjectAsClass) (Tcl_Object object); /* 2 */
    Tcl_Command (*tcl_GetObjectCommand) (Tcl_Object object); /* 3 */
    Tcl_Object (*tcl_GetObjectFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 4 */
    Tcl_Namespace * (*tcl_GetObjectNamespace) (Tcl_Object object); /* 5 */
    Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */
    Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */
    int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
    int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */
    Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
    Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
    Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
    Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */
    int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
    int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
    Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */
    Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
    int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
    ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */
    ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
    void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */
    int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */
    Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
    void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
    void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
    void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
    Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
    int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */







|

|
|






|
|
|
|







135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
    Tcl_Class (*tcl_GetObjectAsClass) (Tcl_Object object); /* 2 */
    Tcl_Command (*tcl_GetObjectCommand) (Tcl_Object object); /* 3 */
    Tcl_Object (*tcl_GetObjectFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 4 */
    Tcl_Namespace * (*tcl_GetObjectNamespace) (Tcl_Object object); /* 5 */
    Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */
    Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */
    int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
    int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 9 */
    Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
    Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 11 */
    Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 12 */
    Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */
    int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
    int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
    Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */
    Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
    int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
    void * (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 20 */
    void * (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
    void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 22 */
    int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */
    Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
    void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
    void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
    void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
    Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
    int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
Changes to generic/tclOODefineCmds.c.
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47


48
49
50
51
52
53
54
 * Some things that make it easier to declare a slot.
 */

struct DeclaredSlot {
    const char *name;
    const Tcl_MethodType getterType;
    const Tcl_MethodType setterType;

};

#define SLOT(name,getter,setter)					\
    {"::oo::" name,							\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
		    getter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
		    setter, NULL, NULL}}



/*
 * Forward declarations.
 */

static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,







>


|




|
>
>







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 * Some things that make it easier to declare a slot.
 */

struct DeclaredSlot {
    const char *name;
    const Tcl_MethodType getterType;
    const Tcl_MethodType setterType;
    const Tcl_MethodType resolverType;
};

#define SLOT(name,getter,setter,resolver)				\
    {"::oo::" name,							\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
		    getter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
		    setter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \
		    resolver, NULL, NULL}}

/*
 * Forward declarations.
 */

static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
105
106
107
108
109
110
111



112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);




/*
 * Now define the slots used in declarations.
 */

static const struct DeclaredSlot slots[] = {
    SLOT("define::filter",      ClassFilterGet, ClassFilterSet),
    SLOT("define::mixin",       ClassMixinGet,  ClassMixinSet),
    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet),
    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet),
    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet),
    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet),
    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet),
    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
};

/*
 * How to build the in-namespace name of a private variable. This is a pattern
 * used with Tcl_ObjPrintf().
 */








>
>
>






|
|
|
|
|
|
|
|







108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ResolveClass(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);

/*
 * Now define the slots used in declarations.
 */

static const struct DeclaredSlot slots[] = {
    SLOT("define::filter",      ClassFilterGet, ClassFilterSet, NULL),
    SLOT("define::mixin",       ClassMixinGet,  ClassMixinSet, ResolveClass),
    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet, ResolveClass),
    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet, NULL),
    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet, NULL),
    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet, ResolveClass),
    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet, NULL),
    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
};

/*
 * How to build the in-namespace name of a private variable. This is a pattern
 * used with Tcl_ObjPrintf().
 */

249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
    }

    if (numFilters == 0) {
	/*
	 * No list of filters was supplied, so we're deleting filters.
	 */

	ckfree(oPtr->filters.list);
	oPtr->filters.list = NULL;
	oPtr->filters.num = 0;
	RecomputeClassCacheFlag(oPtr);
    } else {
	/*
	 * We've got a list of filters, so we're creating filters.
	 */

	Tcl_Obj **filtersList;
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (oPtr->filters.num == 0) {
	    filtersList = ckalloc(size);
	} else {
	    filtersList = ckrealloc(oPtr->filters.list, size);
	}
	for (i=0 ; i<numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	oPtr->filters.list = filtersList;
	oPtr->filters.num = numFilters;







|












|

|







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
    }

    if (numFilters == 0) {
	/*
	 * No list of filters was supplied, so we're deleting filters.
	 */

	Tcl_Free(oPtr->filters.list);
	oPtr->filters.list = NULL;
	oPtr->filters.num = 0;
	RecomputeClassCacheFlag(oPtr);
    } else {
	/*
	 * We've got a list of filters, so we're creating filters.
	 */

	Tcl_Obj **filtersList;
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (oPtr->filters.num == 0) {
	    filtersList = Tcl_Alloc(size);
	} else {
	    filtersList = Tcl_Realloc(oPtr->filters.list, size);
	}
	for (i=0 ; i<numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	oPtr->filters.list = filtersList;
	oPtr->filters.num = numFilters;
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
    }

    if (numFilters == 0) {
	/*
	 * No list of filters was supplied, so we're deleting filters.
	 */

	ckfree(classPtr->filters.list);
	classPtr->filters.list = NULL;
	classPtr->filters.num = 0;
    } else {
	/*
	 * We've got a list of filters, so we're creating filters.
	 */

	Tcl_Obj **filtersList;
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (classPtr->filters.num == 0) {
	    filtersList = ckalloc(size);
	} else {
	    filtersList = ckrealloc(classPtr->filters.list, size);
	}
	for (i=0 ; i<numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	classPtr->filters.list = filtersList;
	classPtr->filters.num = numFilters;







|











|

|







315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
    }

    if (numFilters == 0) {
	/*
	 * No list of filters was supplied, so we're deleting filters.
	 */

	Tcl_Free(classPtr->filters.list);
	classPtr->filters.list = NULL;
	classPtr->filters.num = 0;
    } else {
	/*
	 * We've got a list of filters, so we're creating filters.
	 */

	Tcl_Obj **filtersList;
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (classPtr->filters.num == 0) {
	    filtersList = Tcl_Alloc(size);
	} else {
	    filtersList = Tcl_Realloc(classPtr->filters.list, size);
	}
	for (i=0 ; i<numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	classPtr->filters.list = filtersList;
	classPtr->filters.num = numFilters;
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394

    if (numMixins == 0) {
	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		TclOORemoveFromInstances(oPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    ckfree(oPtr->mixins.list);
	    oPtr->mixins.num = 0;
	}
	RecomputeClassCacheFlag(oPtr);
    } else {
	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		if (mixinPtr && mixinPtr != oPtr->selfCls) {
		    TclOORemoveFromInstances(oPtr, mixinPtr);
		}
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    oPtr->mixins.list = ckrealloc(oPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    oPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
	    oPtr->flags &= ~USE_CLASS_CACHE;
	}
	oPtr->mixins.num = numMixins;
	memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, oPtr->mixins) {
	    if (mixinPtr != oPtr->selfCls) {
		TclOOAddToInstances(oPtr, mixinPtr);







|











|


|







371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400

    if (numMixins == 0) {
	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		TclOORemoveFromInstances(oPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    Tcl_Free(oPtr->mixins.list);
	    oPtr->mixins.num = 0;
	}
	RecomputeClassCacheFlag(oPtr);
    } else {
	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		if (mixinPtr && mixinPtr != oPtr->selfCls) {
		    TclOORemoveFromInstances(oPtr, mixinPtr);
		}
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    oPtr->mixins.list = Tcl_Realloc(oPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    oPtr->mixins.list = Tcl_Alloc(sizeof(Class *) * numMixins);
	    oPtr->flags &= ~USE_CLASS_CACHE;
	}
	oPtr->mixins.num = numMixins;
	memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, oPtr->mixins) {
	    if (mixinPtr != oPtr->selfCls) {
		TclOOAddToInstances(oPtr, mixinPtr);
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448

    if (numMixins == 0) {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    ckfree(classPtr->mixins.list);
	    classPtr->mixins.num = 0;
	}
    } else {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    classPtr->mixins.list = ckrealloc(classPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
	}
	classPtr->mixins.num = numMixins;
	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, classPtr->mixins) {
	    TclOOAddToMixinSubs(classPtr, mixinPtr);
	    /* For the new copy created by memcpy */
	    AddRef(mixinPtr->thisPtr);







|








|


|







428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454

    if (numMixins == 0) {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    Tcl_Free(classPtr->mixins.list);
	    classPtr->mixins.num = 0;
	}
    } else {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    classPtr->mixins.list = Tcl_Realloc(classPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    classPtr->mixins.list = Tcl_Alloc(sizeof(Class *) * numMixins);
	}
	classPtr->mixins.num = numMixins;
	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, classPtr->mixins) {
	    TclOOAddToMixinSubs(classPtr, mixinPtr);
	    /* For the new copy created by memcpy */
	    AddRef(mixinPtr->thisPtr);
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, *vnlPtr) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(vnlPtr->list);
	} else if (i) {
	    vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
	} else {
	    vnlPtr->list = ckalloc(sizeof(Tcl_Obj *) * varc);
	}
    }
    vnlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		vnlPtr->list[n++] = varv[i];
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	vnlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

static inline void
InstallPrivateVariableMapping(







|

|

|




















|







480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, *vnlPtr) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    Tcl_Free(vnlPtr->list);
	} else if (i) {
	    vnlPtr->list = Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
	} else {
	    vnlPtr->list = Tcl_Alloc(sizeof(Tcl_Obj *) * varc);
	}
    }
    vnlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		vnlPtr->list[n++] = varv[i];
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	vnlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    vnlPtr->list = Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

static inline void
InstallPrivateVariableMapping(
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
    }
    FOREACH_STRUCT(privatePtr, *pvlPtr) {
	Tcl_DecrRefCount(privatePtr->variableObj);
	Tcl_DecrRefCount(privatePtr->fullNameObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(pvlPtr->list);
	} else if (i) {
	    pvlPtr->list = ckrealloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * varc);
	} else {
	    pvlPtr->list = ckalloc(sizeof(PrivateVariableMapping) * varc);
	}
    }

    pvlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {







|

|


|







531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
    }
    FOREACH_STRUCT(privatePtr, *pvlPtr) {
	Tcl_DecrRefCount(privatePtr->variableObj);
	Tcl_DecrRefCount(privatePtr->fullNameObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    Tcl_Free(pvlPtr->list);
	} else if (i) {
	    pvlPtr->list = Tcl_Realloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * varc);
	} else {
	    pvlPtr->list = Tcl_Alloc(sizeof(PrivateVariableMapping) * varc);
	}
    }

    pvlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
	pvlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    pvlPtr->list = ckrealloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

/*







|







563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
	pvlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    pvlPtr->list = Tcl_Realloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

/*
1365
1366
1367
1368
1369
1370
1371


1372
1373
1374
1375
1376
1377
1378
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;



    /*
     * Parse the context to get the object to operate on.
     */

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {







>
>







1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Foundation *fPtr = TclOOGetFoundation(interp);
    int wasClass, willBeClass;

    /*
     * Parse the context to get the object to operate on.
     */

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
1400
1401
1402
1403
1404
1405
1406





1407
1408
1409
1410
1411
1412



1413
1414
1415
1416
1417
1418




















1419
1420
1421
1422
1423
1424
1425
	return TCL_ERROR;
    }
    clsPtr = GetClassInOuterContext(interp, objv[1],
	    "the class of an object must be a class");
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }







    /*
     * Set the object's class.
     */




    if (oPtr->selfCls != clsPtr) {
	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
	TclOODecrRefCount(oPtr->selfCls->thisPtr);
	oPtr->selfCls = clsPtr;
	AddRef(oPtr->selfCls->thisPtr);
	TclOOAddToInstances(oPtr, oPtr->selfCls);





















	if (oPtr->classPtr != NULL) {
	    BumpGlobalEpoch(interp, oPtr->classPtr);
	} else {
	    oPtr->epoch++;
	}
    }







>
>
>
>
>
|





>
>
>






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
	return TCL_ERROR;
    }
    clsPtr = GetClassInOuterContext(interp, objv[1],
	    "the class of an object must be a class");
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    if (oPtr == clsPtr->thisPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not change classes into an instance of themselves", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
     * Set the object's class.
     */

    wasClass = (oPtr->classPtr != NULL);
    willBeClass = (TclOOIsReachable(fPtr->classCls, clsPtr));

    if (oPtr->selfCls != clsPtr) {
	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
	TclOODecrRefCount(oPtr->selfCls->thisPtr);
	oPtr->selfCls = clsPtr;
	AddRef(oPtr->selfCls->thisPtr);
	TclOOAddToInstances(oPtr, oPtr->selfCls);

	/*
	 * Create or delete the class guts if necessary.
	 */

	if (wasClass && !willBeClass) {
	    /*
	     * This is the most global of all epochs. Bump it! No cache can be
	     * trusted!
	     */

	    TclOORemoveFromMixins(oPtr->classPtr, oPtr);
	    oPtr->fPtr->epoch++;
	    oPtr->flags |= DONT_DELETE;
	    TclOODeleteDescendants(interp, oPtr);
	    oPtr->flags &= ~DONT_DELETE;
	    TclOOReleaseClassContents(interp, oPtr);
	} else if (!wasClass && willBeClass) {
	    TclOOAllocClass(interp, oPtr);
	}

	if (oPtr->classPtr != NULL) {
	    BumpGlobalEpoch(interp, oPtr->classPtr);
	} else {
	    oPtr->epoch++;
	}
    }
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    TclGetStringFromObj(objv[2], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, objv[1], objv[2], NULL);







|







1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    (void)TclGetStringFromObj(objv[2], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, objv[1], objv[2], NULL);
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    TclGetStringFromObj(objv[1], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, NULL, objv[1], NULL);







|







1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    (void)TclGetStringFromObj(objv[1], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, NULL, objv[1], NULL);
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
	 * instance of) then we put in a blank record with that flag; such
	 * records are skipped over by the call chain engine *except* for
	 * their flags member.
	 */

	if (isInstanceExport) {
	    if (!oPtr->methodsPtr) {
		oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(oPtr->methodsPtr);
		oPtr->flags &= ~USE_CLASS_CACHE;
	    }
	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
		    &isNew);
	} else {
	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
		    &isNew);
	}

	if (isNew) {
	    mPtr = ckalloc(sizeof(Method));
	    memset(mPtr, 0, sizeof(Method));
	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = Tcl_GetHashValue(hPtr);







|











|







1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
	 * instance of) then we put in a blank record with that flag; such
	 * records are skipped over by the call chain engine *except* for
	 * their flags member.
	 */

	if (isInstanceExport) {
	    if (!oPtr->methodsPtr) {
		oPtr->methodsPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(oPtr->methodsPtr);
		oPtr->flags &= ~USE_CLASS_CACHE;
	    }
	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
		    &isNew);
	} else {
	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
		    &isNew);
	}

	if (isNew) {
	    mPtr = Tcl_Alloc(sizeof(Method));
	    memset(mPtr, 0, sizeof(Method));
	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = Tcl_GetHashValue(hPtr);
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
	 * an instance of) then we put in a blank record without that flag;
	 * such records are skipped over by the call chain engine *except* for
	 * their flags member.
	 */

	if (isInstanceUnexport) {
	    if (!oPtr->methodsPtr) {
		oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(oPtr->methodsPtr);
		oPtr->flags &= ~USE_CLASS_CACHE;
	    }
	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
		    &isNew);
	} else {
	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
		    &isNew);
	}

	if (isNew) {
	    mPtr = ckalloc(sizeof(Method));
	    memset(mPtr, 0, sizeof(Method));
	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = Tcl_GetHashValue(hPtr);







|











|







1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
	 * an instance of) then we put in a blank record without that flag;
	 * such records are skipped over by the call chain engine *except* for
	 * their flags member.
	 */

	if (isInstanceUnexport) {
	    if (!oPtr->methodsPtr) {
		oPtr->methodsPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(oPtr->methodsPtr);
		oPtr->flags &= ~USE_CLASS_CACHE;
	    }
	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
		    &isNew);
	} else {
	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
		    &isNew);
	}

	if (isNew) {
	    mPtr = Tcl_Alloc(sizeof(Method));
	    memset(mPtr, 0, sizeof(Method));
	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = Tcl_GetHashValue(hPtr);
2059
2060
2061
2062
2063
2064
2065

2066
2067
2068
2069
2070
2071
2072
2073
2074

2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085




2086
2087
2088

2089
2090
2091
2092
2093
2094
2095
int
TclOODefineSlots(
    Foundation *fPtr)
{
    const struct DeclaredSlot *slotInfoPtr;
    Tcl_Obj *getName = Tcl_NewStringObj("Get", -1);
    Tcl_Obj *setName = Tcl_NewStringObj("Set", -1);

    Class *slotCls;

    slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
	    fPtr->classCls, "::oo::Slot", NULL, -1, NULL, 0))->classPtr;
    if (slotCls == NULL) {
	return TCL_ERROR;
    }
    Tcl_IncrRefCount(getName);
    Tcl_IncrRefCount(setName);

    for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
	Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
		(Tcl_Class) slotCls, slotInfoPtr->name, NULL,-1,NULL,0);

	if (slotObject == NULL) {
	    continue;
	}
	Tcl_NewInstanceMethod(fPtr->interp, slotObject, getName, 0,
		&slotInfoPtr->getterType, NULL);
	Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0,
		&slotInfoPtr->setterType, NULL);




    }
    Tcl_DecrRefCount(getName);
    Tcl_DecrRefCount(setName);

    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassFilterGet, ClassFilterSet --







>









>


|








>
>
>
>



>







2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
int
TclOODefineSlots(
    Foundation *fPtr)
{
    const struct DeclaredSlot *slotInfoPtr;
    Tcl_Obj *getName = Tcl_NewStringObj("Get", -1);
    Tcl_Obj *setName = Tcl_NewStringObj("Set", -1);
    Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", -1);
    Class *slotCls;

    slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
	    fPtr->classCls, "::oo::Slot", NULL, -1, NULL, 0))->classPtr;
    if (slotCls == NULL) {
	return TCL_ERROR;
    }
    Tcl_IncrRefCount(getName);
    Tcl_IncrRefCount(setName);
    Tcl_IncrRefCount(resolveName);
    for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
	Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
		(Tcl_Class) slotCls, slotInfoPtr->name, NULL, -1, NULL, 0);

	if (slotObject == NULL) {
	    continue;
	}
	Tcl_NewInstanceMethod(fPtr->interp, slotObject, getName, 0,
		&slotInfoPtr->getterType, NULL);
	Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0,
		&slotInfoPtr->setterType, NULL);
	if (slotInfoPtr->resolverType.callProc) {
	    Tcl_NewInstanceMethod(fPtr->interp, slotObject, resolveName, 0,
		    &slotInfoPtr->resolverType, NULL);
	}
    }
    Tcl_DecrRefCount(getName);
    Tcl_DecrRefCount(setName);
    Tcl_DecrRefCount(resolveName);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassFilterGet, ClassFilterSet --
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
	return TCL_ERROR;
    }

    /*
     * Allocate some working space.
     */

    superclasses = (Class **) ckalloc(sizeof(Class *) * superc);

    /*
     * Parse the arguments to get the class to use as superclasses.
     *
     * Note that zero classes is special, as it is equivalent to just the
     * class of objects. [Bug 9d61624b3d]
     */

    if (superc == 0) {
	superclasses = ckrealloc(superclasses, sizeof(Class *));
	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
	    superclasses[0] = oPtr->fPtr->classCls;
	} else {
	    superclasses[0] = oPtr->fPtr->objectCls;
	}
	superc = 1;
	AddRef(superclasses[0]->thisPtr);







|









|







2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
	return TCL_ERROR;
    }

    /*
     * Allocate some working space.
     */

    superclasses = (Class **) Tcl_Alloc(sizeof(Class *) * superc);

    /*
     * Parse the arguments to get the class to use as superclasses.
     *
     * Note that zero classes is special, as it is equivalent to just the
     * class of objects. [Bug 9d61624b3d]
     */

    if (superc == 0) {
	superclasses = Tcl_Realloc(superclasses, sizeof(Class *));
	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
	    superclasses[0] = oPtr->fPtr->classCls;
	} else {
	    superclasses[0] = oPtr->fPtr->objectCls;
	}
	superc = 1;
	AddRef(superclasses[0]->thisPtr);
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"attempt to form circular dependency graph", -1));
		Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
	    failedAfterAlloc:
		for (; i > 0; i--) {
		    TclOODecrRefCount(superclasses[i]->thisPtr);
		}
		ckfree(superclasses);
		return TCL_ERROR;
	    }

	    /*
	     * Corresponding TclOODecrRefCount() is near the end of this
	     * function.
	     */







|







2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"attempt to form circular dependency graph", -1));
		Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
	    failedAfterAlloc:
		for (; i > 0; i--) {
		    TclOODecrRefCount(superclasses[i]->thisPtr);
		}
		Tcl_Free(superclasses);
		return TCL_ERROR;
	    }

	    /*
	     * Corresponding TclOODecrRefCount() is near the end of this
	     * function.
	     */
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
     */

    if (oPtr->classPtr->superclasses.num != 0) {
	FOREACH(superPtr, oPtr->classPtr->superclasses) {
	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
	    TclOODecrRefCount(superPtr->thisPtr);
	}
	ckfree(oPtr->classPtr->superclasses.list);
    }
    oPtr->classPtr->superclasses.list = superclasses;
    oPtr->classPtr->superclasses.num = superc;
    FOREACH(superPtr, oPtr->classPtr->superclasses) {
	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
    }
    BumpGlobalEpoch(interp, oPtr->classPtr);







|







2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
     */

    if (oPtr->classPtr->superclasses.num != 0) {
	FOREACH(superPtr, oPtr->classPtr->superclasses) {
	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
	    TclOODecrRefCount(superPtr->thisPtr);
	}
	Tcl_Free(oPtr->classPtr->superclasses.list);
    }
    oPtr->classPtr->superclasses.list = superclasses;
    oPtr->classPtr->superclasses.num = superc;
    FOREACH(superPtr, oPtr->classPtr->superclasses) {
	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
    }
    BumpGlobalEpoch(interp, oPtr->classPtr);
2807
2808
2809
2810
2811
2812
2813





















































2814
2815
2816
2817
2818
2819
2820
2821
2822
2823

    if (IsPrivateDefine(interp)) {
	InstallPrivateVariableMapping(&oPtr->privateVariables, varc, varv,
		oPtr->creationEpoch);
    } else {
	InstallStandardVariableMapping(&oPtr->variables, varc, varv);
    }





















































    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>










2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919

    if (IsPrivateDefine(interp)) {
	InstallPrivateVariableMapping(&oPtr->privateVariables, varc, varv,
		oPtr->creationEpoch);
    } else {
	InstallStandardVariableMapping(&oPtr->variables, varc, varv);
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ResolveClass --
 *
 *	Implementation of the "Resolve" support method for some slots (those
 *	that are slots around a list of classes). This resolves possible class
 *	names to their fully-qualified names if possible.
 *
 * ----------------------------------------------------------------------
 */

static int
ResolveClass(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    int idx = Tcl_ObjectContextSkippedArgs(context);
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Class *clsPtr;

    /*
     * Check if were called wrongly. The definition context isn't used...
     * except that GetClassInOuterContext() assumes that it is there.
     */

    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (objc != idx + 1) {
	Tcl_WrongNumArgs(interp, idx, objv, "slotElement");
	return TCL_ERROR;
    }

    /*
     * Resolve the class if possible. If not, remove any resolution error and
     * return what we've got anyway as the failure might not be fatal overall.
     */

    clsPtr = GetClassInOuterContext(interp, objv[idx],
	    "USER SHOULD NOT SEE THIS MESSAGE");
    if (clsPtr == NULL) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, objv[idx]);
    } else {
	Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
    }

    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclOOInfo.c.
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
		&names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    ckfree(names);
	}
    } else if (oPtr->methodsPtr) {
	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
	    }
	}







|







604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
		&names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    Tcl_Free(names);
	}
    } else if (oPtr->methodsPtr) {
	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
	    }
	}
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
	int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    ckfree(names);
	}
    } else {
	FOREACH_HASH_DECLS;

	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);







|







1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
	int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    Tcl_Free(names);
	}
    } else {
	FOREACH_HASH_DECLS;

	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
Changes to generic/tclOOInt.h.
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
 */

typedef struct Method {
    const Tcl_MethodType *typePtr;
				/* The type of method. If NULL, this is a
				 * special flag record which is just used for
				 * the setting of the flags field. */
    int refCount;
    ClientData clientData;	/* Type-specific data. */
    Tcl_Obj *namePtr;		/* Name of the method. */
    struct Object *declaringObjectPtr;
				/* The object that declares this method, or
				 * NULL if it was declared by a class. */
    struct Class *declaringClassPtr;
				/* The class that declares this method, or
				 * NULL if it was declared directly on an
				 * object. */
    int flags;			/* Assorted flags. Includes whether this
				 * method is public/exported or not. */
} Method;

/*
 * Pre- and post-call callbacks, to allow procedure-like methods to be fine
 * tuned in their behaviour.
 */

typedef int (TclOO_PreCallProc)(ClientData clientData, Tcl_Interp *interp,
	Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished);
typedef int (TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp,
	Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result);
typedef void (TclOO_PmCDDeleteProc)(ClientData clientData);
typedef ClientData (TclOO_PmCDCloneProc)(ClientData clientData);

/*
 * Procedure-like methods have the following extra information.
 */

typedef struct ProcedureMethod {
    int version;		/* Version of this structure. Currently must
				 * be 0. */
    Proc *procPtr;		/* Core of the implementation of the method;
				 * includes the argument definition and the
				 * body bytecodes. */
    int flags;			/* Flags to control features. */
    int refCount;
    ClientData clientData;
    TclOO_PmCDDeleteProc *deleteClientdataProc;
    TclOO_PmCDCloneProc *cloneClientdataProc;
    ProcErrorProc *errProc;	/* Replacement error handler. */
    TclOO_PreCallProc *preCallProc;
				/* Callback to allow for additional setup
				 * before the method executes. */
    TclOO_PostCallProc *postCallProc;







|
|

















|

|

|
|












|
|







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
 */

typedef struct Method {
    const Tcl_MethodType *typePtr;
				/* The type of method. If NULL, this is a
				 * special flag record which is just used for
				 * the setting of the flags field. */
    size_t refCount;
    void *clientData;	/* Type-specific data. */
    Tcl_Obj *namePtr;		/* Name of the method. */
    struct Object *declaringObjectPtr;
				/* The object that declares this method, or
				 * NULL if it was declared by a class. */
    struct Class *declaringClassPtr;
				/* The class that declares this method, or
				 * NULL if it was declared directly on an
				 * object. */
    int flags;			/* Assorted flags. Includes whether this
				 * method is public/exported or not. */
} Method;

/*
 * Pre- and post-call callbacks, to allow procedure-like methods to be fine
 * tuned in their behaviour.
 */

typedef int (TclOO_PreCallProc)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished);
typedef int (TclOO_PostCallProc)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result);
typedef void (TclOO_PmCDDeleteProc)(void *clientData);
typedef void *(TclOO_PmCDCloneProc)(void *clientData);

/*
 * Procedure-like methods have the following extra information.
 */

typedef struct ProcedureMethod {
    int version;		/* Version of this structure. Currently must
				 * be 0. */
    Proc *procPtr;		/* Core of the implementation of the method;
				 * includes the argument definition and the
				 * body bytecodes. */
    int flags;			/* Flags to control features. */
    size_t refCount;
    void *clientData;
    TclOO_PmCDDeleteProc *deleteClientdataProc;
    TclOO_PmCDCloneProc *cloneClientdataProc;
    ProcErrorProc *errProc;	/* Replacement error handler. */
    TclOO_PreCallProc *preCallProc;
				/* Callback to allow for additional setup
				 * before the method executes. */
    TclOO_PostCallProc *postCallProc;
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211


212
213
214
215
216
217
218
    LIST_STATIC(struct Class *) mixins;
				/* Classes mixed into this object. */
    LIST_STATIC(Tcl_Obj *) filters;
				/* List of filter names. */
    struct Class *classPtr;	/* This is non-NULL for all classes, and NULL
				 *  for everything else. It points to the class
				 *  structure. */
    int refCount;		/* Number of strong references to this object.
				 * Note that there may be many more weak
				 * references; this mechanism exists to
				 * avoid Tcl_Preserve. */
    int flags;
    int creationEpoch;		/* Unique value to make comparisons of objects
				 * easier. */
    int epoch;			/* Per-object epoch, incremented when the way
				 * an object should resolve call chains is
				 * changed. */
    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
				 * the ClientData values that are the values
				 * of each piece of attached metadata. This
				 * field starts out as NULL and is only
				 * allocated if metadata is attached. */
    Tcl_Obj *cachedNameObj;	/* Cache of the name of the object. */
    Tcl_HashTable *chainCache;	/* Place to keep unused contexts. This table
				 * is indexed by method name as Tcl_Obj. */
    Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
				/* Function to allow remapping of method
				 * names. For itcl-ng. */
    VariableNameList variables;
    PrivateVariableList privateVariables;
				/* Configurations for the variable resolver
				 * used inside methods. */


} Object;

#define OBJECT_DELETED	1	/* Flag to say that an object has been
				 * destroyed. */
#define DESTRUCTOR_CALLED 2	/* Flag to say that the destructor has been
				 * called. */
#define CLASS_GONE	4	/* Obsolete. Indicates that the class of this







|




|

|



|













>
>







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
    LIST_STATIC(struct Class *) mixins;
				/* Classes mixed into this object. */
    LIST_STATIC(Tcl_Obj *) filters;
				/* List of filter names. */
    struct Class *classPtr;	/* This is non-NULL for all classes, and NULL
				 *  for everything else. It points to the class
				 *  structure. */
    size_t refCount;		/* Number of strong references to this object.
				 * Note that there may be many more weak
				 * references; this mechanism exists to
				 * avoid Tcl_Preserve. */
    int flags;
    size_t creationEpoch;		/* Unique value to make comparisons of objects
				 * easier. */
    size_t epoch;			/* Per-object epoch, incremented when the way
				 * an object should resolve call chains is
				 * changed. */
    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
				 * the void *values that are the values
				 * of each piece of attached metadata. This
				 * field starts out as NULL and is only
				 * allocated if metadata is attached. */
    Tcl_Obj *cachedNameObj;	/* Cache of the name of the object. */
    Tcl_HashTable *chainCache;	/* Place to keep unused contexts. This table
				 * is indexed by method name as Tcl_Obj. */
    Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
				/* Function to allow remapping of method
				 * names. For itcl-ng. */
    VariableNameList variables;
    PrivateVariableList privateVariables;
				/* Configurations for the variable resolver
				 * used inside methods. */
    Tcl_Command myclassCommand;	/* Reference to this object's class dispatcher
				 * command. */
} Object;

#define OBJECT_DELETED	1	/* Flag to say that an object has been
				 * destroyed. */
#define DESTRUCTOR_CALLED 2	/* Flag to say that the destructor has been
				 * called. */
#define CLASS_GONE	4	/* Obsolete. Indicates that the class of this
236
237
238
239
240
241
242




243
244
245
246
247
248
249
				 * other spots). */
#define FORCE_UNKNOWN 0x10000	/* States that we are *really* looking up the
				 * unknown method handler at that point. */
#define HAS_PRIVATE_METHODS 0x20000
				/* Object/class has (or had) private methods,
				 * and so shouldn't be cached so
				 * aggressively. */





/*
 * And the definition of a class. Note that every class also has an associated
 * object, through which it is manipulated.
 */

typedef struct Class {







>
>
>
>







238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
				 * other spots). */
#define FORCE_UNKNOWN 0x10000	/* States that we are *really* looking up the
				 * unknown method handler at that point. */
#define HAS_PRIVATE_METHODS 0x20000
				/* Object/class has (or had) private methods,
				 * and so shouldn't be cached so
				 * aggressively. */
#define DONT_DELETE 0x40000	/* Inhibit deletion of this object. Used
				 * during fundamental object type mutation to
				 * make sure that the object actually survives
				 * to the end of the operation. */

/*
 * And the definition of a class. Note that every class also has an associated
 * object, through which it is manipulated.
 */

typedef struct Class {
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
				 * the (Tcl_Obj*) method name to the (Method*)
				 * method record. */
    Method *constructorPtr;	/* Method record of the class constructor (if
				 * any). */
    Method *destructorPtr;	/* Method record of the class destructor (if
				 * any). */
    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
				 * the ClientData values that are the values
				 * of each piece of attached metadata. This
				 * field starts out as NULL and is only
				 * allocated if metadata is attached. */
    struct CallChain *constructorChainPtr;
    struct CallChain *destructorChainPtr;
    Tcl_HashTable *classChainCache;
				/* Places where call chains are stored. For







|







282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
				 * the (Tcl_Obj*) method name to the (Method*)
				 * method record. */
    Method *constructorPtr;	/* Method record of the class constructor (if
				 * any). */
    Method *destructorPtr;	/* Method record of the class destructor (if
				 * any). */
    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
				 * the void *values that are the values
				 * of each piece of attached metadata. This
				 * field starts out as NULL and is only
				 * allocated if metadata is attached. */
    struct CallChain *constructorChainPtr;
    struct CallChain *destructorChainPtr;
    Tcl_HashTable *classChainCache;
				/* Places where call chains are stored. For
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
 * The foundation of the object system within an interpreter contains
 * references to the key classes and namespaces, together with a few other
 * useful bits and pieces. Probably ought to eventually go in the Interp
 * structure itself.
 */

typedef struct ThreadLocalData {
    int nsCount;		/* Master epoch counter is used for keeping
				 * the values used in Tcl_Obj internal
				 * representations sane. Must be thread-local
				 * because Tcl_Objs can cross interpreter
				 * boundaries within a thread (objects don't
				 * generally cross threads). */
} ThreadLocalData;








|







310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
 * The foundation of the object system within an interpreter contains
 * references to the key classes and namespaces, together with a few other
 * useful bits and pieces. Probably ought to eventually go in the Interp
 * structure itself.
 */

typedef struct ThreadLocalData {
    size_t nsCount;		/* Master epoch counter is used for keeping
				 * the values used in Tcl_Obj internal
				 * representations sane. Must be thread-local
				 * because Tcl_Objs can cross interpreter
				 * boundaries within a thread (objects don't
				 * generally cross threads). */
} ThreadLocalData;

328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
    Tcl_Namespace *objdefNs;	/* Namespace containing special commands for
				 * manipulating objects and classes. The
				 * "oo::objdefine" command acts as a special
				 * kind of ensemble for this namespace. */
    Tcl_Namespace *helpersNs;	/* Namespace containing the commands that are
				 * only valid when executing inside a
				 * procedural method. */
    int epoch;			/* Used to invalidate method chains when the
				 * class structure changes. */
    ThreadLocalData *tsdPtr;	/* Counter so we can allocate a unique
				 * namespace to each object. */
    Tcl_Obj *unknownMethodNameObj;
				/* Shared object containing the name of the
				 * unknown method handler method. */
    Tcl_Obj *constructorName;	/* Shared object containing the "name" of a







|







334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
    Tcl_Namespace *objdefNs;	/* Namespace containing special commands for
				 * manipulating objects and classes. The
				 * "oo::objdefine" command acts as a special
				 * kind of ensemble for this namespace. */
    Tcl_Namespace *helpersNs;	/* Namespace containing the commands that are
				 * only valid when executing inside a
				 * procedural method. */
    size_t epoch;			/* Used to invalidate method chains when the
				 * class structure changes. */
    ThreadLocalData *tsdPtr;	/* Counter so we can allocate a unique
				 * namespace to each object. */
    Tcl_Obj *unknownMethodNameObj;
				/* Shared object containing the name of the
				 * unknown method handler method. */
    Tcl_Obj *constructorName;	/* Shared object containing the "name" of a
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
				 * record. */
    int isFilter;		/* Whether this is a filter invocation. */
    Class *filterDeclarer;	/* What class decided to add the filter; if
				 * NULL, it was added by the object. */
};

typedef struct CallChain {
    int objectCreationEpoch;	/* The object's creation epoch. Note that the
				 * object reference is not stored in the call
				 * chain; it is in the call context. */
    int objectEpoch;		/* Local (object structure) epoch counter
				 * snapshot. */
    int epoch;			/* Global (class structure) epoch counter
				 * snapshot. */
    int flags;			/* Assorted flags, see below. */
    int refCount;		/* Reference count. */
    int numChain;		/* Size of the call chain. */
    struct MInvoke *chain;	/* Array of call chain entries. May point to
				 * staticChain if the number of entries is
				 * small. */
    struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE];
} CallChain;








|


|

|


|







368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
				 * record. */
    int isFilter;		/* Whether this is a filter invocation. */
    Class *filterDeclarer;	/* What class decided to add the filter; if
				 * NULL, it was added by the object. */
};

typedef struct CallChain {
    size_t objectCreationEpoch;	/* The object's creation epoch. Note that the
				 * object reference is not stored in the call
				 * chain; it is in the call context. */
    size_t objectEpoch;		/* Local (object structure) epoch counter
				 * snapshot. */
    size_t epoch;			/* Global (class structure) epoch counter
				 * snapshot. */
    int flags;			/* Assorted flags, see below. */
    size_t refCount;		/* Reference count. */
    int numChain;		/* Size of the call chain. */
    struct MInvoke *chain;	/* Array of call chain entries. May point to
				 * staticChain if the number of entries is
				 * small. */
    struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE];
} CallChain;

422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482



























483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526


527
528
529
530
531
532
533
534
535
536
537
538
539
540


541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567


568

569
570
571
572
573
574
575
/*
 *----------------------------------------------------------------
 * Commands relating to OO support.
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE int	TclOODefineObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOObjDefObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineConstructorObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineDeleteMethodObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineDestructorObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineExportObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineForwardObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineMethodObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineRenameMethodObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineUnexportObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineClassObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineObjSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefinePrivateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOUnknownDefinition(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOCopyObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextToObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);



























MODULE_SCOPE int	TclOOSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);

/*
 * Method implementations (in tclOOBasic.c).
 */

MODULE_SCOPE int	TclOO_Class_Constructor(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_Create(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_CreateNs(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_New(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Destroy(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Eval(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_LinkVar(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Unknown(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_VarName(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);

/*
 * Private definitions, some of which perhaps ought to be exposed properly or
 * maybe just put in the internal stubs table.
 */

MODULE_SCOPE void	TclOOAddToInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void	TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
MODULE_SCOPE void	TclOOAddToSubclasses(Class *subPtr, Class *superPtr);


MODULE_SCOPE int	TclNRNewObjectInstance(Tcl_Interp *interp,
			    Tcl_Class cls, const char *nameStr,
			    const char *nsNameStr, int objc,
			    Tcl_Obj *const *objv, int skip,
			    Tcl_Object *objectPtr);
MODULE_SCOPE Object *	TclNewObjectInstanceCommon(Tcl_Interp *interp,
			    Class *classPtr,
			    const char *nameStr,
			    const char *nsNameStr);
MODULE_SCOPE int	TclOODecrRefCount(Object *oPtr);
MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);


MODULE_SCOPE void	TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
			    Tcl_Obj *methodNameObj, int flags,
			    Object *contextObjPtr, Class *contextClsPtr,
			    Tcl_Obj *cacheInThisObj);
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
			    Tcl_Obj *methodNameObj, int flags);
MODULE_SCOPE Foundation	*TclOOGetFoundation(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclOOGetFwdFromMethod(Method *mPtr);
MODULE_SCOPE Proc *	TclOOGetProcFromMethod(Method *mPtr);
MODULE_SCOPE Tcl_Obj *	TclOOGetMethodBody(Method *mPtr);
MODULE_SCOPE int	TclOOGetSortedClassMethodList(Class *clsPtr,
			    int flags, const char ***stringsPtr);
MODULE_SCOPE int	TclOOGetSortedMethodList(Object *oPtr,
			    Object *contextObj, Class *contextCls, int flags,
			    const char ***stringsPtr);
MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE void	TclOOInitInfo(Tcl_Interp *interp);
MODULE_SCOPE int	TclOOInvokeContext(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
			    Tcl_ObjectContext context, int objc,
			    Tcl_Obj *const *objv, int skip);
MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
			    const DeclaredClassMethod *dcm);
MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);


MODULE_SCOPE int	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);

MODULE_SCOPE int	TclOORemoveFromMixinSubs(Class *subPtr,
			    Class *mixinPtr);
MODULE_SCOPE int	TclOORemoveFromSubclasses(Class *subPtr,
			    Class *superPtr);
MODULE_SCOPE Tcl_Obj *	TclOORenderCallChain(Tcl_Interp *interp,
			    CallChain *callPtr);
MODULE_SCOPE void	TclOOStashContext(Tcl_Obj *objPtr,







|


|


|


|


|


|


|


|


|


|


|


|


|


<
<
<
|


|


|


|


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|







|


|


|


|


|


|


|


|


|











>
>














>
>


















|








>
>

>







428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473



474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
/*
 *----------------------------------------------------------------
 * Commands relating to OO support.
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE int	TclOODefineObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOObjDefObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineConstructorObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineDeleteMethodObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineDestructorObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineExportObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineForwardObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineMethodObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineRenameMethodObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineUnexportObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineClassObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineObjSelfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);



MODULE_SCOPE int	TclOOUnknownDefinition(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOCopyObjectCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextToObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineUnexportObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineClassObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineObjSelfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefinePrivateObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOUnknownDefinition(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOCopyObjectCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextToObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOSelfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);

/*
 * Method implementations (in tclOOBasic.c).
 */

MODULE_SCOPE int	TclOO_Class_Constructor(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_Create(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_CreateNs(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_New(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Destroy(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Eval(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_LinkVar(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Unknown(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_VarName(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);

/*
 * Private definitions, some of which perhaps ought to be exposed properly or
 * maybe just put in the internal stubs table.
 */

MODULE_SCOPE void	TclOOAddToInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void	TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
MODULE_SCOPE void	TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
MODULE_SCOPE Class *	TclOOAllocClass(Tcl_Interp *interp,
			    Object *useThisObj);
MODULE_SCOPE int	TclNRNewObjectInstance(Tcl_Interp *interp,
			    Tcl_Class cls, const char *nameStr,
			    const char *nsNameStr, int objc,
			    Tcl_Obj *const *objv, int skip,
			    Tcl_Object *objectPtr);
MODULE_SCOPE Object *	TclNewObjectInstanceCommon(Tcl_Interp *interp,
			    Class *classPtr,
			    const char *nameStr,
			    const char *nsNameStr);
MODULE_SCOPE int	TclOODecrRefCount(Object *oPtr);
MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
MODULE_SCOPE void	TclOODeleteDescendants(Tcl_Interp *interp,
			    Object *oPtr);
MODULE_SCOPE void	TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
			    Tcl_Obj *methodNameObj, int flags,
			    Object *contextObjPtr, Class *contextClsPtr,
			    Tcl_Obj *cacheInThisObj);
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
			    Tcl_Obj *methodNameObj, int flags);
MODULE_SCOPE Foundation	*TclOOGetFoundation(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclOOGetFwdFromMethod(Method *mPtr);
MODULE_SCOPE Proc *	TclOOGetProcFromMethod(Method *mPtr);
MODULE_SCOPE Tcl_Obj *	TclOOGetMethodBody(Method *mPtr);
MODULE_SCOPE int	TclOOGetSortedClassMethodList(Class *clsPtr,
			    int flags, const char ***stringsPtr);
MODULE_SCOPE int	TclOOGetSortedMethodList(Object *oPtr,
			    Object *contextObj, Class *contextCls, int flags,
			    const char ***stringsPtr);
MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE void	TclOOInitInfo(Tcl_Interp *interp);
MODULE_SCOPE int	TclOOInvokeContext(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
			    Tcl_ObjectContext context, int objc,
			    Tcl_Obj *const *objv, int skip);
MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
			    const DeclaredClassMethod *dcm);
MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void	TclOOReleaseClassContents(Tcl_Interp *interp,
			    Object *oPtr);
MODULE_SCOPE int	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE int	TclOORemoveFromMixins(Class *mixinPtr, Object *oPtr);
MODULE_SCOPE int	TclOORemoveFromMixinSubs(Class *subPtr,
			    Class *mixinPtr);
MODULE_SCOPE int	TclOORemoveFromSubclasses(Class *subPtr,
			    Class *superPtr);
MODULE_SCOPE Tcl_Obj *	TclOORenderCallChain(Tcl_Interp *interp,
			    CallChain *callPtr);
MODULE_SCOPE void	TclOOStashContext(Tcl_Obj *objPtr,
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
 * Convenience macro for duplicating a list. Needs no external declaration,
 * but all arguments are used multiple times and so must have no side effects.
 */

#undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */
#define DUPLICATE(target,source,type) \
    do { \
	register unsigned len = sizeof(type) * ((target).num=(source).num);\
	if (len != 0) { \
	    memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \
	} else { \
	    (target).list = NULL; \
	} \
    } while(0)

#endif /* TCL_OO_INTERNAL_H */








|

|







668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
 * Convenience macro for duplicating a list. Needs no external declaration,
 * but all arguments are used multiple times and so must have no side effects.
 */

#undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */
#define DUPLICATE(target,source,type) \
    do { \
	register size_t len = sizeof(type) * ((target).num=(source).num);\
	if (len != 0) { \
	    memcpy(((target).list=(type*)Tcl_Alloc(len)), (source).list, len); \
	} else { \
	    (target).list = NULL; \
	} \
    } while(0)

#endif /* TCL_OO_INTERNAL_H */

Changes to generic/tclOOIntDecls.h.
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
/* 0 */
TCLAPI Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
/* 1 */
TCLAPI Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
				Object *oPtr, int flags, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				const Tcl_MethodType *typePtr,
				ClientData clientData, Proc **procPtrPtr);
/* 2 */
TCLAPI Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
				Class *clsPtr, int flags, Tcl_Obj *nameObj,
				const char *namePtr, Tcl_Obj *argsObj,
				Tcl_Obj *bodyObj,
				const Tcl_MethodType *typePtr,
				ClientData clientData, Proc **procPtrPtr);
/* 3 */
TCLAPI Method *		TclOONewProcInstanceMethod(Tcl_Interp *interp,
				Object *oPtr, int flags, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				ProcedureMethod **pmPtrPtr);
/* 4 */
TCLAPI Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,







|






|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
/* 0 */
TCLAPI Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
/* 1 */
TCLAPI Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
				Object *oPtr, int flags, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				const Tcl_MethodType *typePtr,
				void *clientData, Proc **procPtrPtr);
/* 2 */
TCLAPI Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
				Class *clsPtr, int flags, Tcl_Obj *nameObj,
				const char *namePtr, Tcl_Obj *argsObj,
				Tcl_Obj *bodyObj,
				const Tcl_MethodType *typePtr,
				void *clientData, Proc **procPtrPtr);
/* 3 */
TCLAPI Method *		TclOONewProcInstanceMethod(Tcl_Interp *interp,
				Object *oPtr, int flags, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				ProcedureMethod **pmPtrPtr);
/* 4 */
TCLAPI Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
				Object *oPtr, int isPublic, Tcl_Obj *nameObj,
				Tcl_Obj *prefixObj);
/* 9 */
TCLAPI Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
				Tcl_Object oPtr,
				TclOO_PreCallProc *preCallPtr,
				TclOO_PostCallProc *postCallPtr,
				ProcErrorProc *errProc,
				ClientData clientData, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				int flags, void **internalTokenPtr);
/* 10 */
TCLAPI Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
				Tcl_Class clsPtr,
				TclOO_PreCallProc *preCallPtr,
				TclOO_PostCallProc *postCallPtr,
				ProcErrorProc *errProc,
				ClientData clientData, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				int flags, void **internalTokenPtr);
/* 11 */
TCLAPI int		TclOOInvokeObject(Tcl_Interp *interp,
				Tcl_Object object, Tcl_Class startCls,
				int publicPrivate, int objc,
				Tcl_Obj *const *objv);
/* 12 */
TCLAPI void		TclOOObjectSetFilters(Object *oPtr, int numFilters,







|
|
|
|





|
|
|
|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
				Object *oPtr, int isPublic, Tcl_Obj *nameObj,
				Tcl_Obj *prefixObj);
/* 9 */
TCLAPI Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
				Tcl_Object oPtr,
				TclOO_PreCallProc *preCallPtr,
				TclOO_PostCallProc *postCallPtr,
				ProcErrorProc *errProc, void *clientData,
				Tcl_Obj *nameObj, Tcl_Obj *argsObj,
				Tcl_Obj *bodyObj, int flags,
				void **internalTokenPtr);
/* 10 */
TCLAPI Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
				Tcl_Class clsPtr,
				TclOO_PreCallProc *preCallPtr,
				TclOO_PostCallProc *postCallPtr,
				ProcErrorProc *errProc, void *clientData,
				Tcl_Obj *nameObj, Tcl_Obj *argsObj,
				Tcl_Obj *bodyObj, int flags,
				void **internalTokenPtr);
/* 11 */
TCLAPI int		TclOOInvokeObject(Tcl_Interp *interp,
				Tcl_Object object, Tcl_Class startCls,
				int publicPrivate, int objc,
				Tcl_Obj *const *objv);
/* 12 */
TCLAPI void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
				Class *const *mixins);

typedef struct TclOOIntStubs {
    int magic;
    void *hooks;

    Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */
    Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 1 */
    Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */
    Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */
    Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */
    int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */
    int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */
    Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */
    Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */
    Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */
    Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */
    int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */
    void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */
    void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */
    void (*tclOOObjectSetMixins) (Object *oPtr, int numMixins, Class *const *mixins); /* 14 */
    void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */
} TclOOIntStubs;








|
|






|
|







93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
				Class *const *mixins);

typedef struct TclOOIntStubs {
    int magic;
    void *hooks;

    Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */
    Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 1 */
    Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */
    Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */
    Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */
    int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */
    int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */
    Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */
    Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */
    Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */
    Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */
    int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */
    void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */
    void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */
    void (*tclOOObjectSetMixins) (Object *oPtr, int numMixins, Class *const *mixins); /* 14 */
    void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */
} TclOOIntStubs;

Changes to generic/tclOOMethod.c.
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
{
    register Object *oPtr = (Object *) object;
    register Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (nameObj == NULL) {
	mPtr = ckalloc(sizeof(Method));
	mPtr->namePtr = NULL;
	mPtr->refCount = 1;
	goto populate;
    }
    if (!oPtr->methodsPtr) {
	oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitObjHashTable(oPtr->methodsPtr);
	oPtr->flags &= ~USE_CLASS_CACHE;
    }
    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew);
    if (isNew) {
	mPtr = ckalloc(sizeof(Method));
	mPtr->namePtr = nameObj;
	mPtr->refCount = 1;
	Tcl_IncrRefCount(nameObj);
	Tcl_SetHashValue(hPtr, mPtr);
    } else {
	mPtr = Tcl_GetHashValue(hPtr);
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {







|





|





|







151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
{
    register Object *oPtr = (Object *) object;
    register Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (nameObj == NULL) {
	mPtr = Tcl_Alloc(sizeof(Method));
	mPtr->namePtr = NULL;
	mPtr->refCount = 1;
	goto populate;
    }
    if (!oPtr->methodsPtr) {
	oPtr->methodsPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitObjHashTable(oPtr->methodsPtr);
	oPtr->flags &= ~USE_CLASS_CACHE;
    }
    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew);
    if (isNew) {
	mPtr = Tcl_Alloc(sizeof(Method));
	mPtr->namePtr = nameObj;
	mPtr->refCount = 1;
	Tcl_IncrRefCount(nameObj);
	Tcl_SetHashValue(hPtr, mPtr);
    } else {
	mPtr = Tcl_GetHashValue(hPtr);
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
{
    register Class *clsPtr = (Class *) cls;
    register Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (nameObj == NULL) {
	mPtr = ckalloc(sizeof(Method));
	mPtr->namePtr = NULL;
	mPtr->refCount = 1;
	goto populate;
    }
    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew);
    if (isNew) {
	mPtr = ckalloc(sizeof(Method));
	mPtr->refCount = 1;
	mPtr->namePtr = nameObj;
	Tcl_IncrRefCount(nameObj);
	Tcl_SetHashValue(hPtr, mPtr);
    } else {
	mPtr = Tcl_GetHashValue(hPtr);
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {







|






|







223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
{
    register Class *clsPtr = (Class *) cls;
    register Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (nameObj == NULL) {
	mPtr = Tcl_Alloc(sizeof(Method));
	mPtr->namePtr = NULL;
	mPtr->refCount = 1;
	goto populate;
    }
    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew);
    if (isNew) {
	mPtr = Tcl_Alloc(sizeof(Method));
	mPtr->refCount = 1;
	mPtr->namePtr = nameObj;
	Tcl_IncrRefCount(nameObj);
	Tcl_SetHashValue(hPtr, mPtr);
    } else {
	mPtr = Tcl_GetHashValue(hPtr);
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
	    mPtr->typePtr->deleteProc(mPtr->clientData);
	}
	if (mPtr->namePtr != NULL) {
	    Tcl_DecrRefCount(mPtr->namePtr);
	}

	ckfree(mPtr);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOONewBasicMethod --







|







282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
	    mPtr->typePtr->deleteProc(mPtr->clientData);
	}
	if (mPtr->namePtr != NULL) {
	    Tcl_DecrRefCount(mPtr->namePtr);
	}

	Tcl_Free(mPtr);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOONewBasicMethod --
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
    int argsLen;
    register ProcedureMethod *pmPtr;
    Tcl_Method method;

    if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    }
    pmPtr = ckalloc(sizeof(ProcedureMethod));
    memset(pmPtr, 0, sizeof(ProcedureMethod));
    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->refCount = 1;

    method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj,
	    argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
    if (method == NULL) {
	ckfree(pmPtr);
    } else if (pmPtrPtr != NULL) {
	*pmPtrPtr = pmPtr;
    }
    return (Method *) method;
}

/*







|








|







346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
    int argsLen;
    register ProcedureMethod *pmPtr;
    Tcl_Method method;

    if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    }
    pmPtr = Tcl_Alloc(sizeof(ProcedureMethod));
    memset(pmPtr, 0, sizeof(ProcedureMethod));
    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->refCount = 1;

    method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj,
	    argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
    if (method == NULL) {
	Tcl_Free(pmPtr);
    } else if (pmPtrPtr != NULL) {
	*pmPtrPtr = pmPtr;
    }
    return (Method *) method;
}

/*
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
	procName = "<destructor>";
    } else if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    } else {
	procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
    }

    pmPtr = ckalloc(sizeof(ProcedureMethod));
    memset(pmPtr, 0, sizeof(ProcedureMethod));
    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->refCount = 1;

    method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName,
	    argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);

    if (argsLen == -1) {
	Tcl_DecrRefCount(argsObj);
    }
    if (method == NULL) {
	ckfree(pmPtr);
    } else if (pmPtrPtr != NULL) {
	*pmPtrPtr = pmPtr;
    }

    return (Method *) method;
}








|












|







407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
	procName = "<destructor>";
    } else if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    } else {
	procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
    }

    pmPtr = Tcl_Alloc(sizeof(ProcedureMethod));
    memset(pmPtr, 0, sizeof(ProcedureMethod));
    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->refCount = 1;

    method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName,
	    argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);

    if (argsLen == -1) {
	Tcl_DecrRefCount(argsObj);
    }
    if (method == NULL) {
	Tcl_Free(pmPtr);
    } else if (pmPtrPtr != NULL) {
	*pmPtrPtr = pmPtr;
    }

    return (Method *) method;
}

501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
	     * proc body was not created by substitution.
	     * (FIXME: check that this is sane and correct!)
	     */

	    if (context.line
		    && (context.nline >= 4) && (context.line[3] >= 0)) {
		int isNew;
		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
		Tcl_HashEntry *hPtr;

		cfPtr->level = -1;
		cfPtr->type = context.type;
		cfPtr->line = ckalloc(sizeof(int));
		cfPtr->line[0] = context.line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = context.data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);







|




|







501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
	     * proc body was not created by substitution.
	     * (FIXME: check that this is sane and correct!)
	     */

	    if (context.line
		    && (context.nline >= 4) && (context.line[3] >= 0)) {
		int isNew;
		CmdFrame *cfPtr = Tcl_Alloc(sizeof(CmdFrame));
		Tcl_HashEntry *hPtr;

		cfPtr->level = -1;
		cfPtr->type = context.type;
		cfPtr->line = Tcl_Alloc(sizeof(int));
		cfPtr->line[0] = context.line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = context.data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
	     * proc body was not created by substitution.
	     * (FIXME: check that this is sane and correct!)
	     */

	    if (context.line
		    && (context.nline >= 4) && (context.line[3] >= 0)) {
		int isNew;
		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
		Tcl_HashEntry *hPtr;

		cfPtr->level = -1;
		cfPtr->type = context.type;
		cfPtr->line = ckalloc(sizeof(int));
		cfPtr->line[0] = context.line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = context.data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);







|




|







614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
	     * proc body was not created by substitution.
	     * (FIXME: check that this is sane and correct!)
	     */

	    if (context.line
		    && (context.nline >= 4) && (context.line[3] >= 0)) {
		int isNew;
		CmdFrame *cfPtr = Tcl_Alloc(sizeof(CmdFrame));
		Tcl_HashEntry *hPtr;

		cfPtr->level = -1;
		cfPtr->type = context.type;
		cfPtr->line = Tcl_Alloc(sizeof(int));
		cfPtr->line[0] = context.line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = context.data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
     */

    if (infoPtr->cachedObjectVar) {
	VarHashRefCount(infoPtr->cachedObjectVar)--;
	TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL);
    }
    Tcl_DecrRefCount(infoPtr->variableObj);
    ckfree(infoPtr);
}

static int
ProcedureMethodCompiledVarResolver(
    Tcl_Interp *interp,
    const char *varName,
    int length,







|







1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
     */

    if (infoPtr->cachedObjectVar) {
	VarHashRefCount(infoPtr->cachedObjectVar)--;
	TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL);
    }
    Tcl_DecrRefCount(infoPtr->variableObj);
    Tcl_Free(infoPtr);
}

static int
ProcedureMethodCompiledVarResolver(
    Tcl_Interp *interp,
    const char *varName,
    int length,
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138

    if (strstr(Tcl_GetString(variableObj), "::") != NULL ||
	    Tcl_StringMatch(Tcl_GetString(variableObj), "*(*)")) {
	Tcl_DecrRefCount(variableObj);
	return TCL_CONTINUE;
    }

    infoPtr = ckalloc(sizeof(OOResVarInfo));
    infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect;
    infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete;
    infoPtr->cachedObjectVar = NULL;
    infoPtr->variableObj = variableObj;
    Tcl_IncrRefCount(variableObj);
    *rPtrPtr = &infoPtr->info;
    return TCL_OK;







|







1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138

    if (strstr(Tcl_GetString(variableObj), "::") != NULL ||
	    Tcl_StringMatch(Tcl_GetString(variableObj), "*(*)")) {
	Tcl_DecrRefCount(variableObj);
	return TCL_CONTINUE;
    }

    infoPtr = Tcl_Alloc(sizeof(OOResVarInfo));
    infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect;
    infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete;
    infoPtr->cachedObjectVar = NULL;
    infoPtr->variableObj = variableObj;
    Tcl_IncrRefCount(variableObj);
    *rPtrPtr = &infoPtr->info;
    return TCL_OK;
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
 *	suitable formatting contexts.
 *
 * ----------------------------------------------------------------------
 */

#define LIMIT 60
#define ELLIPSIFY(str,len) \
	((len) > LIMIT ? LIMIT : (len)), (str), ((len) > LIMIT ? "..." : "")

static void
MethodErrorHandler(
    Tcl_Interp *interp,
    Tcl_Obj *methodNameObj)
{
    int nameLen, objectNameLen;
    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    const char *objectName, *kindName, *methodName =
	    TclGetStringFromObj(mPtr->namePtr, &nameLen);
    Object *declarerPtr;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
	}
	declarerPtr = mPtr->declaringClassPtr->thisPtr;
	kindName = "class";
    }

    objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
	    &objectNameLen);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (%s \"%.*s%s\" method \"%.*s%s\" line %d)",
	    kindName, ELLIPSIFY(objectName, objectNameLen),
	    ELLIPSIFY(methodName, nameLen), Tcl_GetErrorLine(interp)));
}








|






|

















|







1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
 *	suitable formatting contexts.
 *
 * ----------------------------------------------------------------------
 */

#define LIMIT 60
#define ELLIPSIFY(str,len) \
	((len) > LIMIT ? LIMIT : ((int)len)), (str), ((len) > LIMIT ? "..." : "")

static void
MethodErrorHandler(
    Tcl_Interp *interp,
    Tcl_Obj *methodNameObj)
{
    size_t nameLen, objectNameLen;
    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    const char *objectName, *kindName, *methodName =
	    TclGetStringFromObj(mPtr->namePtr, &nameLen);
    Object *declarerPtr;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
	}
	declarerPtr = mPtr->declaringClassPtr->thisPtr;
	kindName = "class";
    }

    objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr),
	    &objectNameLen);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (%s \"%.*s%s\" method \"%.*s%s\" line %d)",
	    kindName, ELLIPSIFY(objectName, objectNameLen),
	    ELLIPSIFY(methodName, nameLen), Tcl_GetErrorLine(interp)));
}

1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
	}
	declarerPtr = mPtr->declaringClassPtr->thisPtr;
	kindName = "class";
    }

    objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
	    &objectNameLen);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (%s \"%.*s%s\" constructor line %d)", kindName,
	    ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
}

static void







|







1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
	}
	declarerPtr = mPtr->declaringClassPtr->thisPtr;
	kindName = "class";
    }

    objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr),
	    &objectNameLen);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (%s \"%.*s%s\" constructor line %d)", kindName,
	    ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
}

static void
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
	}
	declarerPtr = mPtr->declaringClassPtr->thisPtr;
	kindName = "class";
    }

    objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
	    &objectNameLen);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (%s \"%.*s%s\" destructor line %d)", kindName,
	    ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
}

/*







|







1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
	}
	declarerPtr = mPtr->declaringClassPtr->thisPtr;
	kindName = "class";
    }

    objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr),
	    &objectNameLen);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (%s \"%.*s%s\" destructor line %d)", kindName,
	    ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
}

/*
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
DeleteProcedureMethodRecord(
    ProcedureMethod *pmPtr)
{
    TclProcDeleteProc(pmPtr->procPtr);
    if (pmPtr->deleteClientdataProc) {
	pmPtr->deleteClientdataProc(pmPtr->clientData);
    }
    ckfree(pmPtr);
}

static void
DeleteProcedureMethod(
    ClientData clientData)
{
    register ProcedureMethod *pmPtr = clientData;







|







1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
DeleteProcedureMethodRecord(
    ProcedureMethod *pmPtr)
{
    TclProcDeleteProc(pmPtr->procPtr);
    if (pmPtr->deleteClientdataProc) {
	pmPtr->deleteClientdataProc(pmPtr->clientData);
    }
    Tcl_Free(pmPtr);
}

static void
DeleteProcedureMethod(
    ClientData clientData)
{
    register ProcedureMethod *pmPtr = clientData;
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
    TclFreeIntRep(bodyObj);

    /*
     * Create the actual copy of the method record, manufacturing a new proc
     * record.
     */

    pm2Ptr = ckalloc(sizeof(ProcedureMethod));
    memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
    pm2Ptr->refCount = 1;
    Tcl_IncrRefCount(argsObj);
    Tcl_IncrRefCount(bodyObj);
    if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,
	    &pm2Ptr->procPtr) != TCL_OK) {
	Tcl_DecrRefCount(argsObj);
	Tcl_DecrRefCount(bodyObj);
	ckfree(pm2Ptr);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(argsObj);
    Tcl_DecrRefCount(bodyObj);

    if (pmPtr->cloneClientdataProc) {
	pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);







|








|







1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
    TclFreeIntRep(bodyObj);

    /*
     * Create the actual copy of the method record, manufacturing a new proc
     * record.
     */

    pm2Ptr = Tcl_Alloc(sizeof(ProcedureMethod));
    memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
    pm2Ptr->refCount = 1;
    Tcl_IncrRefCount(argsObj);
    Tcl_IncrRefCount(bodyObj);
    if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,
	    &pm2Ptr->procPtr) != TCL_OK) {
	Tcl_DecrRefCount(argsObj);
	Tcl_DecrRefCount(bodyObj);
	Tcl_Free(pm2Ptr);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(argsObj);
    Tcl_DecrRefCount(bodyObj);

    if (pmPtr->cloneClientdataProc) {
	pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix must be non-empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = ckalloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
	    nameObj, flags, &fwdMethodType, fmPtr);
}

/*







|







1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix must be non-empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = Tcl_Alloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
	    nameObj, flags, &fwdMethodType, fmPtr);
}

/*
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix must be non-empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = ckalloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
	    flags, &fwdMethodType, fmPtr);
}

/*







|







1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix must be non-empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = Tcl_Alloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
	    flags, &fwdMethodType, fmPtr);
}

/*
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
static void
DeleteForwardMethod(
    ClientData clientData)
{
    ForwardMethod *fmPtr = clientData;

    Tcl_DecrRefCount(fmPtr->prefixObj);
    ckfree(fmPtr);
}

static int
CloneForwardMethod(
    Tcl_Interp *interp,
    ClientData clientData,
    ClientData *newClientData)
{
    ForwardMethod *fmPtr = clientData;
    ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod));

    fm2Ptr->prefixObj = fmPtr->prefixObj;
    Tcl_IncrRefCount(fm2Ptr->prefixObj);
    *newClientData = fm2Ptr;
    return TCL_OK;
}








|









|







1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
static void
DeleteForwardMethod(
    ClientData clientData)
{
    ForwardMethod *fmPtr = clientData;

    Tcl_DecrRefCount(fmPtr->prefixObj);
    Tcl_Free(fmPtr);
}

static int
CloneForwardMethod(
    Tcl_Interp *interp,
    ClientData clientData,
    ClientData *newClientData)
{
    ForwardMethod *fmPtr = clientData;
    ForwardMethod *fm2Ptr = Tcl_Alloc(sizeof(ForwardMethod));

    fm2Ptr->prefixObj = fmPtr->prefixObj;
    Tcl_IncrRefCount(fm2Ptr->prefixObj);
    *newClientData = fm2Ptr;
    return TCL_OK;
}

Added generic/tclOOScript.h.














































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
/*
 * tclOOScript.h --
 *
 *	This file contains support scripts for TclOO. They are defined here so
 *	that the code can be definitely run even in safe interpreters; TclOO's
 *	core setup is safe.
 *
 * Copyright (c) 2012-2018 Donal K. Fellows
 * Copyright (c) 2013 Andreas Kupries
 * Copyright (c) 2017 Gerald Lester
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef TCL_OO_SCRIPT_H
#define TCL_OO_SCRIPT_H

/*
 * The scripted part of the definitions of TclOO.
 *
 * Compiled from generic/tclOOScript.tcl by tools/makeHeader.tcl, which
 * contains the commented version of everything; *this* file is automatically
 * generated.
 */

static const char *tclOOSetupScript =
/* !BEGIN!: Do not edit below this line. */
"::namespace eval ::oo {\n"
"\t::namespace path {}\n"
"\tnamespace eval Helpers {\n"
"\t\t::namespace path {}\n"
"\t\tproc callback {method args} {\n"
"\t\t\tlist [uplevel 1 {::namespace which my}] $method {*}$args\n"
"\t\t}\n"
"\t\tnamespace export callback\n"
"\t\tnamespace eval tmp {namespace import ::oo::Helpers::callback}\n"
"\t\tnamespace export -clear\n"
"\t\trename tmp::callback mymethod\n"
"\t\tnamespace delete tmp\n"
"\t\tproc classvariable {name args} {\n"
"\t\t\tset ns [info object namespace [uplevel 1 {self class}]]\n"
"\t\t\tforeach v [list $name {*}$args] {\n"
"\t\t\t\tif {[string match *(*) $v]} {\n"
"\t\t\t\t\tset reason \"can\'t create a scalar variable that looks like an array element\"\n"
"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \\\n"
"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
"\t\t\t\t}\n"
"\t\t\t\tif {[string match *::* $v]} {\n"
"\t\t\t\t\tset reason \"can\'t create a local variable with a namespace separator in it\"\n"
"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR INVERTED} \\\n"
"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
"\t\t\t\t}\n"
"\t\t\t\tlappend vs $v $v\n"
"\t\t\t}\n"
"\t\t\ttailcall namespace upvar $ns {*}$vs\n"
"\t\t}\n"
"\t\tproc link {args} {\n"
"\t\t\tset ns [uplevel 1 {::namespace current}]\n"
"\t\t\tforeach link $args {\n"
"\t\t\t\tif {[llength $link] == 2} {\n"
"\t\t\t\t\tlassign $link src dst\n"
"\t\t\t\t} elseif {[llength $link] == 1} {\n"
"\t\t\t\t\tlassign $link src\n"
"\t\t\t\t\tset dst $src\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\treturn -code error -errorcode {TCLOO CMDLINK FORMAT} \\\n"
"\t\t\t\t\t\t\"bad link description; must only have one or two elements\"\n"
"\t\t\t\t}\n"
"\t\t\t\tif {![string match ::* $src]} {\n"
"\t\t\t\t\tset src [string cat $ns :: $src]\n"
"\t\t\t\t}\n"
"\t\t\t\tinterp alias {} $src {} ${ns}::my $dst\n"
"\t\t\t\ttrace add command ${ns}::my delete [list \\\n"
"\t\t\t\t\t::oo::UnlinkLinkedCommand $src]\n"
"\t\t\t}\n"
"\t\t\treturn\n"
"\t\t}\n"
"\t}\n"
"\tproc UnlinkLinkedCommand {cmd args} {\n"
"\t\tif {[namespace which $cmd] ne {}} {\n"
"\t\t\trename $cmd {}\n"
"\t\t}\n"
"\t}\n"
"\tproc DelegateName {class} {\n"
"\t\tstring cat [info object namespace $class] {:: oo ::delegate}\n"
"\t}\n"
"\tproc MixinClassDelegates {class} {\n"
"\t\tif {![info object isa class $class]} {\n"
"\t\t\treturn\n"
"\t\t}\n"
"\t\tset delegate [DelegateName $class]\n"
"\t\tif {![info object isa class $delegate]} {\n"
"\t\t\treturn\n"
"\t\t}\n"
"\t\tforeach c [info class superclass $class] {\n"
"\t\t\tset d [DelegateName $c]\n"
"\t\t\tif {![info object isa class $d]} {\n"
"\t\t\t\tcontinue\n"
"\t\t\t}\n"
"\t\t\tdefine $delegate superclass -append $d\n"
"\t\t}\n"
"\t\tobjdefine $class mixin -append $delegate\n"
"\t}\n"
"\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
"\t\tset originDelegate [DelegateName $originObject]\n"
"\t\tset targetDelegate [DelegateName $targetObject]\n"
"\t\tif {\n"
"\t\t\t[info object isa class $originDelegate]\n"
"\t\t\t&& ![info object isa class $targetDelegate]\n"
"\t\t} then {\n"
"\t\t\tcopy $originDelegate $targetDelegate\n"
"\t\t\tobjdefine $targetObject mixin -set \\\n"
"\t\t\t\t{*}[lmap c [info object mixin $targetObject] {\n"
"\t\t\t\t\tif {$c eq $originDelegate} {set targetDelegate} {set c}\n"
"\t\t\t\t}]\n"
"\t\t}\n"
"\t}\n"
"\tproc define::classmethod {name {args {}} {body {}}} {\n"
"\t\t::set argc [::llength [::info level 0]]\n"
"\t\t::if {$argc == 3} {\n"
"\t\t\t::return -code error -errorcode {TCL WRONGARGS} [::format \\\n"
"\t\t\t\t{wrong # args: should be \"%s name \?args body\?\"} \\\n"
"\t\t\t\t[::lindex [::info level 0] 0]]\n"
"\t\t}\n"
"\t\t::set cls [::uplevel 1 self]\n"
"\t\t::if {$argc == 4} {\n"
"\t\t\t::oo::define [::oo::DelegateName $cls] method $name $args $body\n"
"\t\t}\n"
"\t\t::tailcall forward $name myclass $name\n"
"\t}\n"
"\tproc define::initialise {body} {\n"
"\t\t::set clsns [::info object namespace [::uplevel 1 self]]\n"
"\t\t::tailcall apply [::list {} $body $clsns]\n"
"\t}\n"
"\tnamespace eval define {\n"
"\t\t::namespace export initialise\n"
"\t\t::namespace eval tmp {::namespace import ::oo::define::initialise}\n"
"\t\t::namespace export -clear\n"
"\t\t::rename tmp::initialise initialize\n"
"\t\t::namespace delete tmp\n"
"\t}\n"
"\tdefine Slot {\n"
"\t\tmethod Get {} {\n"
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
"\t\t}\n"
"\t\tmethod Set list {\n"
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
"\t\t}\n"
"\t\tmethod Resolve list {\n"
"\t\t\treturn $list\n"
"\t\t}\n"
"\t\tmethod -set args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\ttailcall my Set $args\n"
"\t\t}\n"
"\t\tmethod -append args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
"\t\t}\n"
"\t\tmethod -clear {} {tailcall my Set {}}\n"
"\t\tmethod -prepend args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$args {*}$current]\n"
"\t\t}\n"
"\t\tmethod -remove args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [lmap val $current {\n"
"\t\t\t\tif {$val in $args} continue else {set val}\n"
"\t\t\t}]\n"
"\t\t}\n"
"\t\tforward --default-operation my -append\n"
"\t\tmethod unknown {args} {\n"
"\t\t\tset def --default-operation\n"
"\t\t\tif {[llength $args] == 0} {\n"
"\t\t\t\ttailcall my $def\n"
"\t\t\t} elseif {![string match -* [lindex $args 0]]} {\n"
"\t\t\t\ttailcall my $def {*}$args\n"
"\t\t\t}\n"
"\t\t\tnext {*}$args\n"
"\t\t}\n"
"\t\texport -set -append -clear -prepend -remove\n"
"\t\tunexport unknown destroy\n"
"\t}\n"
"\tobjdefine define::superclass forward --default-operation my -set\n"
"\tobjdefine define::mixin forward --default-operation my -set\n"
"\tobjdefine objdefine::mixin forward --default-operation my -set\n"
"\tdefine object method <cloned> {originObject} {\n"
"\t\tforeach p [info procs [info object namespace $originObject]::*] {\n"
"\t\t\tset args [info args $p]\n"
"\t\t\tset idx -1\n"
"\t\t\tforeach a $args {\n"
"\t\t\t\tif {[info default $p $a d]} {\n"
"\t\t\t\t\tlset args [incr idx] [list $a $d]\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\tlset args [incr idx] [list $a]\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\tset b [info body $p]\n"
"\t\t\tset p [namespace tail $p]\n"
"\t\t\tproc $p $args $b\n"
"\t\t}\n"
"\t\tforeach v [info vars [info object namespace $originObject]::*] {\n"
"\t\t\tupvar 0 $v vOrigin\n"
"\t\t\tnamespace upvar [namespace current] [namespace tail $v] vNew\n"
"\t\t\tif {[info exists vOrigin]} {\n"
"\t\t\t\tif {[array exists vOrigin]} {\n"
"\t\t\t\t\tarray set vNew [array get vOrigin]\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\tset vNew $vOrigin\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t}\n"
"\t}\n"
"\tdefine class method <cloned> {originObject} {\n"
"\t\tnext $originObject\n"
"\t\t::oo::UpdateClassDelegatesAfterClone $originObject [self]\n"
"\t}\n"
"\tclass create singleton {\n"
"\t\tsuperclass class\n"
"\t\tvariable object\n"
"\t\tunexport create createWithNamespace\n"
"\t\tmethod new args {\n"
"\t\t\tif {![info exists object] || ![info object isa object $object]} {\n"
"\t\t\t\tset object [next {*}$args]\n"
"\t\t\t\t::oo::objdefine $object {\n"
"\t\t\t\t\tmethod destroy {} {\n"
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
"\t\t\t\t\t\t\t\"may not destroy a singleton object\"\n"
"\t\t\t\t\t}\n"
"\t\t\t\t\tmethod <cloned> {originObject} {\n"
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
"\t\t\t\t\t\t\t\"may not clone a singleton object\"\n"
"\t\t\t\t\t}\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\treturn $object\n"
"\t\t}\n"
"\t}\n"
"\tclass create abstract {\n"
"\t\tsuperclass class\n"
"\t\tunexport create createWithNamespace new\n"
"\t}\n"
"}\n"
/* !END!: Do not edit above this line. */
;

#endif /* TCL_OO_SCRIPT_H */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Added generic/tclOOScript.tcl.
















































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
# tclOOScript.h --
#
# 	This file contains support scripts for TclOO. They are defined here so
# 	that the code can be definitely run even in safe interpreters; TclOO's
# 	core setup is safe.
#
# Copyright (c) 2012-2018 Donal K. Fellows
# Copyright (c) 2013 Andreas Kupries
# Copyright (c) 2017 Gerald Lester
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

::namespace eval ::oo {
    ::namespace path {}

    #
    # Commands that are made available to objects by default.
    #
    namespace eval Helpers {
	::namespace path {}

	# ------------------------------------------------------------------
	#
	# callback, mymethod --
	#
	#	Create a script prefix that calls a method on the current
	#	object. Same operation, two names.
	#
	# ------------------------------------------------------------------

	proc callback {method args} {
	    list [uplevel 1 {::namespace which my}] $method {*}$args
	}

	# Make the [callback] command appear as [mymethod] too.
	namespace export callback
	namespace eval tmp {namespace import ::oo::Helpers::callback}
	namespace export -clear
	rename tmp::callback mymethod
	namespace delete tmp

	# ------------------------------------------------------------------
	#
	# classvariable --
	#
	#	Link to a variable in the class of the current object.
	#
	# ------------------------------------------------------------------

	proc classvariable {name args} {
	    # Get a reference to the class's namespace
	    set ns [info object namespace [uplevel 1 {self class}]]
	    # Double up the list of variable names
	    foreach v [list $name {*}$args] {
		if {[string match *(*) $v]} {
		    set reason "can't create a scalar variable that looks like an array element"
		    return -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \
			[format {bad variable name "%s": %s} $v $reason]
		}
		if {[string match *::* $v]} {
		    set reason "can't create a local variable with a namespace separator in it"
		    return -code error -errorcode {TCL UPVAR INVERTED} \
			[format {bad variable name "%s": %s} $v $reason]
		}
		lappend vs $v $v
	    }
	    # Lastly, link the caller's local variables to the class's variables
	    tailcall namespace upvar $ns {*}$vs
	}

	# ------------------------------------------------------------------
	#
	# link --
	#
	#	Make a command that invokes a method on the current object.
	#	The name of the command and the name of the method match by
	#	default.
	#
	# ------------------------------------------------------------------

	proc link {args} {
	    set ns [uplevel 1 {::namespace current}]
	    foreach link $args {
		if {[llength $link] == 2} {
		    lassign $link src dst
		} elseif {[llength $link] == 1} {
		    lassign $link src
		    set dst $src
		} else {
		    return -code error -errorcode {TCLOO CMDLINK FORMAT} \
			"bad link description; must only have one or two elements"
		}
		if {![string match ::* $src]} {
		    set src [string cat $ns :: $src]
		}
		interp alias {} $src {} ${ns}::my $dst
		trace add command ${ns}::my delete [list \
		    ::oo::UnlinkLinkedCommand $src]
	    }
	    return
	}
    }

    # ----------------------------------------------------------------------
    #
    # UnlinkLinkedCommand --
    #
    #	Callback used to remove linked command when the underlying mechanism
    #	that supports it is deleted.
    #
    # ----------------------------------------------------------------------

    proc UnlinkLinkedCommand {cmd args} {
	if {[namespace which $cmd] ne {}} {
	    rename $cmd {}
	}
    }

    # ----------------------------------------------------------------------
    #
    # DelegateName --
    #
    #	Utility that gets the name of the class delegate for a class. It's
    #	trivial, but makes working with them much easier as delegate names are
    #	intentionally hard to create by accident.
    #
    # ----------------------------------------------------------------------

    proc DelegateName {class} {
	string cat [info object namespace $class] {:: oo ::delegate}
    }

    # ----------------------------------------------------------------------
    #
    # MixinClassDelegates --
    #
    #	Support code called *after* [oo::define] inside the constructor of a
    #	class that patches in the appropriate class delegates.
    #
    # ----------------------------------------------------------------------

    proc MixinClassDelegates {class} {
	if {![info object isa class $class]} {
	    return
	}
	set delegate [DelegateName $class]
	if {![info object isa class $delegate]} {
	    return
	}
	foreach c [info class superclass $class] {
	    set d [DelegateName $c]
	    if {![info object isa class $d]} {
		continue
	    }
	    define $delegate superclass -append $d
	}
	objdefine $class mixin -append $delegate
    }

    # ----------------------------------------------------------------------
    #
    # UpdateClassDelegatesAfterClone --
    #
    #	Support code that is like [MixinClassDelegates] except for when a
    #	class is cloned.
    #
    # ----------------------------------------------------------------------

    proc UpdateClassDelegatesAfterClone {originObject targetObject} {
	# Rebuild the class inheritance delegation class
	set originDelegate [DelegateName $originObject]
	set targetDelegate [DelegateName $targetObject]
	if {
	    [info object isa class $originDelegate]
	    && ![info object isa class $targetDelegate]
	} then {
	    copy $originDelegate $targetDelegate
	    objdefine $targetObject mixin -set \
		{*}[lmap c [info object mixin $targetObject] {
		    if {$c eq $originDelegate} {set targetDelegate} {set c}
		}]
	}
    }

    # ----------------------------------------------------------------------
    #
    # oo::define::classmethod --
    #
    #	Defines a class method. See define(n) for details.
    #
    # Note that the ::oo::define namespace is semi-public and a bit weird
    # anyway, so we don't regard the namespace path as being under control:
    # fully qualified names are used for everything.
    #
    # ----------------------------------------------------------------------

    proc define::classmethod {name {args {}} {body {}}} {
        # Create the method on the class if the caller gave arguments and body
        ::set argc [::llength [::info level 0]]
        ::if {$argc == 3} {
            ::return -code error -errorcode {TCL WRONGARGS} [::format \
		{wrong # args: should be "%s name ?args body?"} \
                [::lindex [::info level 0] 0]]
        }
        ::set cls [::uplevel 1 self]
        ::if {$argc == 4} {
            ::oo::define [::oo::DelegateName $cls] method $name $args $body
        }
        # Make the connection by forwarding
        ::tailcall forward $name myclass $name
    }

    # ----------------------------------------------------------------------
    #
    # oo::define::initialise, oo::define::initialize --
    #
    #	Do specific initialisation for a class. See define(n) for details.
    #
    # Note that the ::oo::define namespace is semi-public and a bit weird
    # anyway, so we don't regard the namespace path as being under control:
    # fully qualified names are used for everything.
    #
    # ----------------------------------------------------------------------

    proc define::initialise {body} {
        ::set clsns [::info object namespace [::uplevel 1 self]]
        ::tailcall apply [::list {} $body $clsns]
    }

    # Make the [initialise] definition appear as [initialize] too
    namespace eval define {
	::namespace export initialise
	::namespace eval tmp {::namespace import ::oo::define::initialise}
	::namespace export -clear
	::rename tmp::initialise initialize
	::namespace delete tmp
    }

    # ----------------------------------------------------------------------
    #
    # Slot --
    #
    #	The class of slot operations, which are basically lists at the low
    #	level of TclOO; this provides a more consistent interface to them.
    #
    # ----------------------------------------------------------------------

    define Slot {
	# ------------------------------------------------------------------
	#
	# Slot Get --
	#
	#	Basic slot getter. Retrieves the contents of the slot.
	#	Particular slots must provide concrete non-erroring
	#	implementation.
	#
	# ------------------------------------------------------------------

	method Get {} {
	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
	}

	# ------------------------------------------------------------------
	#
	# Slot Set --
	#
	#	Basic slot setter. Sets the contents of the slot.  Particular
	#	slots must provide concrete non-erroring implementation.
	#
	# ------------------------------------------------------------------

	method Set list {
	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
	}

	# ------------------------------------------------------------------
	#
	# Slot Resolve --
	#
	#	Helper that lets a slot convert a list of arguments of a
	#	particular type to their canonical forms. Defaults to doing
	#	nothing (suitable for simple strings).
	#
	# ------------------------------------------------------------------

	method Resolve list {
	    return $list
	}

	# ------------------------------------------------------------------
	#
	# Slot -set, -append, -clear, --default-operation --
	#
	#	Standard public slot operations. If a slot can't figure out
	#	what method to call directly, it uses --default-operation.
	#
	# ------------------------------------------------------------------

	method -set args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    tailcall my Set $args
	}
	method -append args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [list {*}$current {*}$args]
	}
	method -clear {} {tailcall my Set {}}
	method -prepend args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [list {*}$args {*}$current]
	}
	method -remove args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [lmap val $current {
		if {$val in $args} continue else {set val}
	    }]
	}

	# Default handling
	forward --default-operation my -append
	method unknown {args} {
	    set def --default-operation
	    if {[llength $args] == 0} {
		tailcall my $def
	    } elseif {![string match -* [lindex $args 0]]} {
		tailcall my $def {*}$args
	    }
	    next {*}$args
	}

	# Set up what is exported and what isn't
	export -set -append -clear -prepend -remove
	unexport unknown destroy
    }

    # Set the default operation differently for these slots
    objdefine define::superclass forward --default-operation my -set
    objdefine define::mixin forward --default-operation my -set
    objdefine objdefine::mixin forward --default-operation my -set

    # ----------------------------------------------------------------------
    #
    # oo::object <cloned> --
    #
    #	Handler for cloning objects that clones basic bits (only!) of the
    #	object's namespace. Non-procedures, traces, sub-namespaces, etc. need
    #	more complex (and class-specific) handling.
    #
    # ----------------------------------------------------------------------

    define object method <cloned> {originObject} {
	# Copy over the procedures from the original namespace
	foreach p [info procs [info object namespace $originObject]::*] {
	    set args [info args $p]
	    set idx -1
	    foreach a $args {
		if {[info default $p $a d]} {
		    lset args [incr idx] [list $a $d]
		} else {
		    lset args [incr idx] [list $a]
		}
	    }
	    set b [info body $p]
	    set p [namespace tail $p]
	    proc $p $args $b
	}
	# Copy over the variables from the original namespace
	foreach v [info vars [info object namespace $originObject]::*] {
	    upvar 0 $v vOrigin
	    namespace upvar [namespace current] [namespace tail $v] vNew
	    if {[info exists vOrigin]} {
		if {[array exists vOrigin]} {
		    array set vNew [array get vOrigin]
		} else {
		    set vNew $vOrigin
		}
	    }
	}
	# General commands, sub-namespaces and advancd variable config (traces,
	# etc) are *not* copied over. Classes that want that should do it
	# themselves.
    }

    # ----------------------------------------------------------------------
    #
    # oo::class <cloned> --
    #
    #	Handler for cloning classes, which fixes up the delegates.
    #
    # ----------------------------------------------------------------------

    define class method <cloned> {originObject} {
	next $originObject
	# Rebuild the class inheritance delegation class
	::oo::UpdateClassDelegatesAfterClone $originObject [self]
    }

    # ----------------------------------------------------------------------
    #
    # oo::singleton --
    #
    #	A metaclass that is used to make classes that only permit one instance
    #	of them to exist. See singleton(n).
    #
    # ----------------------------------------------------------------------

    class create singleton {
	superclass class
	variable object
	unexport create createWithNamespace
	method new args {
	    if {![info exists object] || ![info object isa object $object]} {
		set object [next {*}$args]
		::oo::objdefine $object {
		    method destroy {} {
			::return -code error -errorcode {TCLOO SINGLETON} \
			    "may not destroy a singleton object"
		    }
		    method <cloned> {originObject} {
			::return -code error -errorcode {TCLOO SINGLETON} \
			    "may not clone a singleton object"
		    }
		}
	    }
	    return $object
	}
    }

    # ----------------------------------------------------------------------
    #
    # oo::abstract --
    #
    #	A metaclass that is used to make classes that can't be directly
    #	instantiated. See abstract(n).
    #
    # ----------------------------------------------------------------------

    class create abstract {
	superclass class
	unexport create createWithNamespace new
    }
}

# Local Variables:
# mode: tcl
# c-basic-offset: 4
# fill-column: 78
# End:
Changes to generic/tclObj.c.
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187

/*
 * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
 */

#define PACK_BIGNUM(bignum, objPtr) \
    if ((bignum).used > 0x7fff) {                                       \
	mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int));     \
	*temp = bignum;                                                 \
	(objPtr)->internalRep.twoPtrValue.ptr1 = temp;                 \
	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
    } else {                                                            \
	if ((bignum).alloc > 0x7fff) {                                  \
	    mp_shrink(&(bignum));                                       \
	}                                                               \







|







173
174
175
176
177
178
179
180
181
182
183
184
185
186
187

/*
 * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
 */

#define PACK_BIGNUM(bignum, objPtr) \
    if ((bignum).used > 0x7fff) {                                       \
	mp_int *temp = (void *) Tcl_Alloc((unsigned) sizeof(mp_int));     \
	*temp = bignum;                                                 \
	(objPtr)->internalRep.twoPtrValue.ptr1 = temp;                 \
	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
    } else {                                                            \
	if ((bignum).alloc > 0x7fff) {                                  \
	    mp_shrink(&(bignum));                                       \
	}                                                               \
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445

    if (tablePtr != NULL) {
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		ckfree(objData);
	    }
	}

	Tcl_DeleteHashTable(tablePtr);
	ckfree(tablePtr);
	tsdPtr->objThreadMap = NULL;
    }
#endif
}

/*
 *----------------------------------------------------------------------







|




|







426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445

    if (tablePtr != NULL) {
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		Tcl_Free(objData);
	    }
	}

	Tcl_DeleteHashTable(tablePtr);
	Tcl_Free(tablePtr);
	tsdPtr->objThreadMap = NULL;
    }
#endif
}

/*
 *----------------------------------------------------------------------
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
     * would be the natural place for this is invoked afterwards, meaning that
     * we try to operate on a data structure already gone.
     */

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->lineCLPtr) {
	tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
    }
    return tsdPtr;
}

/*







|







507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
     * would be the natural place for this is invoked afterwards, meaning that
     * we try to operate on a data structure already gone.
     */

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->lineCLPtr) {
	tsdPtr->lineCLPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
    }
    return tsdPtr;
}

/*
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
    int num,
    int *loc)
{
    int newEntry;
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
    ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));

    if (!newEntry) {
	/*
	 * We're entering ContLineLoc data for the same value more than one
	 * time. Taking care not to leak the old entry.
	 *
	 * This can happen when literals in a proc body are shared. See for







|







542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
    int num,
    int *loc)
{
    int newEntry;
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
    ContLineLoc *clLocPtr = Tcl_Alloc(sizeof(ContLineLoc) + num*sizeof(int));

    if (!newEntry) {
	/*
	 * We're entering ContLineLoc data for the same value more than one
	 * time. Taking care not to leak the old entry.
	 *
	 * This can happen when literals in a proc body are shared. See for
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
	 * TclContinuationsEnterDerived for this case, which modified the
	 * stored locations (Rebased to the proper relative offset). Just
	 * returning the stored entry would rebase them a second time, or
	 * more, hosing the data. It is easier to simply replace, as we are
	 * doing.
	 */

	ckfree(Tcl_GetHashValue(hPtr));
    }

    clLocPtr->num = num;
    memcpy(&clLocPtr->loc, loc, num*sizeof(int));
    clLocPtr->loc[num] = CLL_END;       /* Sentinel */
    Tcl_SetHashValue(hPtr, clLocPtr);








|







566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
	 * TclContinuationsEnterDerived for this case, which modified the
	 * stored locations (Rebased to the proper relative offset). Just
	 * returning the stored entry would rebase them a second time, or
	 * more, hosing the data. It is easier to simply replace, as we are
	 * doing.
	 */

	Tcl_Free(Tcl_GetHashValue(hPtr));
    }

    clLocPtr->num = num;
    memcpy(&clLocPtr->loc, loc, num*sizeof(int));
    clLocPtr->loc[num] = CLL_END;       /* Sentinel */
    Tcl_SetHashValue(hPtr, clLocPtr);

602
603
604
605
606
607
608

609
610
611
612
613
614
615
616

void
TclContinuationsEnterDerived(
    Tcl_Obj *objPtr,
    int start,
    int *clNext)
{

    int length, end, num;
    int *wordCLLast = clNext;

    /*
     * We have to handle invisible continuations lines here as well, despite
     * the code we have in TclSubstTokens (TST) for that. Why ?  Nesting. If
     * our script is the sole argument to an 'eval' command, for example, the
     * scriptCLLocPtr we are using was generated by a previous call to TST,







>
|







602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617

void
TclContinuationsEnterDerived(
    Tcl_Obj *objPtr,
    int start,
    int *clNext)
{
    size_t length;
    int end, num;
    int *wordCLLast = clNext;

    /*
     * We have to handle invisible continuations lines here as well, despite
     * the code we have in TclSubstTokens (TST) for that. Why ?  Nesting. If
     * our script is the sole argument to an 'eval' command, for example, the
     * scriptCLLocPtr we are using was generated by a previous call to TST,
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
     */

    /*
     * First compute the range of the word within the script. (Is there a
     * better way which doesn't shimmer?)
     */

    TclGetStringFromObj(objPtr, &length);
    end = start + length;       /* First char after the word */

    /*
     * Then compute the table slice covering the range of the word.
     */

    while (*wordCLLast >= 0 && *wordCLLast < end) {







|







630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
     */

    /*
     * First compute the range of the word within the script. (Is there a
     * better way which doesn't shimmer?)
     */

    (void)TclGetStringFromObj(objPtr, &length);
    end = start + length;       /* First char after the word */

    /*
     * Then compute the table slice covering the range of the word.
     */

    while (*wordCLLast >= 0 && *wordCLLast < end) {
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788

    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

    for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	ckfree(Tcl_GetHashValue(hPtr));
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
    ckfree(tsdPtr->lineCLPtr);
    tsdPtr->lineCLPtr = NULL;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_RegisterObjType --







|



|







771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789

    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

    for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	Tcl_Free(Tcl_GetHashValue(hPtr));
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
    Tcl_Free(tsdPtr->lineCLPtr);
    tsdPtr->lineCLPtr = NULL;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_RegisterObjType --
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tablePtr = tsdPtr->objThreadMap;

    if (tablePtr != NULL) {
	fprintf(outFile, "total objects: %d\n", tablePtr->numEntries);
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		fprintf(outFile,
			"key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",







|







981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tablePtr = tsdPtr->objThreadMap;

    if (tablePtr != NULL) {
	fprintf(outFile, "total objects: %" TCL_Z_MODIFIER "u\n", tablePtr->numEntries);
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		fprintf(outFile,
			"key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
	Tcl_HashEntry *hPtr;
	Tcl_HashTable *tablePtr;
	int isNew;
	ObjData *objData;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	if (tsdPtr->objThreadMap == NULL) {
	    tsdPtr->objThreadMap = ckalloc(sizeof(Tcl_HashTable));
	    Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
	}
	tablePtr = tsdPtr->objThreadMap;
	hPtr = Tcl_CreateHashEntry(tablePtr, objPtr, &isNew);
	if (!isNew) {
	    Tcl_Panic("expected to create new entry for object map");
	}

	/*
	 * Record the debugging information.
	 */

	objData = ckalloc(sizeof(ObjData));
	objData->objPtr = objPtr;
	objData->file = file;
	objData->line = line;
	Tcl_SetHashValue(hPtr, objData);
    }
#endif /* TCL_THREADS */
}







|












|







1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
	Tcl_HashEntry *hPtr;
	Tcl_HashTable *tablePtr;
	int isNew;
	ObjData *objData;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	if (tsdPtr->objThreadMap == NULL) {
	    tsdPtr->objThreadMap = Tcl_Alloc(sizeof(Tcl_HashTable));
	    Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
	}
	tablePtr = tsdPtr->objThreadMap;
	hPtr = Tcl_CreateHashEntry(tablePtr, objPtr, &isNew);
	if (!isNew) {
	    Tcl_Panic("expected to create new entry for object map");
	}

	/*
	 * Record the debugging information.
	 */

	objData = Tcl_Alloc(sizeof(ObjData));
	objData->objPtr = objPtr;
	objData->file = file;
	objData->line = line;
	Tcl_SetHashValue(hPtr, objData);
    }
#endif /* TCL_THREADS */
}
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197

/*
 *----------------------------------------------------------------------
 *
 * TclAllocateFreeObjects --
 *
 *	Function to allocate a number of free Tcl_Objs. This is done using a
 *	single ckalloc to reduce the overhead for Tcl_Obj allocation.
 *
 *	Assumes mutex is held.
 *
 * Results:
 *	None.
 *
 * Side effects:







|







1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198

/*
 *----------------------------------------------------------------------
 *
 * TclAllocateFreeObjects --
 *
 *	Function to allocate a number of free Tcl_Objs. This is done using a
 *	single Tcl_Alloc to reduce the overhead for Tcl_Obj allocation.
 *
 *	Assumes mutex is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
    register Tcl_Obj *prevPtr, *objPtr;
    register int i;

    /*
     * This has been noted by Purify to be a potential leak. The problem is
     * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated
     * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually
     * freeing the memory. TclFinalizeObjects() does not ckfree() this memory,
     * but leaves it to Tcl's memory subsystem finalization to release it.
     * Purify apparently can't figure that out, and fires a false alarm.
     */

    basePtr = ckalloc(bytesToAlloc);

    prevPtr = NULL;
    objPtr = (Tcl_Obj *) basePtr;
    for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
	objPtr->internalRep.twoPtrValue.ptr1 = prevPtr;
	prevPtr = objPtr;
	objPtr++;







|




|







1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
    register Tcl_Obj *prevPtr, *objPtr;
    register int i;

    /*
     * This has been noted by Purify to be a potential leak. The problem is
     * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated
     * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually
     * freeing the memory. TclFinalizeObjects() does not Tcl_Free() this memory,
     * but leaves it to Tcl's memory subsystem finalization to release it.
     * Purify apparently can't figure that out, and fires a false alarm.
     */

    basePtr = Tcl_Alloc(bytesToAlloc);

    prevPtr = NULL;
    objPtr = (Tcl_Obj *) basePtr;
    for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
	objPtr->internalRep.twoPtrValue.ptr1 = prevPtr;
	prevPtr = objPtr;
	objPtr++;
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
	    /*
	     * As the Tcl_Obj is going to be deleted we remove the entry.
	     */

	    ObjData *objData = Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		ckfree(objData);
	    }

	    Tcl_DeleteHashEntry(hPtr);
	}
    }
# endif

    /*
     * Check for a double free of the same value.  This is slightly tricky
     * because it is customary to free a Tcl_Obj when its refcount falls
     * either from 1 to 0, or from 0 to -1.  Falling from -1 to -2, though,
     * and so on, is always a sign of a botch in the caller.
     */
    if (objPtr->refCount < -1) {
	Tcl_Panic("Reference count for %p was negative", objPtr);
    }
    /*
     * Now, in case we just approved drop from 1 to 0 as acceptable, make
     * sure we do not accept a second free when falling from 0 to -1.
     * Skip that possibility so any double free will trigger the panic.
     */
    objPtr->refCount = -1;

    /*
     * Invalidate the string rep first so we can use the bytes value for our
     * pointer chain, and signal an obj deletion (as opposed to shimmering)
     * with 'length == -1'.
     */

    TclInvalidateStringRep(objPtr);
    objPtr->length = -1;

    if (ObjDeletePending(context)) {
	PushObjToDelete(context, objPtr);
    } else {
	TCL_DTRACE_OBJ_FREE(objPtr);
	if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	    ObjDeletionLock(context);
	    typePtr->freeIntRepProc(objPtr);
	    ObjDeletionUnlock(context);
	}

	Tcl_MutexLock(&tclObjMutex);
	ckfree(objPtr);
	Tcl_MutexUnlock(&tclObjMutex);
	TclIncrObjsFreed();
	ObjDeletionLock(context);
	while (ObjOnStack(context)) {
	    Tcl_Obj *objToFree;

	    PopObjToDelete(context, objToFree);
	    TCL_DTRACE_OBJ_FREE(objToFree);
	    TclFreeIntRep(objToFree);

	    Tcl_MutexLock(&tclObjMutex);
	    ckfree(objToFree);
	    Tcl_MutexUnlock(&tclObjMutex);
	    TclIncrObjsFreed();
	}
	ObjDeletionUnlock(context);
    }

    /*







|













|







|




|



|












|











|







1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
	    /*
	     * As the Tcl_Obj is going to be deleted we remove the entry.
	     */

	    ObjData *objData = Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		Tcl_Free(objData);
	    }

	    Tcl_DeleteHashEntry(hPtr);
	}
    }
# endif

    /*
     * Check for a double free of the same value.  This is slightly tricky
     * because it is customary to free a Tcl_Obj when its refcount falls
     * either from 1 to 0, or from 0 to -1.  Falling from -1 to -2, though,
     * and so on, is always a sign of a botch in the caller.
     */
    if (objPtr->refCount == (size_t)-2) {
	Tcl_Panic("Reference count for %p was negative", objPtr);
    }
    /*
     * Now, in case we just approved drop from 1 to 0 as acceptable, make
     * sure we do not accept a second free when falling from 0 to -1.
     * Skip that possibility so any double free will trigger the panic.
     */
    objPtr->refCount = (size_t)-1;

    /*
     * Invalidate the string rep first so we can use the bytes value for our
     * pointer chain, and signal an obj deletion (as opposed to shimmering)
     * with 'length == (size_t)-1'.
     */

    TclInvalidateStringRep(objPtr);
    objPtr->length = (size_t)-1;

    if (ObjDeletePending(context)) {
	PushObjToDelete(context, objPtr);
    } else {
	TCL_DTRACE_OBJ_FREE(objPtr);
	if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	    ObjDeletionLock(context);
	    typePtr->freeIntRepProc(objPtr);
	    ObjDeletionUnlock(context);
	}

	Tcl_MutexLock(&tclObjMutex);
	Tcl_Free(objPtr);
	Tcl_MutexUnlock(&tclObjMutex);
	TclIncrObjsFreed();
	ObjDeletionLock(context);
	while (ObjOnStack(context)) {
	    Tcl_Obj *objToFree;

	    PopObjToDelete(context, objToFree);
	    TCL_DTRACE_OBJ_FREE(objToFree);
	    TclFreeIntRep(objToFree);

	    Tcl_MutexLock(&tclObjMutex);
	    Tcl_Free(objToFree);
	    Tcl_MutexUnlock(&tclObjMutex);
	    TclIncrObjsFreed();
	}
	ObjDeletionUnlock(context);
    }

    /*
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    if (hPtr) {
		ckfree(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}
#else /* TCL_MEM_DEBUG */








|







1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    if (hPtr) {
		Tcl_Free(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}
#else /* TCL_MEM_DEBUG */

1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    if (hPtr) {
		ckfree(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}
#endif /* TCL_MEM_DEBUG */








|







1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    if (hPtr) {
		Tcl_Free(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}
#endif /* TCL_MEM_DEBUG */

1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
 *----------------------------------------------------------------------
 */

int
TclObjBeingDeleted(
    Tcl_Obj *objPtr)
{
    return (objPtr->length == -1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DuplicateObj --
 *







|







1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
 *----------------------------------------------------------------------
 */

int
TclObjBeingDeleted(
    Tcl_Obj *objPtr)
{
    return (objPtr->length == (size_t)-1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DuplicateObj --
 *
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
	     * 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 < 0
		|| objPtr->bytes[objPtr->length] != '\0') {
	    Tcl_Panic("UpdateStringProc for type '%s' "
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    return objPtr->bytes;







|







1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
	     * 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 == (size_t)-1
		|| objPtr->bytes[objPtr->length] != '\0') {
	    Tcl_Panic("UpdateStringProc for type '%s' "
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    return objPtr->bytes;
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
	     * 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 < 0
		|| objPtr->bytes[objPtr->length] != '\0') {
	    Tcl_Panic("UpdateStringProc for type '%s' "
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    if (lengthPtr != NULL) {
	*lengthPtr = objPtr->length;
    }
    return objPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *







|







|







1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
	     * 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 == (size_t)-1
		|| objPtr->bytes[objPtr->length] != '\0') {
	    Tcl_Panic("UpdateStringProc for type '%s' "
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    if (lengthPtr != NULL) {
	*lengthPtr = (objPtr->length < INT_MAX)? objPtr->length: INT_MAX;
    }
    return objPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845

1846
1847
1848
1849
1850
1851
1852
1853
1854

    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }

  badBoolean:
    if (interp != NULL) {
	int length;
	const char *str = TclGetStringFromObj(objPtr, &length);
	Tcl_Obj *msg;

	TclNewLiteralStringObj(msg, "expected boolean value but got \"");
	Tcl_AppendLimitedToObj(msg, str, length, 50, "");
	Tcl_AppendToObj(msg, "\"", -1);
	Tcl_SetObjResult(interp, msg);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL);
    }
    return TCL_ERROR;
}

static int
ParseBoolean(
    register Tcl_Obj *objPtr)	/* The object to parse/convert. */
{
    int newBool;
    char lowerCase[6];

    const char *str = TclGetString(objPtr);
    size_t i, length = objPtr->length;

    if ((length == 0) || (length > 5)) {
	/*
         * Longest valid boolean string rep. is "false".
         */

	return TCL_ERROR;







|


















>
|
<







1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848

1849
1850
1851
1852
1853
1854
1855

    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }

  badBoolean:
    if (interp != NULL) {
	size_t length;
	const char *str = TclGetStringFromObj(objPtr, &length);
	Tcl_Obj *msg;

	TclNewLiteralStringObj(msg, "expected boolean value but got \"");
	Tcl_AppendLimitedToObj(msg, str, length, 50, "");
	Tcl_AppendToObj(msg, "\"", -1);
	Tcl_SetObjResult(interp, msg);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL);
    }
    return TCL_ERROR;
}

static int
ParseBoolean(
    register Tcl_Obj *objPtr)	/* The object to parse/convert. */
{
    int newBool;
    char lowerCase[6];
    size_t i, length;
    const char *str = TclGetStringFromObj(objPtr, &length);


    if ((length == 0) || (length > 5)) {
	/*
         * Longest valid boolean string rep. is "false".
         */

	return TCL_ERROR;
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205

2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
 */

static void
UpdateStringOfDouble(
    register Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
{
    char buffer[TCL_DOUBLE_SPACE];
    register int len;

    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
    len = strlen(buffer);


    objPtr->bytes = ckalloc(len + 1);
    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
    objPtr->length = len;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntFromObj --
 *







|




>
|
|
<







2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209

2210
2211
2212
2213
2214
2215
2216
 */

static void
UpdateStringOfDouble(
    register Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
{
    char buffer[TCL_DOUBLE_SPACE];
    size_t len;

    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
    len = strlen(buffer);

    objPtr->length = len;
    objPtr->bytes = Tcl_Alloc(++len);
    memcpy(objPtr->bytes, buffer, len);

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntFromObj --
 *
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
    return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
#else
    long l;

    if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
	if (interp != NULL) {
	    const char *s =
		    "integer value too large to represent as non-long integer";
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	}
	return TCL_ERROR;







|







2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
    return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
#else
    long l;

    if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < INT_MIN))) {
	if (interp != NULL) {
	    const char *s =
		    "integer value too large to represent as non-long integer";
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	}
	return TCL_ERROR;
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320

2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
 */

static void
UpdateStringOfInt(
    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
{
    char buffer[TCL_INTEGER_SPACE];
    register int len;

    len = TclFormatInt(buffer, objPtr->internalRep.wideValue);


    objPtr->bytes = ckalloc(len + 1);
    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
    objPtr->length = len;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetLongFromObj --
 *







|



>
|

<







2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324

2325
2326
2327
2328
2329
2330
2331
 */

static void
UpdateStringOfInt(
    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
{
    char buffer[TCL_INTEGER_SPACE];
    size_t len;

    len = TclFormatInt(buffer, objPtr->internalRep.wideValue);

    objPtr->length = len;
    objPtr->bytes = Tcl_Alloc(len + 1);
    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetLongFromObj --
 *
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
	if (objPtr->typePtr == &tclIntType) {
	    *longPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#else
	if (objPtr->typePtr == &tclIntType) {
	    /*
	     * We return any integer in the range -ULONG_MAX to ULONG_MAX
	     * converted to a long, ignoring overflow. The rule preserves
	     * existing semantics for conversion of integers on input, but
	     * avoids inadvertent demotion of wide integers to 32-bit ones in
	     * the internal rep.
	     */

	    Tcl_WideInt w = objPtr->internalRep.wideValue;

	    if (w >= -(Tcl_WideInt)(ULONG_MAX)
		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
		*longPtr = Tcl_WideAsLong(w);
		return TCL_OK;
	    }
	    goto tooLarge;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {







|








|

|







2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
	if (objPtr->typePtr == &tclIntType) {
	    *longPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#else
	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
	     * existing semantics for conversion of integers on input, but
	     * avoids inadvertent demotion of wide integers to 32-bit ones in
	     * the internal rep.
	     */

	    Tcl_WideInt w = objPtr->internalRep.wideValue;

	    if (w >= (Tcl_WideInt)(LONG_MIN)
		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
		*longPtr = (long) w;
		return TCL_OK;
	    }
	    goto tooLarge;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409

2410


2411

2412
2413
2414


2415
2416
2417
2418
2419
2420
2421
	     * long range get auto-narrowed to tclIntType, while all the
	     * values in the unsigned long range will fit in a long.
	     */

	    mp_int big;

	    UNPACK_BIGNUM(objPtr, big);
	    if ((size_t) big.used <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1)
		    / DIGIT_BIT) {
		unsigned long value = 0, numBytes = sizeof(long);
		long scratch;
		unsigned char *bytes = (unsigned char *) &scratch;

		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
		    while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		    }
		    if (big.sign) {

			*longPtr = - (long) value;


		    } else {

			*longPtr = (long) value;
		    }
		    return TCL_OK;


		}
	    }
#ifndef TCL_WIDE_INT_IS_LONG
	tooLarge:
#endif
	    if (interp != NULL) {
		const char *s = "integer value too large to represent";







|

|
<







>
|
>
>

>
|
<
|
>
>







2393
2394
2395
2396
2397
2398
2399
2400
2401
2402

2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416

2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
	     * long range get auto-narrowed to tclIntType, while all the
	     * values in the unsigned long range will fit in a long.
	     */

	    mp_int big;

	    UNPACK_BIGNUM(objPtr, big);
	    if ((size_t) big.used <= (CHAR_BIT * sizeof(unsigned long) + DIGIT_BIT - 1)
		    / DIGIT_BIT) {
		unsigned long scratch, value = 0, numBytes = sizeof(unsigned long);

		unsigned char *bytes = (unsigned char *) &scratch;

		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
		    while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		    }
		    if (big.sign) {
			if (value <= 1 + (unsigned long)LONG_MAX) {
			    *longPtr = - (long) value;
			    return TCL_OK;
			}
		    } else {
			if (value <= (unsigned long)ULONG_MAX) {
			    *longPtr = (long) value;

			    return TCL_OK;
			}
		    }
		}
	    }
#ifndef TCL_WIDE_INT_IS_LONG
	tooLarge:
#endif
	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
2642
2643
2644
2645
2646
2647
2648

2649


2650

2651
2652
2653


2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
































































2664
2665
2666
2667
2668
2669
2670
		unsigned char *bytes = (unsigned char *) &scratch;

		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
		    while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		    }
		    if (big.sign) {

			*wideIntPtr = - (Tcl_WideInt) value;


		    } else {

			*wideIntPtr = (Tcl_WideInt) value;
		    }
		    return TCL_OK;


		}
	    }
	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);

		Tcl_SetObjResult(interp, msg);
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	    }
	    return TCL_ERROR;
































































	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*







>
|
>
>

>
|
<
|
>
>










>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660

2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
		unsigned char *bytes = (unsigned char *) &scratch;

		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
		    while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		    }
		    if (big.sign) {
			if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
			    *wideIntPtr = - (Tcl_WideInt) value;
			    return TCL_OK;
			}
		    } else {
			if (value <= (Tcl_WideUInt)WIDE_MAX) {
			    *wideIntPtr = (Tcl_WideInt) value;

			    return TCL_OK;
			}
		    }
		}
	    }
	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);

		Tcl_SetObjResult(interp, msg);
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	    }
	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetWideBitsFromObj --
 *
 *	Attempt to return a wide integer from the Tcl object "objPtr". If the
 *	object is not already a int, double or bignum, an attempt will be made
 *	to convert it to one of these. Out-of-range values don't result in an
 *	error, but only the least significant 64 bits will be returned.
 *
 * Results:
 *	The return value is a standard Tcl object result. If an error occurs
 *	during conversion, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:
 *	If the object is not already an int, double or bignum object, the
 *	conversion will free any old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
TclGetWideBitsFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,            /* Object from which to get a wide int. */
    Tcl_WideInt *wideIntPtr)    /* Place to store resulting wide integer. */
{
    do {
	if (objPtr->typePtr == &tclIntType) {
	    *wideIntPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
	    }
	    return TCL_ERROR;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    mp_int big;

	    Tcl_WideUInt value = 0, scratch;
	    unsigned long numBytes = sizeof(Tcl_WideInt);
	    unsigned char *bytes = (unsigned char *) &scratch;

	    Tcl_GetBignumFromObj(NULL, objPtr, &big);
	    mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big);
	    mp_to_unsigned_bin_n(&big, bytes, &numBytes);
	    while (numBytes-- > 0) {
		value = (value << CHAR_BIT) | *bytes++;
	    }
	    *wideIntPtr = !big.sign ? (Tcl_WideInt)value : -(Tcl_WideInt)value;
	    mp_clear(&big);
	    return TCL_OK;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
    Tcl_Obj *objPtr)
{
    mp_int toFree;		/* Bignum to free */

    UNPACK_BIGNUM(objPtr, toFree);
    mp_clear(&toFree);
    if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
	ckfree(objPtr->internalRep.twoPtrValue.ptr1);
    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *







|







2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
    Tcl_Obj *objPtr)
{
    mp_int toFree;		/* Bignum to free */

    UNPACK_BIGNUM(objPtr, toFree);
    mp_clear(&toFree);
    if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
	Tcl_Free(objPtr->internalRep.twoPtrValue.ptr1);
    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
	 *
	 * Note that so long as we enforce our bignums to the size that fits
	 * in a packed bignum, this branch will never be taken.
	 */

	Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
    }
    stringVal = ckalloc(size);
    status = mp_toradix_n(&bignumVal, stringVal, 10, size);
    if (status != MP_OKAY) {
	Tcl_Panic("conversion failure in UpdateStringOfBignum");
    }
    objPtr->bytes = stringVal;
    objPtr->length = size - 1;	/* size includes a trailing NUL byte. */
}







|







2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
	 *
	 * Note that so long as we enforce our bignums to the size that fits
	 * in a packed bignum, this branch will never be taken.
	 */

	Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
    }
    stringVal = Tcl_Alloc(size);
    status = mp_toradix_n(&bignumVal, stringVal, 10, size);
    if (status != MP_OKAY) {
	Tcl_Panic("conversion failure in UpdateStringOfBignum");
    }
    objPtr->bytes = stringVal;
    objPtr->length = size - 1;	/* size includes a trailing NUL byte. */
}
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043

	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
	    goto tooLargeForWide;
	}
	while (numBytes-- > 0) {
	    value = (value << CHAR_BIT) | *bytes++;
	}
	if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) {
	    goto tooLargeForWide;
	}
	if (bignumValue->sign) {
	    TclSetIntObj(objPtr, -(Tcl_WideInt)value);
	} else {
	    TclSetIntObj(objPtr, (Tcl_WideInt)value);
	}







|







3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117

	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
	    goto tooLargeForWide;
	}
	while (numBytes-- > 0) {
	    value = (value << CHAR_BIT) | *bytes++;
	}
	if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
	    goto tooLargeForWide;
	}
	if (bignumValue->sign) {
	    TclSetIntObj(objPtr, -(Tcl_WideInt)value);
	} else {
	    TclSetIntObj(objPtr, (Tcl_WideInt)value);
	}
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
	    } else {
		*typePtr = TCL_NUMBER_DOUBLE;
	    }
	    *clientDataPtr = &objPtr->internalRep.doubleValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    *typePtr = TCL_NUMBER_WIDE;
	    *clientDataPtr = &objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    static Tcl_ThreadDataKey bignumKey;
	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
		    (int) sizeof(mp_int));

	    UNPACK_BIGNUM(objPtr, *bigPtr);
	    *typePtr = TCL_NUMBER_BIG;
	    *clientDataPtr = bigPtr;
	    return TCL_OK;
	}
    } while (TCL_OK ==







|





|
<







3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209

3210
3211
3212
3213
3214
3215
3216
	    } else {
		*typePtr = TCL_NUMBER_DOUBLE;
	    }
	    *clientDataPtr = &objPtr->internalRep.doubleValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    *typePtr = TCL_NUMBER_INT;
	    *clientDataPtr = &objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    static Tcl_ThreadDataKey bignumKey;
	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey, sizeof(mp_int));


	    UNPACK_BIGNUM(objPtr, *bigPtr);
	    *typePtr = TCL_NUMBER_BIG;
	    *clientDataPtr = bigPtr;
	    return TCL_OK;
	}
    } while (TCL_OK ==
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
 */

static Tcl_HashEntry *
AllocObjEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = keyPtr;
    Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));

    hPtr->key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    hPtr->clientData = NULL;

    return hPtr;
}







|
|







3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
 */

static Tcl_HashEntry *
AllocObjEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_HashEntry *hPtr = Tcl_Alloc(sizeof(Tcl_HashEntry));

    hPtr->key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    hPtr->clientData = NULL;

    return hPtr;
}
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
 */

int
TclCompareObjKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = keyPtr;
    Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
    register const char *p1, *p2;
    register size_t l1, l2;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller







|







3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
 */

int
TclCompareObjKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
    Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
    register const char *p1, *p2;
    register size_t l1, l2;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
void
TclFreeObjEntry(
    Tcl_HashEntry *hPtr)	/* Hash entry to free. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;

    Tcl_DecrRefCount(objPtr);
    ckfree(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclHashObjKey --
 *







|







3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
void
TclFreeObjEntry(
    Tcl_HashEntry *hPtr)	/* Hash entry to free. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;

    Tcl_DecrRefCount(objPtr);
    Tcl_Free(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclHashObjKey --
 *
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524

3525
3526
3527
3528
3529
3530
3531
3532
 */

TCL_HASH_TYPE
TclHashObjKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    Tcl_Obj *objPtr = keyPtr;
    int length;
    const char *string = TclGetStringFromObj(objPtr, &length);

    unsigned int result = 0;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:







|
<
|
>
|







3588
3589
3590
3591
3592
3593
3594
3595

3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
 */

TCL_HASH_TYPE
TclHashObjKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;

    const char *string = TclGetString(objPtr);
    size_t length = objPtr->length;
    TCL_HASH_TYPE result = 0;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
     *
     * See also HashStringKey in tclHash.c.
     * See also HashString in tclLiteral.c.
     *
     * See [tcl-Feature Request #2958832]
     */

    if (length > 0) {
	result = UCHAR(*string);
	while (--length) {
	    result += (result << 3) + UCHAR(*++string);
	}
    }
    return (TCL_HASH_TYPE) result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandFromObj --
 *







|





|







3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
     *
     * See also HashStringKey in tclHash.c.
     * See also HashString in tclLiteral.c.
     *
     * See [tcl-Feature Request #2958832]
     */

    if (length) {
	result = UCHAR(*string);
	while (--length) {
	    result += (result << 3) + UCHAR(*++string);
	}
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandFromObj --
 *
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
    Interp *iPtr = (Interp *) interp;
    ResolvedCmdName *fillPtr;
    const char *name = TclGetString(objPtr);

    if (resPtr) {
	fillPtr = resPtr;
    } else {
	fillPtr = ckalloc(sizeof(ResolvedCmdName));
	fillPtr->refCount = 1;
    }

    fillPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;
    fillPtr->cmdEpoch = cmdPtr->cmdEpoch;








|







3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
    Interp *iPtr = (Interp *) interp;
    ResolvedCmdName *fillPtr;
    const char *name = TclGetString(objPtr);

    if (resPtr) {
	fillPtr = resPtr;
    } else {
	fillPtr = Tcl_Alloc(sizeof(ResolvedCmdName));
	fillPtr->refCount = 1;
    }

    fillPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;
    fillPtr->cmdEpoch = cmdPtr->cmdEpoch;

3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
	     * table or if there are other references to it from other cmdName
	     * objects.
	     */

	    Command *cmdPtr = resPtr->cmdPtr;

	    TclCleanupCommandMacro(cmdPtr);
	    ckfree(resPtr);
	}
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *







|







3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
	     * table or if there are other references to it from other cmdName
	     * objects.
	     */

	    Command *cmdPtr = resPtr->cmdPtr;

	    TclCleanupCommandMacro(cmdPtr);
	    Tcl_Free(resPtr);
	}
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945

    /*
     * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
     * internal representation 0x45671234:0x98765432, string representation
     * "1872361827361287"
     */

    descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d,"
	    " object pointer at %p",
	    objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
	    objv[1]->refCount, objv[1]);

    if (objv[1]->typePtr) {
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",







|







4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018

    /*
     * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
     * internal representation 0x45671234:0x98765432, string representation
     * "1872361827361287"
     */

    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",
	    objv[1]->refCount, objv[1]);

    if (objv[1]->typePtr) {
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
Changes to generic/tclParse.c.
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
};

/*
 * Prototypes for local functions defined in this file:
 */

static inline int	CommandComplete(const char *script, int numBytes);
static int		ParseComment(const char *src, int numBytes,
			    Tcl_Parse *parsePtr);
static int		ParseTokens(const char *src, int numBytes, int mask,
			    int flags, Tcl_Parse *parsePtr);
static int		ParseWhiteSpace(const char *src, int numBytes,
			    int *incompletePtr, char *typePtr);
static int		ParseAllWhiteSpace(const char *src, int numBytes,
			    int *incompletePtr);

/*
 *----------------------------------------------------------------------
 *
 * TclParseInit --
 *







|
|

|

|

|







156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
};

/*
 * Prototypes for local functions defined in this file:
 */

static inline int	CommandComplete(const char *script, size_t numBytes);
static size_t		ParseComment(const char *src, size_t numBytes,
			    Tcl_Parse *parsePtr);
static int		ParseTokens(const char *src, size_t numBytes, int mask,
			    int flags, Tcl_Parse *parsePtr);
static size_t		ParseWhiteSpace(const char *src, size_t numBytes,
			    int *incompletePtr, char *typePtr);
static size_t		ParseAllWhiteSpace(const char *src, size_t numBytes,
			    int *incompletePtr);

/*
 *----------------------------------------------------------------------
 *
 * TclParseInit --
 *
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
 *----------------------------------------------------------------------
 */

void
TclParseInit(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting */
    const char *start,		/* Start of string to be parsed. */
    int numBytes,		/* Total number of bytes in string. If < 0,
				 * the script consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr)	/* Points to struct to initialize */
{
    parsePtr->numWords = 0;
    parsePtr->tokenPtr = parsePtr->staticTokens;
    parsePtr->numTokens = 0;







|







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
 *----------------------------------------------------------------------
 */

void
TclParseInit(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting */
    const char *start,		/* Start of string to be parsed. */
    size_t numBytes,		/* Total number of bytes in string. If (size_t)-1,
				 * the script consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr)	/* Points to struct to initialize */
{
    parsePtr->numWords = 0;
    parsePtr->tokenPtr = parsePtr->staticTokens;
    parsePtr->numTokens = 0;
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276

int
Tcl_ParseCommand(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* First character of string containing one or
				 * more Tcl commands. */
    register int numBytes,	/* Total number of bytes in string. If < 0,
				 * the script consists of all bytes up to the
				 * first null character. */
    int nested,			/* Non-zero means this is a nested command:
				 * close bracket should be considered a
				 * command terminator. If zero, then close
				 * bracket has no special meaning. */
    register Tcl_Parse *parsePtr)
				/* Structure to fill in with information about
				 * the parsed command; any previous
				 * information in the structure is ignored. */
{
    register const char *src;	/* Points to current character in the
				 * command. */
    char type;			/* Result returned by CHAR_TYPE(*src). */
    Tcl_Token *tokenPtr;	/* Pointer to token being filled in. */
    int wordIndex;		/* Index of word token for current word. */
    int terminators;		/* CHAR_TYPE bits that indicate the end of a
				 * command. */
    const char *termPtr;	/* Set by Tcl_ParseBraces/QuotedString to
				 * point to char after terminating one. */
    int scanned;

    if ((start == NULL) && (numBytes != 0)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "can't parse a NULL pointer", -1));
	}
	return TCL_ERROR;
    }
    if (numBytes < 0) {
	numBytes = strlen(start);
    }
    TclParseInit(interp, start, numBytes, parsePtr);
    parsePtr->commentStart = NULL;
    parsePtr->commentSize = 0;
    parsePtr->commandStart = NULL;
    parsePtr->commandSize = 0;







|






|




|








|








|







232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276

int
Tcl_ParseCommand(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* First character of string containing one or
				 * more Tcl commands. */
    size_t numBytes,		/* Total number of bytes in string. If (size_t)-1,
				 * the script consists of all bytes up to the
				 * first null character. */
    int nested,			/* Non-zero means this is a nested command:
				 * close bracket should be considered a
				 * command terminator. If zero, then close
				 * bracket has no special meaning. */
    Tcl_Parse *parsePtr)
				/* Structure to fill in with information about
				 * the parsed command; any previous
				 * information in the structure is ignored. */
{
    const char *src;		/* Points to current character in the
				 * command. */
    char type;			/* Result returned by CHAR_TYPE(*src). */
    Tcl_Token *tokenPtr;	/* Pointer to token being filled in. */
    int wordIndex;		/* Index of word token for current word. */
    int terminators;		/* CHAR_TYPE bits that indicate the end of a
				 * command. */
    const char *termPtr;	/* Set by Tcl_ParseBraces/QuotedString to
				 * point to char after terminating one. */
    size_t scanned;

    if ((start == NULL) && (numBytes != 0)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "can't parse a NULL pointer", -1));
	}
	return TCL_ERROR;
    }
    if (numBytes == (size_t)-1) {
	numBytes = strlen(start);
    }
    TclParseInit(interp, start, numBytes, parsePtr);
    parsePtr->commentStart = NULL;
    parsePtr->commentSize = 0;
    parsePtr->commandStart = NULL;
    parsePtr->commandSize = 0;
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
	     */

	    expPtr = &parsePtr->tokenPtr[expIdx];
	    if ((0 == expandWord)
		    /* Haven't seen prefix already */
		    && (1 == parsePtr->numTokens - expIdx)
		    /* Only one token */
		    && (((1 == (size_t) expPtr->size)
			    /* Same length as prefix */
			    && (expPtr->start[0] == '*')))
			    /* Is the prefix */
		    && (numBytes > 0) && (0 == ParseWhiteSpace(termPtr,
			    numBytes, &parsePtr->incomplete, &type))
		    && (type != TYPE_COMMAND_END)
		    /* Non-whitespace follows */) {







|







381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
	     */

	    expPtr = &parsePtr->tokenPtr[expIdx];
	    if ((0 == expandWord)
		    /* Haven't seen prefix already */
		    && (1 == parsePtr->numTokens - expIdx)
		    /* Only one token */
		    && (((1 == expPtr->size)
			    /* Same length as prefix */
			    && (expPtr->start[0] == '*')))
			    /* Is the prefix */
		    && (numBytes > 0) && (0 == ParseWhiteSpace(termPtr,
			    numBytes, &parsePtr->incomplete, &type))
		    && (type != TYPE_COMMAND_END)
		    /* Non-whitespace follows */) {
416
417
418
419
420
421
422

423
424
425
426
427
428
429
430
	 * case of a word consisting of a single range of literal text.
	 */

	tokenPtr = &parsePtr->tokenPtr[wordIndex];
	tokenPtr->size = src - tokenPtr->start;
	tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
	if (expandWord) {

	    int i, isLiteral = 1;

	    /*
	     * When a command includes a word that is an expanded literal; for
	     * example, {*}{1 2 3}, the parser performs that expansion
	     * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead
	     * of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand()
	     * caller might have to expand. This notably makes it simpler for







>
|







416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
	 * case of a word consisting of a single range of literal text.
	 */

	tokenPtr = &parsePtr->tokenPtr[wordIndex];
	tokenPtr->size = src - tokenPtr->start;
	tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
	if (expandWord) {
	    size_t i;
	    int isLiteral = 1;

	    /*
	     * When a command includes a word that is an expanded literal; for
	     * example, {*}{1 2 3}, the parser performs that expansion
	     * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead
	     * of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand()
	     * caller might have to expand. This notably makes it simpler for
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476

		/*
		 * Step through the literal string, parsing and counting list
		 * elements.
		 */

		while (nextElem < listEnd) {
		    int size;

		    code = TclFindElement(NULL, nextElem, listEnd - nextElem,
			    &elemStart, &nextElem, &size, &literal);
		    if ((code != TCL_OK) || !literal) {
			break;
		    }
		    if (elemStart < listEnd) {







|







463
464
465
466
467
468
469
470
471
472
473
474
475
476
477

		/*
		 * Step through the literal string, parsing and counting list
		 * elements.
		 */

		while (nextElem < listEnd) {
		    size_t size;

		    code = TclFindElement(NULL, nextElem, listEnd - nextElem,
			    &elemStart, &nextElem, &size, &literal);
		    if ((code != TCL_OK) || !literal) {
			break;
		    }
		    if (elemStart < listEnd) {
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ParseWhiteSpace(
    const char *src,		/* First character to parse. */
    register int numBytes,	/* Max number of bytes to scan. */
    int *incompletePtr,		/* Set this boolean memory to true if parsing
				 * indicates an incomplete command. */
    char *typePtr)		/* Points to location to store character type
				 * of character that ends run of whitespace */
{
    register char type = TYPE_NORMAL;
    register const char *p = src;







|


|







655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseWhiteSpace(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of bytes to scan. */
    int *incompletePtr,		/* Set this boolean memory to true if parsing
				 * indicates an incomplete command. */
    char *typePtr)		/* Points to location to store character type
				 * of character that ends run of whitespace */
{
    register char type = TYPE_NORMAL;
    register const char *p = src;
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
 *
 * Results:
 *	Returns the number of bytes recognized as white space.
 *
 *----------------------------------------------------------------------
 */

static int
ParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    int numBytes,		/* Max number of byes to scan */
    int *incompletePtr)		/* Set true if parse is incomplete. */
{
    char type;
    const char *p = src;

    do {
	int scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type);

	p += scanned;
	numBytes -= scanned;
    } while (numBytes && (*p == '\n') && (p++, --numBytes));
    return (p-src);
}

int
TclParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    int numBytes)		/* Max number of byes to scan */
{
    int dummy;
    return ParseAllWhiteSpace(src, numBytes, &dummy);
}

/*
 *----------------------------------------------------------------------







|


|






|







|


|







709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
 *
 * Results:
 *	Returns the number of bytes recognized as white space.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of byes to scan */
    int *incompletePtr)		/* Set true if parse is incomplete. */
{
    char type;
    const char *p = src;

    do {
	size_t scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type);

	p += scanned;
	numBytes -= scanned;
    } while (numBytes && (*p == '\n') && (p++, --numBytes));
    return (p-src);
}

size_t
TclParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    size_t numBytes)		/* Max number of byes to scan */
{
    int dummy;
    return ParseAllWhiteSpace(src, numBytes, &dummy);
}

/*
 *----------------------------------------------------------------------
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
 *
 *----------------------------------------------------------------------
 */

int
TclParseHex(
    const char *src,		/* First character to parse. */
    int numBytes,		/* Max number of byes to scan */
    int *resultPtr)	/* Points to storage provided by caller where
				 * the character resulting from the
				 * conversion is to be written. */
{
    int result = 0;
    register const char *p = src;

    while (numBytes--) {







|
|







761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
 *
 *----------------------------------------------------------------------
 */

int
TclParseHex(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of byes to scan */
    int *resultPtr)		/* Points to storage provided by caller where
				 * the character resulting from the
				 * conversion is to be written. */
{
    int result = 0;
    register const char *p = src;

    while (numBytes--) {
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
 *----------------------------------------------------------------------
 */

int
TclParseBackslash(
    const char *src,		/* Points to the backslash character of a a
				 * backslash sequence. */
    int numBytes,		/* Max number of bytes to scan. */
    int *readPtr,		/* NULL, or points to storage where the number
				 * of bytes scanned should be written. */
    char *dst)			/* NULL, or points to buffer where the UTF-8
				 * encoding of the backslash sequence is to be
				 * written. At most TCL_UTF_MAX bytes will be
				 * written there. */
{
    register const char *p = src+1;
    Tcl_UniChar unichar = 0;
    int result;
    int count;
    char buf[TCL_UTF_MAX];

    if (numBytes == 0) {
	if (readPtr != NULL) {
	    *readPtr = 0;
	}
	return 0;







|
|









|







817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
 *----------------------------------------------------------------------
 */

int
TclParseBackslash(
    const char *src,		/* Points to the backslash character of a a
				 * backslash sequence. */
    size_t numBytes,		/* Max number of bytes to scan. */
    size_t *readPtr,		/* NULL, or points to storage where the number
				 * of bytes scanned should be written. */
    char *dst)			/* NULL, or points to buffer where the UTF-8
				 * encoding of the backslash sequence is to be
				 * written. At most TCL_UTF_MAX bytes will be
				 * written there. */
{
    register const char *p = src+1;
    Tcl_UniChar unichar = 0;
    int result;
    size_t count;
    char buf[TCL_UTF_MAX];

    if (numBytes == 0) {
	if (readPtr != NULL) {
	    *readPtr = 0;
	}
	return 0;
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ParseComment(
    const char *src,		/* First character to parse. */
    register int numBytes,	/* Max number of bytes to scan. */
    Tcl_Parse *parsePtr)	/* Information about parse in progress.
				 * Updated if parsing indicates an incomplete
				 * command. */
{
    register const char *p = src;
    int incomplete = parsePtr->incomplete;

    while (numBytes) {
	int scanned = ParseAllWhiteSpace(p, numBytes, &incomplete);
	p += scanned;
	numBytes -= scanned;

	if ((numBytes == 0) || (*p != '#')) {
	    break;
	}
	if (parsePtr->commentStart == NULL) {







|


|








|







1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseComment(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of bytes to scan. */
    Tcl_Parse *parsePtr)	/* Information about parse in progress.
				 * Updated if parsing indicates an incomplete
				 * command. */
{
    register const char *p = src;
    int incomplete = parsePtr->incomplete;

    while (numBytes) {
	size_t scanned = ParseAllWhiteSpace(p, numBytes, &incomplete);
	p += scanned;
	numBytes -= scanned;

	if ((numBytes == 0) || (*p != '#')) {
	    break;
	}
	if (parsePtr->commentStart == NULL) {
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
 *
 *----------------------------------------------------------------------
 */

static int
ParseTokens(
    register const char *src,	/* First character to parse. */
    register int numBytes,	/* Max number of bytes to scan. */
    int mask,			/* Specifies when to stop parsing. The parse
				 * stops at the first unquoted character whose
				 * CHAR_TYPE contains any of the bits in
				 * mask. */
    int flags,			/* OR-ed bits indicating what substitutions to
				 * perform: TCL_SUBST_COMMANDS,
				 * TCL_SUBST_VARIABLES, and







|







1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
 *
 *----------------------------------------------------------------------
 */

static int
ParseTokens(
    register const char *src,	/* First character to parse. */
    size_t numBytes,		/* Max number of bytes to scan. */
    int mask,			/* Specifies when to stop parsing. The parse
				 * stops at the first unquoted character whose
				 * CHAR_TYPE contains any of the bits in
				 * mask. */
    int flags,			/* OR-ed bits indicating what substitutions to
				 * perform: TCL_SUBST_COMMANDS,
				 * TCL_SUBST_VARIABLES, and
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331

void
Tcl_FreeParse(
    Tcl_Parse *parsePtr)	/* Structure that was filled in by a previous
				 * call to Tcl_ParseCommand. */
{
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree(parsePtr->tokenPtr);
	parsePtr->tokenPtr = parsePtr->staticTokens;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332

void
Tcl_FreeParse(
    Tcl_Parse *parsePtr)	/* Structure that was filled in by a previous
				 * call to Tcl_ParseCommand. */
{
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	Tcl_Free(parsePtr->tokenPtr);
	parsePtr->tokenPtr = parsePtr->staticTokens;
    }
}

/*
 *----------------------------------------------------------------------
 *
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387

int
Tcl_ParseVarName(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of variable substitution string.
				 * First character must be "$". */
    register int numBytes,	/* Total number of bytes in string. If < 0,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,	/* Structure to fill in with information about
				 * the variable name. */
    int append)			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
{
    Tcl_Token *tokenPtr;
    register const char *src;
    int varIndex;
    unsigned array;

    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
    }
    if (numBytes < 0) {
	numBytes = strlen(start);
    }

    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }








|

















|







1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388

int
Tcl_ParseVarName(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of variable substitution string.
				 * First character must be "$". */
    size_t numBytes,		/* Total number of bytes in string. If (size_t)-1,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,	/* Structure to fill in with information about
				 * the variable name. */
    int append)			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
{
    Tcl_Token *tokenPtr;
    register const char *src;
    int varIndex;
    unsigned array;

    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
    }
    if (numBytes == (size_t)-1) {
	numBytes = strlen(start);
    }

    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }

1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657

1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669

int
Tcl_ParseBraces(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of string enclosed in braces. The
				 * first character must be {'. */
    register int numBytes,	/* Total number of bytes in string. If < 0,
				 * the string consists of all bytes up to the
				 * first null character. */
    register Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
				 * the terminating '}' if the parse was
				 * successful. */
{
    Tcl_Token *tokenPtr;
    register const char *src;
    int startIndex, level, length;


    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
    }
    if (numBytes < 0) {
	numBytes = strlen(start);
    }

    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }








|
















|
>




|







1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671

int
Tcl_ParseBraces(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of string enclosed in braces. The
				 * first character must be {'. */
    size_t numBytes,		/* Total number of bytes in string. If (size_t)-1,
				 * the string consists of all bytes up to the
				 * first null character. */
    register Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
				 * the terminating '}' if the parse was
				 * successful. */
{
    Tcl_Token *tokenPtr;
    register const char *src;
    int startIndex, level;
    size_t length;

    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
    }
    if (numBytes == (size_t)-1) {
	numBytes = strlen(start);
    }

    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }

1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867

int
Tcl_ParseQuotedString(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of the quoted string. The first
				 * character must be '"'. */
    register int numBytes,	/* Total number of bytes in string. If < 0,
				 * the string consists of all bytes up to the
				 * first null character. */
    register Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
				 * the quoted string's terminating close-quote
				 * if the parse succeeds. */
{
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
    }
    if (numBytes < 0) {
	numBytes = strlen(start);
    }

    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }








|

















|







1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869

int
Tcl_ParseQuotedString(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of the quoted string. The first
				 * character must be '"'. */
    size_t numBytes,		/* Total number of bytes in string. If (size_t)-1,
				 * the string consists of all bytes up to the
				 * first null character. */
    register Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
				 * the quoted string's terminating close-quote
				 * if the parse succeeds. */
{
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
    }
    if (numBytes == (size_t)-1) {
	numBytes = strlen(start);
    }

    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }

1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
 *----------------------------------------------------------------------
 */

void
TclSubstParse(
    Tcl_Interp *interp,
    const char *bytes,
    int numBytes,
    int flags,
    Tcl_Parse *parsePtr,
    Tcl_InterpState *statePtr)
{
    int length = numBytes;
    const char *p = bytes;

    TclParseInit(interp, p, length, parsePtr);

    /*
     * First parse the string rep of objPtr, as if it were enclosed as a
     * "-quoted word in a normal Tcl command. Honor flags that selectively







|




|







1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
 *----------------------------------------------------------------------
 */

void
TclSubstParse(
    Tcl_Interp *interp,
    const char *bytes,
    size_t numBytes,
    int flags,
    Tcl_Parse *parsePtr,
    Tcl_InterpState *statePtr)
{
    size_t length = numBytes;
    const char *p = bytes;

    TclParseInit(interp, p, length, parsePtr);

    /*
     * First parse the string rep of objPtr, as if it were enclosed as a
     * "-quoted word in a normal Tcl command. Honor flags that selectively
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	clPosition = ckalloc(maxNumCL * sizeof(int));
    }

    adjust = 0;
    result = NULL;
    for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
	Tcl_Obj *appendObj = NULL;
	const char *append = NULL;







|







2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	clPosition = Tcl_Alloc(maxNumCL * sizeof(int));
    }

    adjust = 0;
    result = NULL;
    for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
	Tcl_Obj *appendObj = NULL;
	const char *append = NULL;
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
		    && (tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    int clPos;

		    if (result == 0) {
			clPos = 0;
		    } else {
			TclGetStringFromObj(result, &clPos);
		    }

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = ckrealloc(clPosition,
				maxNumCL * sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL++;
		}
		adjust++;
	    }







|




|







2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
		    && (tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    int clPos;

		    if (result == 0) {
			clPos = 0;
		    } else {
			(void)TclGetStringFromObj(result, &clPos);
		    }

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = Tcl_Realloc(clPosition,
				maxNumCL * sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL++;
		}
		adjust++;
	    }
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401

	    /*
	     * Release the temp table we used to collect the locations of
	     * continuation lines, if any.
	     */

	    if (maxNumCL) {
		ckfree(clPosition);
	    }
	} else {
	    Tcl_ResetResult(interp);
	}
    }
    if (tokensLeftPtr != NULL) {
	*tokensLeftPtr = count;







|







2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403

	    /*
	     * Release the temp table we used to collect the locations of
	     * continuation lines, if any.
	     */

	    if (maxNumCL) {
		Tcl_Free(clPosition);
	    }
	} else {
	    Tcl_ResetResult(interp);
	}
    }
    if (tokensLeftPtr != NULL) {
	*tokensLeftPtr = count;
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
 *
 *----------------------------------------------------------------------
 */

static inline int
CommandComplete(
    const char *script,		/* Script to check. */
    int numBytes)		/* Number of bytes in script. */
{
    Tcl_Parse parse;
    const char *p, *end;
    int result;

    p = script;
    end = p + numBytes;







|







2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
 *
 *----------------------------------------------------------------------
 */

static inline int
CommandComplete(
    const char *script,		/* Script to check. */
    size_t numBytes)		/* Number of bytes in script. */
{
    Tcl_Parse parse;
    const char *p, *end;
    int result;

    p = script;
    end = p + numBytes;
Changes to generic/tclPathObj.c.
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

static Tcl_Obj *	AppendPath(Tcl_Obj *head, Tcl_Obj *tail);
static void		DupFsPathInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static void		FreeFsPathInternalRep(Tcl_Obj *pathPtr);
static void		UpdateStringOfFsPath(Tcl_Obj *pathPtr);
static int		SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static int		FindSplitPos(const char *path, int separator);
static int		IsSeparatorOrNull(int ch);
static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);
static int		MakePathFromNormalized(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);

/*
 * Define the 'path' object type, which Tcl uses to represent file paths







|







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

static Tcl_Obj *	AppendPath(Tcl_Obj *head, Tcl_Obj *tail);
static void		DupFsPathInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static void		FreeFsPathInternalRep(Tcl_Obj *pathPtr);
static void		UpdateStringOfFsPath(Tcl_Obj *pathPtr);
static int		SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static size_t	FindSplitPos(const char *path, int separator);
static int		IsSeparatorOrNull(int ch);
static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);
static int		MakePathFromNormalized(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);

/*
 * Define the 'path' object type, which Tcl uses to represent file paths
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
		oldDirSep = dirSep;
	    }
	again:
	    if (IsSeparatorOrNull(dirSep[2])) {
		/*
		 * Need to skip '.' in the path.
		 */
		int curLen;

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);
		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		TclGetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		dirSep += 2;
		oldDirSep = dirSep;
		if (dirSep[0] != 0 && dirSep[1] == '.') {
		    goto again;
		}
		continue;
	    }
	    if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) {
		Tcl_Obj *linkObj;
		int curLen;
		char *linkStr;

		/*
		 * Have '..' so need to skip previous directory.
		 */

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);

		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		TclGetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
		    linkObj = Tcl_FSLink(retVal, NULL, 0);

		    /* Safety check in case driver caused sharing */







|






|












|












|







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
		oldDirSep = dirSep;
	    }
	again:
	    if (IsSeparatorOrNull(dirSep[2])) {
		/*
		 * Need to skip '.' in the path.
		 */
		size_t curLen;

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);
		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		(void)TclGetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		dirSep += 2;
		oldDirSep = dirSep;
		if (dirSep[0] != 0 && dirSep[1] == '.') {
		    goto again;
		}
		continue;
	    }
	    if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) {
		Tcl_Obj *linkObj;
		size_t curLen;
		char *linkStr;

		/*
		 * Have '..' so need to skip previous directory.
		 */

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);

		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		(void)TclGetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
		    linkObj = Tcl_FSLink(retVal, NULL, 0);

		    /* Safety check in case driver caused sharing */
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
			     * to retVal's directory. This means concatenating
			     * the link onto the directory of the path so far.
			     */

			    const char *path =
				    TclGetStringFromObj(retVal, &curLen);

			    while (--curLen >= 0) {
				if (IsSeparatorOrNull(path[curLen])) {
				    break;
				}
			    }

			    /*
			     * We want the trailing slash.







|







287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
			     * to retVal's directory. This means concatenating
			     * the link onto the directory of the path so far.
			     */

			    const char *path =
				    TclGetStringFromObj(retVal, &curLen);

			    while (curLen-- > 0) {
				if (IsSeparatorOrNull(path[curLen])) {
				    break;
				}
			    }

			    /*
			     * We want the trailing slash.
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
			    linkStr = TclGetStringFromObj(retVal, &curLen);

			    /*
			     * Convert to forward-slashes on windows.
			     */

			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
				int i;

				for (i = 0; i < curLen; i++) {
				    if (linkStr[i] == '\\') {
					linkStr[i] = '/';
				    }
				}
			    }
			}
		    } else {
			linkStr = TclGetStringFromObj(retVal, &curLen);
		    }

		    /*
		     * Either way, we now remove the last path element (but
		     * not the first character of the path).
		     */

		    while (--curLen >= 0) {
			if (IsSeparatorOrNull(linkStr[curLen])) {
			    if (curLen) {
				Tcl_SetObjLength(retVal, curLen);
			    } else {
				Tcl_SetObjLength(retVal, 1);
			    }
			    break;







|

















|







320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
			    linkStr = TclGetStringFromObj(retVal, &curLen);

			    /*
			     * Convert to forward-slashes on windows.
			     */

			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
				size_t i;

				for (i = 0; i < curLen; i++) {
				    if (linkStr[i] == '\\') {
					linkStr[i] = '/';
				    }
				}
			    }
			}
		    } else {
			linkStr = TclGetStringFromObj(retVal, &curLen);
		    }

		    /*
		     * Either way, we now remove the last path element (but
		     * not the first character of the path).
		     */

		    while (curLen-- > 0) {
			if (IsSeparatorOrNull(linkStr[curLen])) {
			    if (curLen) {
				Tcl_SetObjLength(retVal, curLen);
			    } else {
				Tcl_SetObjLength(retVal, 1);
			    }
			    break;
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
    }

    /*
     * Ensure a windows drive like C:/ has a trailing separator.
     */

    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
	int len;
	const char *path = TclGetStringFromObj(retVal, &len);

	if (len == 2 && path[0] != 0 && path[1] == ':') {
	    if (Tcl_IsShared(retVal)) {
		TclDecrRefCount(retVal);
		retVal = Tcl_DuplicateObj(retVal);
		Tcl_IncrRefCount(retVal);







|







400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
    }

    /*
     * Ensure a windows drive like C:/ has a trailing separator.
     */

    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
	size_t len;
	const char *path = TclGetStringFromObj(retVal, &len);

	if (len == 2 && path[0] != 0 && path[1] == ':') {
	    if (Tcl_IsShared(retVal)) {
		TclDecrRefCount(retVal);
		retVal = Tcl_DuplicateObj(retVal);
		Tcl_IncrRefCount(retVal);
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
		 * Check if the joined-on bit has any directory delimiters in
		 * it. If so, the 'dirname' would be a joining of the main
		 * part with the dirname of the joined-on bit. We could handle
		 * that special case here, but we don't, and instead just use
		 * the standardPath code.
		 */

		int numBytes;
		const char *rest =
			TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file dirname] is
		 * documented to return all but the last non-empty element







<
|
|







574
575
576
577
578
579
580

581
582
583
584
585
586
587
588
589
		 * Check if the joined-on bit has any directory delimiters in
		 * it. If so, the 'dirname' would be a joining of the main
		 * part with the dirname of the joined-on bit. We could handle
		 * that special case here, but we don't, and instead just use
		 * the standardPath code.
		 */


		const char *rest = TclGetString(fsPathPtr->normPathPtr);
		size_t numBytes = fsPathPtr->normPathPtr->length;

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file dirname] is
		 * documented to return all but the last non-empty element
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
		/*
		 * Check if the joined-on bit has any directory delimiters in
		 * it. If so, the 'tail' would be only the part following the
		 * last delimiter. We could handle that special case here, but
		 * we don't, and instead just use the standardPath code.
		 */

		int numBytes;
		const char *rest =
			TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file tail] is
		 * documented to return the last non-empty element







<
|
|







611
612
613
614
615
616
617

618
619
620
621
622
623
624
625
626
		/*
		 * Check if the joined-on bit has any directory delimiters in
		 * it. If so, the 'tail' would be only the part following the
		 * last delimiter. We could handle that special case here, but
		 * we don't, and instead just use the standardPath code.
		 */


		const char *rest = TclGetString(fsPathPtr->normPathPtr);
		size_t numBytes = fsPathPtr->normPathPtr->length;

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file tail] is
		 * documented to return the last non-empty element
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
		Tcl_IncrRefCount(fsPathPtr->normPathPtr);
		return fsPathPtr->normPathPtr;
	    }
	    case TCL_PATH_EXTENSION:
		return GetExtension(fsPathPtr->normPathPtr);
	    case TCL_PATH_ROOT: {
		const char *fileName, *extension;
		int length;

		fileName = TclGetStringFromObj(fsPathPtr->normPathPtr,
			&length);
		extension = TclGetExtension(fileName);
		if (extension == NULL) {
		    /*
		     * There is no extension so the root is the same as the







|







639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
		Tcl_IncrRefCount(fsPathPtr->normPathPtr);
		return fsPathPtr->normPathPtr;
	    }
	    case TCL_PATH_EXTENSION:
		return GetExtension(fsPathPtr->normPathPtr);
	    case TCL_PATH_ROOT: {
		const char *fileName, *extension;
		size_t length;

		fileName = TclGetStringFromObj(fsPathPtr->normPathPtr,
			&length);
		extension = TclGetExtension(fileName);
		if (extension == NULL) {
		    /*
		     * There is no extension so the root is the same as the
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
		     * suffix removed.  Do that by joining our "head" to
		     * our "tail" with the extension suffix removed from
		     * the tail.
		     */

		    Tcl_Obj *resultPtr =
			    TclNewFSPathObj(fsPathPtr->cwdPtr, fileName,
			    (int)(length - strlen(extension)));

		    Tcl_IncrRefCount(resultPtr);
		    return resultPtr;
		}
	    }
	    default:
		/* We should never get here */







|







662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
		     * suffix removed.  Do that by joining our "head" to
		     * our "tail" with the extension suffix removed from
		     * the tail.
		     */

		    Tcl_Obj *resultPtr =
			    TclNewFSPathObj(fsPathPtr->cwdPtr, fileName,
			    length - strlen(extension));

		    Tcl_IncrRefCount(resultPtr);
		    return resultPtr;
		}
	    }
	    default:
		/* We should never get here */
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
	Tcl_Obj *splitPtr, *resultPtr;

    standardPath:
	resultPtr = NULL;
	if (portion == TCL_PATH_EXTENSION) {
	    return GetExtension(pathPtr);
	} else if (portion == TCL_PATH_ROOT) {
	    int length;
	    const char *fileName, *extension;

	    fileName = TclGetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;
	    } else {
		Tcl_Obj *root = Tcl_NewStringObj(fileName,
			(int) (length - strlen(extension)));

		Tcl_IncrRefCount(root);
		return root;
	    }
	}

	/*







|









|







690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
	Tcl_Obj *splitPtr, *resultPtr;

    standardPath:
	resultPtr = NULL;
	if (portion == TCL_PATH_EXTENSION) {
	    return GetExtension(pathPtr);
	} else if (portion == TCL_PATH_ROOT) {
	    size_t length;
	    const char *fileName, *extension;

	    fileName = TclGetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;
	    } else {
		Tcl_Obj *root = Tcl_NewStringObj(fileName,
			length - strlen(extension));

		Tcl_IncrRefCount(root);
		return root;
	    }
	}

	/*
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
                && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
            Tcl_Obj *tailObj = objv[1];
	    Tcl_PathType type = TclGetPathType(tailObj, NULL, NULL, NULL);

	    if (type == TCL_PATH_RELATIVE) {
		const char *str;
		int len;

		str = TclGetStringFromObj(tailObj, &len);
		if (len == 0) {
		    /*
		     * This happens if we try to handle the root volume '/'.
		     * There's no need to return a special path object, when
		     * the base itself is just fine!







|







879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
                && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
            Tcl_Obj *tailObj = objv[1];
	    Tcl_PathType type = TclGetPathType(tailObj, NULL, NULL, NULL);

	    if (type == TCL_PATH_RELATIVE) {
		const char *str;
		size_t len;

		str = TclGetStringFromObj(tailObj, &len);
		if (len == 0) {
		    /*
		     * This happens if we try to handle the root volume '/'.
		     * There's no need to return a special path object, when
		     * the base itself is just fine!
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
		    res = Tcl_DuplicateObj(res);
		    Tcl_IncrRefCount(res);
		}
	    }

	    if (length > 0 && ptr[length -1] != '/') {
		Tcl_AppendToObj(res, &separator, 1);
		TclGetStringFromObj(res, &length);
	    }
	    Tcl_SetObjLength(res, length + (int) strlen(strElt));

	    ptr = TclGetString(res) + length;
	    for (; *strElt != '\0'; strElt++) {
		if (*strElt == separator) {
		    while (strElt[1] == separator) {
			strElt++;
		    }







|

|







1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
		    res = Tcl_DuplicateObj(res);
		    Tcl_IncrRefCount(res);
		}
	    }

	    if (length > 0 && ptr[length -1] != '/') {
		Tcl_AppendToObj(res, &separator, 1);
		(void)TclGetStringFromObj(res, &length);
	    }
	    Tcl_SetObjLength(res, length + strlen(strElt));

	    ptr = TclGetString(res) + length;
	    for (; *strElt != '\0'; strElt++) {
		if (*strElt == separator) {
		    while (strElt[1] == separator) {
			strElt++;
		    }
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235

/*
 * Helper function for SetFsPathFromAny. Returns position of first directory
 * delimiter in the path. If no separator is found, then returns the position
 * of the end of the string.
 */

static int
FindSplitPos(
    const char *path,
    int separator)
{
    int count = 0;
    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:







|







1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233

/*
 * Helper function for SetFsPathFromAny. Returns position of first directory
 * delimiter in the path. If no separator is found, then returns the position
 * of the end of the string.
 */

static size_t
FindSplitPos(
    const char *path,
    int separator)
{
    int count = 0;
    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclNewFSPathObj(
    Tcl_Obj *dirPtr,
    const char *addStrRep,
    int len)
{
    FsPath *fsPathPtr;
    Tcl_Obj *pathPtr;
    const char *p;
    int state = 0, count = 0;

    /* [Bug 2806250] - this is only a partial solution of the problem.







|







1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclNewFSPathObj(
    Tcl_Obj *dirPtr,
    const char *addStrRep,
    size_t len)
{
    FsPath *fsPathPtr;
    Tcl_Obj *pathPtr;
    const char *p;
    int state = 0, count = 0;

    /* [Bug 2806250] - this is only a partial solution of the problem.
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321

	pathPtr = AppendPath(dirPtr, tail);
	Tcl_DecrRefCount(tail);
	return pathPtr;
    }

    pathPtr = Tcl_NewObj();
    fsPathPtr = ckalloc(sizeof(FsPath));

    /*
     * Set up the path.
     */

    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);







|







1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319

	pathPtr = AppendPath(dirPtr, tail);
	Tcl_DecrRefCount(tail);
	return pathPtr;
    }

    pathPtr = Tcl_NewObj();
    fsPathPtr = Tcl_Alloc(sizeof(FsPath));

    /*
     * Set up the path.
     */

    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353

    /*
     * Look for path components made up of only "."
     * This is overly conservative analysis to keep simple. It may mark some
     * things as needing more aggressive normalization that don't actually
     * need it. No harm done.
     */
    for (p = addStrRep; len > 0; p++, len--) {
	switch (state) {
	case 0:		/* So far only "." since last dirsep or start */
	    switch (*p) {
	    case '.':
		count++;
		break;
	    case '/':
	    case '\\':
	    case ':':
		if (count) {
		    PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
		    len = 0;







|




|







1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351

    /*
     * Look for path components made up of only "."
     * This is overly conservative analysis to keep simple. It may mark some
     * things as needing more aggressive normalization that don't actually
     * need it. No harm done.
     */
    for (p = addStrRep; len+1 > 1; p++, len--) {
	switch (state) {
	case 0:		/* So far only "." since last dirsep or start */
	    switch (*p) {
	    case '.':
		count = 1;
		break;
	    case '/':
	    case '\\':
	    case ':':
		if (count) {
		    PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
		    len = 0;
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
}

static Tcl_Obj *
AppendPath(
    Tcl_Obj *head,
    Tcl_Obj *tail)
{
    int numBytes;
    const char *bytes;
    Tcl_Obj *copy = Tcl_DuplicateObj(head);

    /*
     * This is likely buggy when dealing with virtual filesystem drivers
     * that use some character other than "/" as a path separator.  I know
     * of no evidence that such a foolish thing exists.  This solution was
     * chosen so that "JoinPath" operations that pass through either path
     * intrep produce the same results; that is, bugward compatibility.  If
     * we need to fix that bug here, it needs fixing in TclJoinPath() too.
     */
    bytes = TclGetStringFromObj(tail, &numBytes);
    if (numBytes == 0) {
	Tcl_AppendToObj(copy, "/", 1);
    } else {
	TclpNativeJoinPath(copy, bytes);
    }
    return copy;
}








<











|
|







1373
1374
1375
1376
1377
1378
1379

1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
}

static Tcl_Obj *
AppendPath(
    Tcl_Obj *head,
    Tcl_Obj *tail)
{

    const char *bytes;
    Tcl_Obj *copy = Tcl_DuplicateObj(head);

    /*
     * This is likely buggy when dealing with virtual filesystem drivers
     * that use some character other than "/" as a path separator.  I know
     * of no evidence that such a foolish thing exists.  This solution was
     * chosen so that "JoinPath" operations that pass through either path
     * intrep produce the same results; that is, bugward compatibility.  If
     * we need to fix that bug here, it needs fixing in TclJoinPath() too.
     */
    bytes = TclGetString(tail);
    if (tail->length == 0) {
	Tcl_AppendToObj(copy, "/", 1);
    } else {
	TclpNativeJoinPath(copy, bytes);
    }
    return copy;
}

1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
		return TCL_ERROR;
	    }
	    pathPtr->typePtr->updateStringProc(pathPtr);
	}
	TclFreeIntRep(pathPtr);
    }

    fsPathPtr = ckalloc(sizeof(FsPath));

    /*
     * It's a pure normalized absolute path.
     */

    fsPathPtr->translatedPathPtr = NULL;








|







1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
		return TCL_ERROR;
	    }
	    pathPtr->typePtr->updateStringProc(pathPtr);
	}
	TclFreeIntRep(pathPtr);
    }

    fsPathPtr = Tcl_Alloc(sizeof(FsPath));

    /*
     * It's a pure normalized absolute path.
     */

    fsPathPtr->translatedPathPtr = NULL;

1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
 *	native form (from, e.g. readlink or a native dialog), and that path is
 *	to be used at the Tcl level, then calling this function is an
 *	efficient way of creating the appropriate path object type.
 *
 *	Any memory which is allocated for 'clientData' should be retained
 *	until clientData is passed to the filesystem's freeInternalRepProc
 *	when it can be freed. The built in platform-specific filesystems use
 *	'ckalloc' to allocate clientData, and ckfree to free it.
 *
 * Results:
 *	NULL or a valid path object pointer, with refCount zero.
 *
 * Side effects:
 *	New memory may be allocated.
 *







|







1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
 *	native form (from, e.g. readlink or a native dialog), and that path is
 *	to be used at the Tcl level, then calling this function is an
 *	efficient way of creating the appropriate path object type.
 *
 *	Any memory which is allocated for 'clientData' should be retained
 *	until clientData is passed to the filesystem's freeInternalRepProc
 *	when it can be freed. The built in platform-specific filesystems use
 *	'Tcl_Alloc' to allocate clientData, and Tcl_Free to free it.
 *
 * Results:
 *	NULL or a valid path object pointer, with refCount zero.
 *
 * Side effects:
 *	New memory may be allocated.
 *
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
		return NULL;
	    }
	    pathPtr->typePtr->updateStringProc(pathPtr);
	}
	TclFreeIntRep(pathPtr);
    }

    fsPathPtr = ckalloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = NULL;

    /*
     * Circular reference, by design.
     */








|







1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
		return NULL;
	    }
	    pathPtr->typePtr->updateStringProc(pathPtr);
	}
	TclFreeIntRep(pathPtr);
    }

    fsPathPtr = Tcl_Alloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = NULL;

    /*
     * Circular reference, by design.
     */

1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	int len;
	const char *orig = TclGetStringFromObj(transPtr, &len);
	char *result = ckalloc(len+1);

	memcpy(result, orig, (size_t) len+1);
	TclDecrRefCount(transPtr);
	return result;
    }

    return NULL;







|







1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	int len;
	const char *orig = TclGetStringFromObj(transPtr, &len);
	char *result = Tcl_Alloc(len+1);

	memcpy(result, orig, (size_t) len+1);
	TclDecrRefCount(transPtr);
	return result;
    }

    return NULL;
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
	    return NULL;
	}
	/* TODO: Figure out why this is needed. */
	if (pathPtr->bytes == NULL) {
	    UpdateStringOfFsPath(pathPtr);
	}

	TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	if (tailLen) {
	    copy = AppendPath(dir, fsPathPtr->normPathPtr);
	} else {
	    copy = Tcl_DuplicateObj(dir);
	}
	Tcl_IncrRefCount(dir);
	Tcl_IncrRefCount(copy);







|







1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
	    return NULL;
	}
	/* TODO: Figure out why this is needed. */
	if (pathPtr->bytes == NULL) {
	    UpdateStringOfFsPath(pathPtr);
	}

	(void)TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	if (tailLen) {
	    copy = AppendPath(dir, fsPathPtr->normPathPtr);
	} else {
	    copy = Tcl_DuplicateObj(dir);
	}
	Tcl_IncrRefCount(dir);
	Tcl_IncrRefCount(copy);
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
	    }
	    FreeFsPathInternalRep(pathPtr);
	    if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
		return NULL;
	    }
	    fsPathPtr = PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    int cwdLen;
	    Tcl_Obj *copy;

	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);

	    (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
	    cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');








|







1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
	    }
	    FreeFsPathInternalRep(pathPtr);
	    if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
		return NULL;
	    }
	    fsPathPtr = PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    size_t cwdLen;
	    Tcl_Obj *copy;

	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);

	    (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
	    cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');

2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014

	/*
	 * Check if path is pure normalized (this can only be the case if it
	 * is an absolute path).
	 */

	if (pureNormalized) {
	    int normPathLen, pathLen;
	    const char *normPath;

	    path = TclGetStringFromObj(pathPtr, &pathLen);
	    normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen);
	    if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) {
		/*
		 * The path was already normalized. Get rid of the duplicate.







|







1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011

	/*
	 * Check if path is pure normalized (this can only be the case if it
	 * is an absolute path).
	 */

	if (pureNormalized) {
	    size_t normPathLen, pathLen;
	    const char *normPath;

	    path = TclGetStringFromObj(pathPtr, &pathLen);
	    normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen);
	    if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) {
		/*
		 * The path was already normalized. Get rid of the duplicate.
2265
2266
2267
2268
2269
2270
2271
2272

2273
2274
2275
2276
2277
2278
2279

int
Tcl_FSEqualPaths(
    Tcl_Obj *firstPtr,
    Tcl_Obj *secondPtr)
{
    const char *firstStr, *secondStr;
    int firstLen, secondLen, tempErrno;


    if (firstPtr == secondPtr) {
	return 1;
    }

    if (firstPtr == NULL || secondPtr == NULL) {
	return 0;







|
>







2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277

int
Tcl_FSEqualPaths(
    Tcl_Obj *firstPtr,
    Tcl_Obj *secondPtr)
{
    const char *firstStr, *secondStr;
    size_t firstLen, secondLen;
    int tempErrno;

    if (firstPtr == secondPtr) {
	return 1;
    }

    if (firstPtr == NULL || secondPtr == NULL) {
	return 0;
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
 */

static int
SetFsPathFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    int len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    char *name;

    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }







|







2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
 */

static int
SetFsPathFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    size_t len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    char *name;

    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369

    /*
     * Handle tilde substitutions, if needed.
     */

    if (name[0] == '~') {
	Tcl_DString temp;
	int split;
	char separator = '/';

	split = FindSplitPos(name, separator);
	if (split != len) {
	    /*
	     * We have multiple pieces '~user/foo/bar...'
	     */







|







2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367

    /*
     * Handle tilde substitutions, if needed.
     */

    if (name[0] == '~') {
	Tcl_DString temp;
	size_t split;
	char separator = '/';

	split = FindSplitPos(name, separator);
	if (split != len) {
	    /*
	     * We have multiple pieces '~user/foo/bar...'
	     */
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
    }

    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

    fsPathPtr = ckalloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = transPtr;
    if (transPtr != pathPtr) {
	Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
	/* Redo translation when $env(HOME) changes */
	fsPathPtr->filesystemEpoch = TclFSEpoch();
    } else {







|







2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
    }

    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

    fsPathPtr = Tcl_Alloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = transPtr;
    if (transPtr != pathPtr) {
	Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
	/* Redo translation when $env(HOME) changes */
	fsPathPtr->filesystemEpoch = TclFSEpoch();
    } else {
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549

	if (freeProc != NULL) {
	    freeProc(fsPathPtr->nativePathPtr);
	    fsPathPtr->nativePathPtr = NULL;
	}
    }

    ckfree(fsPathPtr);
    pathPtr->typePtr = NULL;
}

static void
DupFsPathInternalRep(
    Tcl_Obj *srcPtr,		/* Path obj with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Path obj with internal rep to set. */
{
    FsPath *srcFsPathPtr = PATHOBJ(srcPtr);
    FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath));

    SETPATHOBJ(copyPtr, copyFsPathPtr);

    if (srcFsPathPtr->translatedPathPtr == srcPtr) {
	/* Cycle in src -> make cycle in copy. */
	copyFsPathPtr->translatedPathPtr = copyPtr;
    } else {







|









|







2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547

	if (freeProc != NULL) {
	    freeProc(fsPathPtr->nativePathPtr);
	    fsPathPtr->nativePathPtr = NULL;
	}
    }

    Tcl_Free(fsPathPtr);
    pathPtr->typePtr = NULL;
}

static void
DupFsPathInternalRep(
    Tcl_Obj *srcPtr,		/* Path obj with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Path obj with internal rep to set. */
{
    FsPath *srcFsPathPtr = PATHOBJ(srcPtr);
    FsPath *copyFsPathPtr = Tcl_Alloc(sizeof(FsPath));

    SETPATHOBJ(copyPtr, copyFsPathPtr);

    if (srcFsPathPtr->translatedPathPtr == srcPtr) {
	/* Cycle in src -> make cycle in copy. */
	copyFsPathPtr->translatedPathPtr = copyPtr;
    } else {
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
 */

static void
UpdateStringOfFsPath(
    register Tcl_Obj *pathPtr)	/* path obj with string rep to update. */
{
    FsPath *fsPathPtr = PATHOBJ(pathPtr);
    int cwdLen;
    Tcl_Obj *copy;

    if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
	Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
    }

    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);







|







2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
 */

static void
UpdateStringOfFsPath(
    register Tcl_Obj *pathPtr)	/* path obj with string rep to update. */
{
    FsPath *fsPathPtr = PATHOBJ(pathPtr);
    size_t cwdLen;
    Tcl_Obj *copy;

    if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
	Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
    }

    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
    } else {
	/*
	 * It is somewhat unusual to reach this code path without the object
	 * being of tclFsPathType. However, we do our best to deal with the
	 * situation.
	 */

	int len;

	(void) TclGetStringFromObj(pathPtr, &len);
	if (len == 0) {
	    /*
	     * We reject the empty path "".
	     */








|







2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
    } else {
	/*
	 * It is somewhat unusual to reach this code path without the object
	 * being of tclFsPathType. However, we do our best to deal with the
	 * situation.
	 */

	size_t len;

	(void) TclGetStringFromObj(pathPtr, &len);
	if (len == 0) {
	    /*
	     * We reject the empty path "".
	     */

Changes to generic/tclPipe.c.
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    Tcl_Pid *pidPtr)		/* Array of pids to detach. */
{
    register Detached *detPtr;
    int i;

    Tcl_MutexLock(&pipeMutex);
    for (i = 0; i < numPids; i++) {
	detPtr = ckalloc(sizeof(Detached));
	detPtr->pid = pidPtr[i];
	detPtr->nextPtr = detList;
	detList = detPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);

}







|







184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    Tcl_Pid *pidPtr)		/* Array of pids to detach. */
{
    register Detached *detPtr;
    int i;

    Tcl_MutexLock(&pipeMutex);
    for (i = 0; i < numPids; i++) {
	detPtr = Tcl_Alloc(sizeof(Detached));
	detPtr->pid = pidPtr[i];
	detPtr->nextPtr = detList;
	detList = detPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);

}
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
	}
	nextPtr = detPtr->nextPtr;
	if (prevPtr == NULL) {
	    detList = detPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = detPtr->nextPtr;
	}
	ckfree(detPtr);
	detPtr = nextPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);
}

/*
 *----------------------------------------------------------------------







|







234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
	}
	nextPtr = detPtr->nextPtr;
	if (prevPtr == NULL) {
	    detList = detPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = detPtr->nextPtr;
	}
	Tcl_Free(detPtr);
	detPtr = nextPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);
}

/*
 *----------------------------------------------------------------------
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
	if (interp != NULL) {
	    int count;
	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);
	    objPtr = Tcl_NewObj();
	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
	    if (count < 0) {
		result = TCL_ERROR;
		Tcl_DecrRefCount(objPtr);
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading stderr output file: %s",
			Tcl_PosixError(interp)));
	    } else if (count > 0) {







|







332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
	if (interp != NULL) {
	    int count;
	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);
	    objPtr = Tcl_NewObj();
	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
	    if (count == -1) {
		result = TCL_ERROR;
		Tcl_DecrRefCount(objPtr);
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading stderr output file: %s",
			Tcl_PosixError(interp)));
	    } else if (count > 0) {
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834

    /*
     * Scan through the argc array, creating a process for each group of
     * arguments between the "|" characters.
     */

    Tcl_ReapDetachedProcs();
    pidPtr = ckalloc(cmdCount * sizeof(Tcl_Pid));

    curInFile = inputFile;

    for (i = 0; i < argc; i = lastArg + 1) {
	int result, joinThisError;
	Tcl_Pid pid;
	const char *oldName;







|







820
821
822
823
824
825
826
827
828
829
830
831
832
833
834

    /*
     * Scan through the argc array, creating a process for each group of
     * arguments between the "|" characters.
     */

    Tcl_ReapDetachedProcs();
    pidPtr = Tcl_Alloc(cmdCount * sizeof(Tcl_Pid));

    curInFile = inputFile;

    for (i = 0; i < argc; i = lastArg + 1) {
	int result, joinThisError;
	Tcl_Pid pid;
	const char *oldName;
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
    }
    if (pidPtr != NULL) {
	for (i = 0; i < numPids; i++) {
	    if (pidPtr[i] != (Tcl_Pid) -1) {
		Tcl_DetachPids(1, &pidPtr[i]);
	    }
	}
	ckfree(pidPtr);
    }
    numPids = -1;
    goto cleanup;
}

/*
 *----------------------------------------------------------------------







|







974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
    }
    if (pidPtr != NULL) {
	for (i = 0; i < numPids; i++) {
	    if (pidPtr[i] != (Tcl_Pid) -1) {
		Tcl_DetachPids(1, &pidPtr[i]);
	    }
	}
	Tcl_Free(pidPtr);
    }
    numPids = -1;
    goto cleanup;
}

/*
 *----------------------------------------------------------------------
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
	goto error;
    }
    return channel;

  error:
    if (numPids > 0) {
	Tcl_DetachPids(numPids, pidPtr);
	ckfree(pidPtr);
    }
    if (inPipe != NULL) {
	TclpCloseFile(inPipe);
    }
    if (outPipe != NULL) {
	TclpCloseFile(outPipe);
    }







|







1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
	goto error;
    }
    return channel;

  error:
    if (numPids > 0) {
	Tcl_DetachPids(numPids, pidPtr);
	Tcl_Free(pidPtr);
    }
    if (inPipe != NULL) {
	TclpCloseFile(inPipe);
    }
    if (outPipe != NULL) {
	TclpCloseFile(outPipe);
    }
Changes to generic/tclPkg.c.
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
static int		TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result);

/*
 * Helper macros.
 */

#define DupBlock(v,s,len) \
    ((v) = ckalloc(len), memcpy((v),(s),(len)))
#define DupString(v,s) \
    do { \
	size_t local__len = strlen(s) + 1; \
	DupBlock((v),(s),local__len); \
    } while (0)

/*







|







108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
static int		TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result);

/*
 * Helper macros.
 */

#define DupBlock(v,s,len) \
    ((v) = Tcl_Alloc(len), memcpy((v),(s),(len)))
#define DupString(v,s) \
    do { \
	size_t local__len = strlen(s) + 1; \
	DupBlock((v),(s),local__len); \
    } while (0)

/*
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
	return TCL_OK;
    }

    if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
	    NULL) != TCL_OK) {
	return TCL_ERROR;
    } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) {
	ckfree(pvi);
	return TCL_ERROR;
    }

    res = CompareVersions(pvi, vi, NULL);
    ckfree(pvi);
    ckfree(vi);

    if (res == 0) {
	if (clientData != NULL) {
	    pkgPtr->clientData = clientData;
	}
	return TCL_OK;
    }







|




|
|







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
	return TCL_OK;
    }

    if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
	    NULL) != TCL_OK) {
	return TCL_ERROR;
    } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) {
	Tcl_Free(pvi);
	return TCL_ERROR;
    }

    res = CompareVersions(pvi, vi, NULL);
    Tcl_Free(pvi);
    Tcl_Free(vi);

    if (res == 0) {
	if (clientData != NULL) {
	    pkgPtr->clientData = clientData;
	}
	return TCL_OK;
    }
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
    PkgFiles *pkgFiles = (PkgFiles *) clientData;
    Tcl_HashSearch search;
    Tcl_HashEntry *entry;

    while (pkgFiles->names) {
	PkgName *name = pkgFiles->names;
	pkgFiles->names = name->nextPtr;
	ckfree(name);
    }
    entry = Tcl_FirstHashEntry(&pkgFiles->table, &search);
    while (entry) {
	Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(entry);
	Tcl_DecrRefCount(obj);
	entry = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(&pkgFiles->table);
    ckfree(pkgFiles);
    return;
}

void *TclInitPkgFiles(Tcl_Interp *interp)
{
    /* If assocdata "tclPkgFiles" doesn't exist yet, create it */
    PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
    if (!pkgFiles) {
	pkgFiles = ckalloc(sizeof(PkgFiles));
	pkgFiles->names = NULL;
	Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles);
    }
    return pkgFiles;
}








|








|








|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
    PkgFiles *pkgFiles = (PkgFiles *) clientData;
    Tcl_HashSearch search;
    Tcl_HashEntry *entry;

    while (pkgFiles->names) {
	PkgName *name = pkgFiles->names;
	pkgFiles->names = name->nextPtr;
	Tcl_Free(name);
    }
    entry = Tcl_FirstHashEntry(&pkgFiles->table, &search);
    while (entry) {
	Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(entry);
	Tcl_DecrRefCount(obj);
	entry = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(&pkgFiles->table);
    Tcl_Free(pkgFiles);
    return;
}

void *TclInitPkgFiles(Tcl_Interp *interp)
{
    /* If assocdata "tclPkgFiles" doesn't exist yet, create it */
    PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
    if (!pkgFiles) {
	pkgFiles = Tcl_Alloc(sizeof(PkgFiles));
	pkgFiles->names = NULL;
	Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles);
    }
    return pkgFiles;
}

415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
    int reqc = PTR2INT(data[1]);
    Tcl_Obj *const *reqv = data[2];
    int code = CheckAllRequirements(interp, reqc, reqv);
    Require *reqPtr;
    if (code != TCL_OK) {
	return code;
    }
    reqPtr = ckalloc(sizeof(Require));
    Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL);
    reqPtr->clientDataPtr = data[3];
    reqPtr->name = name;
    reqPtr->pkgPtr = FindPackage(interp, name);
    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreStep1);
    } else {







|







415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
    int reqc = PTR2INT(data[1]);
    Tcl_Obj *const *reqv = data[2];
    int code = CheckAllRequirements(interp, reqc, reqv);
    Require *reqPtr;
    if (code != TCL_OK) {
	return code;
    }
    reqPtr = Tcl_Alloc(sizeof(Require));
    Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL);
    reqPtr->clientDataPtr = data[3];
    reqPtr->name = name;
    reqPtr->pkgPtr = FindPackage(interp, name);
    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreStep1);
    } else {
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
     * Ensure that the provided version meets the current requirements.
     */

    if (reqc != 0) {
	CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pkgVersionI, NULL);
	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);

	ckfree(pkgVersionI);

	if (!satisfies) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "version conflict for package \"%s\": have %s, need",
		    name, reqPtr->pkgPtr->version));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
		    NULL);







|







513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
     * Ensure that the provided version meets the current requirements.
     */

    if (reqc != 0) {
	CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pkgVersionI, NULL);
	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);

	Tcl_Free(pkgVersionI);

	if (!satisfies) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "version conflict for package \"%s\": have %s, need",
		    name, reqPtr->pkgPtr->version));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
		    NULL);
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(reqPtr->pkgPtr->version, -1));
    return TCL_OK;
}

static int
PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) {
    ckfree(data[0]);
    return result;
}


static int
SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
    PkgAvail *availPtr, *bestPtr, *bestStablePtr;







|







537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(reqPtr->pkgPtr->version, -1));
    return TCL_OK;
}

static int
PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) {
    Tcl_Free(data[0]);
    return result;
}


static int
SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
	    continue;
	}

	/* Check satisfaction of requirements before considering the current version further. */
	if (reqc > 0) {
	    satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
	    if (!satisfies) {
		ckfree(availVersion);
		availVersion = NULL;
		continue;
	    }
	}

	if (bestPtr != NULL) {
	    int res = CompareVersions(availVersion, bestVersion, NULL);

	    /*
	     * Note: Used internal reps in the comparison!
	     */

	    if (res > 0) {
		/*
		 * The version of the package sought is better than the
		 * currently selected version.
		 */
		ckfree(bestVersion);
		bestVersion = NULL;
		goto newbest;
	    }
	} else {
	newbest:
	    /* We have found a version which is better than our max. */

	    bestPtr = availPtr;
	    CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL);
	}

	if (!availStable) {
	    ckfree(availVersion);
	    availVersion = NULL;
	    continue;
	}

	if (bestStablePtr != NULL) {
	    int res = CompareVersions(availVersion, bestStableVersion, NULL);

	    /*
	     * Note: Used internal reps in the comparison!
	     */

	    if (res > 0) {
		/*
		 * This stable version of the package sought is better
		 * than the currently selected stable version.
		 */
		ckfree(bestStableVersion);
		bestStableVersion = NULL;
		goto newstable;
	    }
	} else {
	newstable:
	    /* We have found a stable version which is better than our max stable. */
	    bestStablePtr = availPtr;
	    CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL);
	}

	ckfree(availVersion);
	availVersion = NULL;
    } /* end for */

    /*
     * Clean up memorized internal reps, if any.
     */

    if (bestVersion != NULL) {
	ckfree(bestVersion);
	bestVersion = NULL;
    }

    if (bestStableVersion != NULL) {
	ckfree(bestStableVersion);
	bestStableVersion = NULL;
    }

    /*
     * Now choose a version among the two best. For 'latest' we simply
     * take (actually keep) the best. For 'stable' we take the best
     * stable, if there is any, or the best if there is nothing stable.







|

















|












|
















|










|








|




|







599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
	    continue;
	}

	/* Check satisfaction of requirements before considering the current version further. */
	if (reqc > 0) {
	    satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
	    if (!satisfies) {
		Tcl_Free(availVersion);
		availVersion = NULL;
		continue;
	    }
	}

	if (bestPtr != NULL) {
	    int res = CompareVersions(availVersion, bestVersion, NULL);

	    /*
	     * Note: Used internal reps in the comparison!
	     */

	    if (res > 0) {
		/*
		 * The version of the package sought is better than the
		 * currently selected version.
		 */
		Tcl_Free(bestVersion);
		bestVersion = NULL;
		goto newbest;
	    }
	} else {
	newbest:
	    /* We have found a version which is better than our max. */

	    bestPtr = availPtr;
	    CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL);
	}

	if (!availStable) {
	    Tcl_Free(availVersion);
	    availVersion = NULL;
	    continue;
	}

	if (bestStablePtr != NULL) {
	    int res = CompareVersions(availVersion, bestStableVersion, NULL);

	    /*
	     * Note: Used internal reps in the comparison!
	     */

	    if (res > 0) {
		/*
		 * This stable version of the package sought is better
		 * than the currently selected stable version.
		 */
		Tcl_Free(bestStableVersion);
		bestStableVersion = NULL;
		goto newstable;
	    }
	} else {
	newstable:
	    /* We have found a stable version which is better than our max stable. */
	    bestStablePtr = availPtr;
	    CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL);
	}

	Tcl_Free(availVersion);
	availVersion = NULL;
    } /* end for */

    /*
     * Clean up memorized internal reps, if any.
     */

    if (bestVersion != NULL) {
	Tcl_Free(bestVersion);
	bestVersion = NULL;
    }

    if (bestStableVersion != NULL) {
	Tcl_Free(bestStableVersion);
	bestStableVersion = NULL;
    }

    /*
     * Now choose a version among the two best. For 'latest' we simply
     * take (actually keep) the best. For 'stable' we take the best
     * stable, if there is any, or the best if there is nothing stable.
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
	PkgName *pkgName;

	Tcl_Preserve(versionToProvide);
	pkgPtr->clientData = versionToProvide;

	pkgFiles = TclInitPkgFiles(interp);
	/* Push "ifneeded" package name in "tclPkgFiles" assocdata. */
	pkgName = ckalloc(sizeof(PkgName) + strlen(name));
	pkgName->nextPtr = pkgFiles->names;
	strcpy(pkgName->name, name);
	pkgFiles->names = pkgName;
	if (bestPtr->pkgIndex) {
	    TclPkgFileSeen(interp, bestPtr->pkgIndex);
	}
	reqPtr->versionToProvide = versionToProvide;







|







706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
	PkgName *pkgName;

	Tcl_Preserve(versionToProvide);
	pkgPtr->clientData = versionToProvide;

	pkgFiles = TclInitPkgFiles(interp);
	/* Push "ifneeded" package name in "tclPkgFiles" assocdata. */
	pkgName = Tcl_Alloc(sizeof(PkgName) + strlen(name));
	pkgName->nextPtr = pkgFiles->names;
	strcpy(pkgName->name, name);
	pkgFiles->names = pkgName;
	if (bestPtr->pkgIndex) {
	    TclPkgFileSeen(interp, bestPtr->pkgIndex);
	}
	reqPtr->versionToProvide = versionToProvide;
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
    const char *name = reqPtr->name;
    char *versionToProvide = reqPtr->versionToProvide;

    /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/
    PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
    PkgName *pkgName = pkgFiles->names;
    pkgFiles->names = pkgName->nextPtr;
    ckfree(pkgName);

    reqPtr->pkgPtr = FindPackage(interp, name);
    if (result == TCL_OK) {
	Tcl_ResetResult(interp);
	if (reqPtr->pkgPtr->version == NULL) {
	    result = TCL_ERROR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "attempt to provide package %s %s failed:"
		    " no version of package %s provided",
		    name, versionToProvide, name));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
		    NULL);
	} else {
	    char *pvi, *vi;

	    if (CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pvi,
		    NULL) != TCL_OK) {
		result = TCL_ERROR;
	    } else if (CheckVersionAndConvert(interp,
		    versionToProvide, &vi, NULL) != TCL_OK) {
		ckfree(pvi);
		result = TCL_ERROR;
	    } else {
		int res = CompareVersions(pvi, vi, NULL);

		ckfree(pvi);
		ckfree(vi);
		if (res != 0) {
		    result = TCL_ERROR;
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "attempt to provide package %s %s failed:"
			    " package %s %s provided instead",
			    name, versionToProvide,
			    name, reqPtr->pkgPtr->version));







|




















|




|
|







732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
    const char *name = reqPtr->name;
    char *versionToProvide = reqPtr->versionToProvide;

    /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/
    PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
    PkgName *pkgName = pkgFiles->names;
    pkgFiles->names = pkgName->nextPtr;
    Tcl_Free(pkgName);

    reqPtr->pkgPtr = FindPackage(interp, name);
    if (result == TCL_OK) {
	Tcl_ResetResult(interp);
	if (reqPtr->pkgPtr->version == NULL) {
	    result = TCL_ERROR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "attempt to provide package %s %s failed:"
		    " no version of package %s provided",
		    name, versionToProvide, name));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
		    NULL);
	} else {
	    char *pvi, *vi;

	    if (CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pvi,
		    NULL) != TCL_OK) {
		result = TCL_ERROR;
	    } else if (CheckVersionAndConvert(interp,
		    versionToProvide, &vi, NULL) != TCL_OK) {
		Tcl_Free(pvi);
		result = TCL_ERROR;
	    } else {
		int res = CompareVersions(pvi, vi, NULL);

		Tcl_Free(pvi);
		Tcl_Free(vi);
		if (res != 0) {
		    result = TCL_ERROR;
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "attempt to provide package %s %s failed:"
			    " package %s %s provided instead",
			    name, versionToProvide,
			    name, reqPtr->pkgPtr->version));
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
	 * This is consistent with our returning NULL. If we're not
	 * willing to tell our caller we got a particular version, we
	 * shouldn't store that version for telling future callers
	 * either.
	 */

	if (reqPtr->pkgPtr->version != NULL) {
	    ckfree(reqPtr->pkgPtr->version);
	    reqPtr->pkgPtr->version = NULL;
	}
	reqPtr->pkgPtr->clientData = NULL;
	return result;
    }

    Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);







|







804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
	 * This is consistent with our returning NULL. If we're not
	 * willing to tell our caller we got a particular version, we
	 * shouldn't store that version for telling future callers
	 * either.
	 */

	if (reqPtr->pkgPtr->version != NULL) {
	    Tcl_Free(reqPtr->pkgPtr->version);
	    reqPtr->pkgPtr->version = NULL;
	}
	reqPtr->pkgPtr->clientData = NULL;
	return result;
    }

    Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
	    if (hPtr == NULL) {
		continue;
	    }
	    pkgPtr = Tcl_GetHashValue(hPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    if (pkgPtr->version != NULL) {
		ckfree(pkgPtr->version);
	    }
	    while (pkgPtr->availPtr != NULL) {
		availPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr->nextPtr;
		Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		ckfree(availPtr);
	    }
	    ckfree(pkgPtr);
	}
	break;
    }
    case PKG_IFNEEDED: {
	int length, res;
	char *argv3i, *avi;

	if ((objc != 4) && (objc != 5)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
	    return TCL_ERROR;
	}
	argv3 = TclGetString(objv[3]);
	if (CheckVersionAndConvert(interp, argv3, &argv3i, NULL) != TCL_OK) {
	    return TCL_ERROR;
	}
	argv2 = TclGetString(objv[2]);
	if (objc == 4) {
	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
	    if (hPtr == NULL) {
		ckfree(argv3i);
		return TCL_OK;
	    }
	    pkgPtr = Tcl_GetHashValue(hPtr);
	} else {
	    pkgPtr = FindPackage(interp, argv2);
	}
	argv3 = TclGetStringFromObj(objv[3], &length);

	for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
		prevPtr = availPtr, availPtr = availPtr->nextPtr) {
	    if (CheckVersionAndConvert(interp, availPtr->version, &avi,
		    NULL) != TCL_OK) {
		ckfree(argv3i);
		return TCL_ERROR;
	    }

	    res = CompareVersions(avi, argv3i, NULL);
	    ckfree(avi);

	    if (res == 0){
		if (objc == 4) {
		    ckfree(argv3i);
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj(availPtr->script, -1));
		    return TCL_OK;
		}
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		break;
	    }
	}
	ckfree(argv3i);

	if (objc == 4) {
	    return TCL_OK;
	}
	if (availPtr == NULL) {
	    availPtr = ckalloc(sizeof(PkgAvail));
	    availPtr->pkgIndex = NULL;
	    DupBlock(availPtr->version, argv3, (unsigned) length + 1);

	    if (prevPtr == NULL) {
		availPtr->nextPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr;
	    } else {







|










|

|



















|












|




|



|












|





|







991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
	    if (hPtr == NULL) {
		continue;
	    }
	    pkgPtr = Tcl_GetHashValue(hPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    if (pkgPtr->version != NULL) {
		Tcl_Free(pkgPtr->version);
	    }
	    while (pkgPtr->availPtr != NULL) {
		availPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr->nextPtr;
		Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		Tcl_Free(availPtr);
	    }
	    Tcl_Free(pkgPtr);
	}
	break;
    }
    case PKG_IFNEEDED: {
	int length, res;
	char *argv3i, *avi;

	if ((objc != 4) && (objc != 5)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
	    return TCL_ERROR;
	}
	argv3 = TclGetString(objv[3]);
	if (CheckVersionAndConvert(interp, argv3, &argv3i, NULL) != TCL_OK) {
	    return TCL_ERROR;
	}
	argv2 = TclGetString(objv[2]);
	if (objc == 4) {
	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
	    if (hPtr == NULL) {
		Tcl_Free(argv3i);
		return TCL_OK;
	    }
	    pkgPtr = Tcl_GetHashValue(hPtr);
	} else {
	    pkgPtr = FindPackage(interp, argv2);
	}
	argv3 = TclGetStringFromObj(objv[3], &length);

	for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
		prevPtr = availPtr, availPtr = availPtr->nextPtr) {
	    if (CheckVersionAndConvert(interp, availPtr->version, &avi,
		    NULL) != TCL_OK) {
		Tcl_Free(argv3i);
		return TCL_ERROR;
	    }

	    res = CompareVersions(avi, argv3i, NULL);
	    Tcl_Free(avi);

	    if (res == 0){
		if (objc == 4) {
		    Tcl_Free(argv3i);
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj(availPtr->script, -1));
		    return TCL_OK;
		}
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		break;
	    }
	}
	Tcl_Free(argv3i);

	if (objc == 4) {
	    return TCL_OK;
	}
	if (availPtr == NULL) {
	    availPtr = Tcl_Alloc(sizeof(PkgAvail));
	    availPtr->pkgIndex = NULL;
	    DupBlock(availPtr->version, argv3, (unsigned) length + 1);

	    if (prevPtr == NULL) {
		availPtr->nextPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr;
	    } else {
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
	if (objc == 2) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(iPtr->packageUnknown, -1));
	    }
	} else if (objc == 3) {
	    if (iPtr->packageUnknown != NULL) {
		ckfree(iPtr->packageUnknown);
	    }
	    argv2 = TclGetStringFromObj(objv[2], &length);
	    if (argv2[0] == 0) {
		iPtr->packageUnknown = NULL;
	    } else {
		DupBlock(iPtr->packageUnknown, argv2, (unsigned) length+1);
	    }







|







1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
	if (objc == 2) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(iPtr->packageUnknown, -1));
	    }
	} else if (objc == 3) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_Free(iPtr->packageUnknown);
	    }
	    argv2 = TclGetStringFromObj(objv[2], &length);
	    if (argv2[0] == 0) {
		iPtr->packageUnknown = NULL;
	    } else {
		DupBlock(iPtr->packageUnknown, argv2, (unsigned) length+1);
	    }
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
	    return TCL_ERROR;
	}
	argv3 = TclGetString(objv[3]);
	argv2 = TclGetString(objv[2]);
	if (CheckVersionAndConvert(interp, argv2, &iva, NULL) != TCL_OK ||
		CheckVersionAndConvert(interp, argv3, &ivb, NULL) != TCL_OK) {
	    if (iva != NULL) {
		ckfree(iva);
	    }

	    /*
	     * ivb cannot be set in this branch.
	     */

	    return TCL_ERROR;
	}

	/*
	 * Comparison is done on the internal representation.
	 */

	Tcl_SetObjResult(interp,
		Tcl_NewIntObj(CompareVersions(iva, ivb, NULL)));
	ckfree(iva);
	ckfree(ivb);
	break;
    case PKG_VERSIONS:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package");
	    return TCL_ERROR;
	} else {
	    Tcl_Obj *resultObj = Tcl_NewObj();







|















|
|







1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
	    return TCL_ERROR;
	}
	argv3 = TclGetString(objv[3]);
	argv2 = TclGetString(objv[2]);
	if (CheckVersionAndConvert(interp, argv2, &iva, NULL) != TCL_OK ||
		CheckVersionAndConvert(interp, argv3, &ivb, NULL) != TCL_OK) {
	    if (iva != NULL) {
		Tcl_Free(iva);
	    }

	    /*
	     * ivb cannot be set in this branch.
	     */

	    return TCL_ERROR;
	}

	/*
	 * Comparison is done on the internal representation.
	 */

	Tcl_SetObjResult(interp,
		Tcl_NewIntObj(CompareVersions(iva, ivb, NULL)));
	Tcl_Free(iva);
	Tcl_Free(ivb);
	break;
    case PKG_VERSIONS:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package");
	    return TCL_ERROR;
	} else {
	    Tcl_Obj *resultObj = Tcl_NewObj();
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
	    return TCL_ERROR;
	}

	argv2 = TclGetString(objv[2]);
	if (CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK) {
	    return TCL_ERROR;
	} else if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
	    ckfree(argv2i);
	    return TCL_ERROR;
	}

	satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3);
	ckfree(argv2i);

	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies));
	break;
    }
    default:
	Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
    }







|




|







1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
	    return TCL_ERROR;
	}

	argv2 = TclGetString(objv[2]);
	if (CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK) {
	    return TCL_ERROR;
	} else if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
	    Tcl_Free(argv2i);
	    return TCL_ERROR;
	}

	satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3);
	Tcl_Free(argv2i);

	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies));
	break;
    }
    default:
	Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
    }
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    int isNew;
    Package *pkgPtr;

    hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew);
    if (isNew) {
	pkgPtr = ckalloc(sizeof(Package));
	pkgPtr->version = NULL;
	pkgPtr->availPtr = NULL;
	pkgPtr->clientData = NULL;
	Tcl_SetHashValue(hPtr, pkgPtr);
    } else {
	pkgPtr = Tcl_GetHashValue(hPtr);
    }







|







1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    int isNew;
    Package *pkgPtr;

    hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew);
    if (isNew) {
	pkgPtr = Tcl_Alloc(sizeof(Package));
	pkgPtr->version = NULL;
	pkgPtr->availPtr = NULL;
	pkgPtr->clientData = NULL;
	Tcl_SetHashValue(hPtr, pkgPtr);
    } else {
	pkgPtr = Tcl_GetHashValue(hPtr);
    }
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
    Tcl_HashEntry *hPtr;
    PkgAvail *availPtr;

    for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	pkgPtr = Tcl_GetHashValue(hPtr);
	if (pkgPtr->version != NULL) {
	    ckfree(pkgPtr->version);
	}
	while (pkgPtr->availPtr != NULL) {
	    availPtr = pkgPtr->availPtr;
	    pkgPtr->availPtr = availPtr->nextPtr;
	    Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
	    Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
	    if (availPtr->pkgIndex) {
		Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		availPtr->pkgIndex = NULL;
	    }
	    ckfree(availPtr);
	}
	ckfree(pkgPtr);
    }
    Tcl_DeleteHashTable(&iPtr->packageTable);
    if (iPtr->packageUnknown != NULL) {
	ckfree(iPtr->packageUnknown);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * CheckVersionAndConvert --







|










|

|



|







1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
    Tcl_HashEntry *hPtr;
    PkgAvail *availPtr;

    for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	pkgPtr = Tcl_GetHashValue(hPtr);
	if (pkgPtr->version != NULL) {
	    Tcl_Free(pkgPtr->version);
	}
	while (pkgPtr->availPtr != NULL) {
	    availPtr = pkgPtr->availPtr;
	    pkgPtr->availPtr = availPtr->nextPtr;
	    Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
	    Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
	    if (availPtr->pkgIndex) {
		Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		availPtr->pkgIndex = NULL;
	    }
	    Tcl_Free(availPtr);
	}
	Tcl_Free(pkgPtr);
    }
    Tcl_DeleteHashTable(&iPtr->packageTable);
    if (iPtr->packageUnknown != NULL) {
	Tcl_Free(iPtr->packageUnknown);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * CheckVersionAndConvert --
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
    const char *p = string;
    char prevChar;
    int hasunstable = 0;
    /*
     * 4* assuming that each char is a separator (a,b become ' -x ').
     * 4+ to have spce for an additional -2 at the end
     */
    char *ibuf = ckalloc(4 + 4*strlen(string));
    char *ip = ibuf;

    /*
     * Basic rules
     * (1) First character has to be a digit.
     * (2) All other characters have to be a digit or '.'
     * (3) Two '.'s may not follow each other.







|







1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
    const char *p = string;
    char prevChar;
    int hasunstable = 0;
    /*
     * 4* assuming that each char is a separator (a,b become ' -x ').
     * 4+ to have spce for an additional -2 at the end
     */
    char *ibuf = Tcl_Alloc(4 + 4*strlen(string));
    char *ip = ibuf;

    /*
     * Basic rules
     * (1) First character has to be a digit.
     * (2) All other characters have to be a digit or '.'
     * (3) Two '.'s may not follow each other.
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
	prevChar = *p;
    }
    if (prevChar!='.' && prevChar!='a' && prevChar!='b') {
	*ip = '\0';
	if (internal != NULL) {
	    *internal = ibuf;
	} else {
	    ckfree(ibuf);
	}
	if (stable != NULL) {
	    *stable = !hasunstable;
	}
	return TCL_OK;
    }

  error:
    ckfree(ibuf);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "expected version number but got \"%s\"", string));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
    return TCL_ERROR;
}

/*







|








|







1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
	prevChar = *p;
    }
    if (prevChar!='.' && prevChar!='a' && prevChar!='b') {
	*ip = '\0';
	if (internal != NULL) {
	    *internal = ibuf;
	} else {
	    Tcl_Free(ibuf);
	}
	if (stable != NULL) {
	    *stable = !hasunstable;
	}
	return TCL_OK;
    }

  error:
    Tcl_Free(ibuf);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "expected version number but got \"%s\"", string));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
    return TCL_ERROR;
}

/*
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
	return TCL_ERROR;
    }

    /*
     * Exactly one dash is present. Copy the string, split at the location of
     * dash and check that both parts are versions. Note that the max part can
     * be empty. Also note that the string allocated with strdup() must be
     * freed with free() and not ckfree().
     */

    DupString(buf, string);
    dash = buf + (dash - string);
    *dash = '\0';		/* buf now <=> min part */
    dash++;			/* dash now <=> max part */

    if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) ||
	    ((*dash != '\0') &&
	    (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) {
	ckfree(buf);
	return TCL_ERROR;
    }

    ckfree(buf);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AddRequirementsToResult --







|










|



|







1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
	return TCL_ERROR;
    }

    /*
     * Exactly one dash is present. Copy the string, split at the location of
     * dash and check that both parts are versions. Note that the max part can
     * be empty. Also note that the string allocated with strdup() must be
     * freed with free() and not Tcl_Free().
     */

    DupString(buf, string);
    dash = buf + (dash - string);
    *dash = '\0';		/* buf now <=> min part */
    dash++;			/* dash now <=> max part */

    if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) ||
	    ((*dash != '\0') &&
	    (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) {
	Tcl_Free(buf);
	return TCL_ERROR;
    }

    Tcl_Free(buf);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AddRequirementsToResult --
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
	char *reqi = NULL;
	int thisIsMajor;

	CheckVersionAndConvert(NULL, req, &reqi, NULL);
	strcat(reqi, " -2");
	res = CompareVersions(havei, reqi, &thisIsMajor);
	satisfied = (res == 0) || ((res == 1) && !thisIsMajor);
	ckfree(reqi);
	return satisfied;
    }

    /*
     * Exactly one dash is present (Assumption of valid syntax). Copy the req,
     * split at the location of dash and check that both parts are versions.
     * Note that the max part can be empty.







|







2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
	char *reqi = NULL;
	int thisIsMajor;

	CheckVersionAndConvert(NULL, req, &reqi, NULL);
	strcat(reqi, " -2");
	res = CompareVersions(havei, reqi, &thisIsMajor);
	satisfied = (res == 0) || ((res == 1) && !thisIsMajor);
	Tcl_Free(reqi);
	return satisfied;
    }

    /*
     * Exactly one dash is present (Assumption of valid syntax). Copy the req,
     * split at the location of dash and check that both parts are versions.
     * Note that the max part can be empty.
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
	 * We have a min, but no max. For the comparison we generate the
	 * internal rep, padded with 'a0' i.e. '-2'.
	 */

	CheckVersionAndConvert(NULL, buf, &min, NULL);
	strcat(min, " -2");
	satisfied = (CompareVersions(havei, min, NULL) >= 0);
	ckfree(min);
	ckfree(buf);
	return satisfied;
    }

    /*
     * We have both min and max, and generate their internal reps. When
     * identical we compare as is, otherwise we pad with 'a0' to ove the range
     * a bit.







|
|







2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
	 * We have a min, but no max. For the comparison we generate the
	 * internal rep, padded with 'a0' i.e. '-2'.
	 */

	CheckVersionAndConvert(NULL, buf, &min, NULL);
	strcat(min, " -2");
	satisfied = (CompareVersions(havei, min, NULL) >= 0);
	Tcl_Free(min);
	Tcl_Free(buf);
	return satisfied;
    }

    /*
     * We have both min and max, and generate their internal reps. When
     * identical we compare as is, otherwise we pad with 'a0' to ove the range
     * a bit.
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
    } else {
	strcat(min, " -2");
	strcat(max, " -2");
	satisfied = ((CompareVersions(min, havei, NULL) <= 0) &&
		(CompareVersions(havei, max, NULL) < 0));
    }

    ckfree(min);
    ckfree(max);
    ckfree(buf);
    return satisfied;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PkgInitStubsCheck --







|
|
|







2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
    } else {
	strcat(min, " -2");
	strcat(max, " -2");
	satisfied = ((CompareVersions(min, havei, NULL) <= 0) &&
		(CompareVersions(havei, max, NULL) < 0));
    }

    Tcl_Free(min);
    Tcl_Free(max);
    Tcl_Free(buf);
    return satisfied;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PkgInitStubsCheck --
Changes to generic/tclPkgConfig.c.
101
102
103
104
105
106
107


108
109
110
111
112
113
114
    /* Runtime paths to various stuff */

    {"libdir,runtime",		CFG_RUNTIME_LIBDIR},
    {"bindir,runtime",		CFG_RUNTIME_BINDIR},
    {"scriptdir,runtime",	CFG_RUNTIME_SCRDIR},
    {"includedir,runtime",	CFG_RUNTIME_INCDIR},
    {"docdir,runtime",		CFG_RUNTIME_DOCDIR},



    /* Installation paths to various stuff */

    {"libdir,install",		CFG_INSTALL_LIBDIR},
    {"bindir,install",		CFG_INSTALL_BINDIR},
    {"scriptdir,install",	CFG_INSTALL_SCRDIR},
    {"includedir,install",	CFG_INSTALL_INCDIR},







>
>







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
    /* Runtime paths to various stuff */

    {"libdir,runtime",		CFG_RUNTIME_LIBDIR},
    {"bindir,runtime",		CFG_RUNTIME_BINDIR},
    {"scriptdir,runtime",	CFG_RUNTIME_SCRDIR},
    {"includedir,runtime",	CFG_RUNTIME_INCDIR},
    {"docdir,runtime",		CFG_RUNTIME_DOCDIR},
    {"dllfile,runtime",		CFG_RUNTIME_DLLFILE},
    {"zipfile,runtime",		CFG_RUNTIME_ZIPFILE},

    /* Installation paths to various stuff */

    {"libdir,install",		CFG_INSTALL_LIBDIR},
    {"bindir,install",		CFG_INSTALL_BINDIR},
    {"scriptdir,install",	CFG_INSTALL_SCRDIR},
    {"includedir,install",	CFG_INSTALL_INCDIR},
Changes to generic/tclPlatDecls.h.
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

/*
 * Exported function declarations:
 */

#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
TCLAPI TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
				Tcl_DString *dsPtr);
/* 1 */
TCLAPI char *		Tcl_WinTCharToUtf(const TCHAR *str, int len,
				Tcl_DString *dsPtr);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
TCLAPI int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
				const char *bundleName, int hasResourceFile,
				int maxPathLen, char *libraryPath);
/* 1 */
TCLAPI int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, int maxPathLen,
				char *libraryPath);
#endif /* MACOSX */

typedef struct TclPlatStubs {
    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 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
#endif /* MACOSX */
} TclPlatStubs;

extern const TclPlatStubs *tclPlatStubsPtr;

#ifdef __cplusplus
}







|


|






|




|








|
|


|
|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

/*
 * Exported function declarations:
 */

#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
TCLAPI TCHAR *		Tcl_WinUtfToTChar(const char *str, size_t len,
				Tcl_DString *dsPtr);
/* 1 */
TCLAPI char *		Tcl_WinTCharToUtf(const TCHAR *str, size_t len,
				Tcl_DString *dsPtr);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
TCLAPI int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
				const char *bundleName, int hasResourceFile,
				size_t maxPathLen, char *libraryPath);
/* 1 */
TCLAPI int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, size_t maxPathLen,
				char *libraryPath);
#endif /* MACOSX */

typedef struct TclPlatStubs {
    int magic;
    void *hooks;

#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    TCHAR * (*tcl_WinUtfToTChar) (const char *str, size_t len, Tcl_DString *dsPtr); /* 0 */
    char * (*tcl_WinTCharToUtf) (const TCHAR *str, size_t len, Tcl_DString *dsPtr); /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 0 */
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 1 */
#endif /* MACOSX */
} TclPlatStubs;

extern const TclPlatStubs *tclPlatStubsPtr;

#ifdef __cplusplus
}
Changes to generic/tclPort.h.
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#if defined(_WIN32)
#   include "tclWinPort.h"
#else
#   include "tclUnixPort.h"
#endif
#include "tcl.h"

#if !defined(LLONG_MIN)
#   ifdef TCL_WIDE_INT_IS_LONG
#      define LLONG_MIN LONG_MIN
#   else
#      ifdef LLONG_BIT
#         define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1)))
#      else
/* Assume we're on a system with a 64-bit 'long long' type */
#         define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63))
#      endif
#   endif
/* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */
#   define LLONG_MAX (~LLONG_MIN)
#endif


#endif /* _TCLPORT */







|
<
<
<
<
<
<
<
|
<
<
<
<
<
|


20
21
22
23
24
25
26
27







28





29
30
31
#if defined(_WIN32)
#   include "tclWinPort.h"
#else
#   include "tclUnixPort.h"
#endif
#include "tcl.h"

#define UWIDE_MAX ((Tcl_WideUInt)-1)







#define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1))





#define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1))

#endif /* _TCLPORT */
Changes to generic/tclPreserve.c.
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

/*
 * Global data structures used to hold the list of preserved data references.
 * These variables are protected by "preserveMutex".
 */

static Reference *refArray = NULL;	/* First in array of references. */
static int spaceAvl = 0;	/* Total number of structures available at
				 * *firstRefPtr. */
static int inUse = 0;		/* Count of structures currently in use in
				 * refArray. */
TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */

#define INITIAL_SIZE	2	/* Initial number of reference slots to make */

/*
 * The following data structure is used to keep track of whether an arbitrary







|

|







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

/*
 * Global data structures used to hold the list of preserved data references.
 * These variables are protected by "preserveMutex".
 */

static Reference *refArray = NULL;	/* First in array of references. */
static size_t spaceAvl = 0;	/* Total number of structures available at
				 * *firstRefPtr. */
static size_t inUse = 0;		/* Count of structures currently in use in
				 * refArray. */
TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */

#define INITIAL_SIZE	2	/* Initial number of reference slots to make */

/*
 * The following data structure is used to keep track of whether an arbitrary
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99

	/* ARGSUSED */
void
TclFinalizePreserve(void)
{
    Tcl_MutexLock(&preserveMutex);
    if (spaceAvl != 0) {
	ckfree(refArray);
	refArray = NULL;
	inUse = 0;
	spaceAvl = 0;
    }
    Tcl_MutexUnlock(&preserveMutex);
}








|







85
86
87
88
89
90
91
92
93
94
95
96
97
98
99

	/* ARGSUSED */
void
TclFinalizePreserve(void)
{
    Tcl_MutexLock(&preserveMutex);
    if (spaceAvl != 0) {
	Tcl_Free(refArray);
	refArray = NULL;
	inUse = 0;
	spaceAvl = 0;
    }
    Tcl_MutexUnlock(&preserveMutex);
}

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
 */

void
Tcl_Preserve(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    int i;

    /*
     * See if there is already a reference for this pointer. If so, just
     * increment its reference count.
     */

    Tcl_MutexLock(&preserveMutex);







|







117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
 */

void
Tcl_Preserve(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    size_t i;

    /*
     * See if there is already a reference for this pointer. If so, just
     * increment its reference count.
     */

    Tcl_MutexLock(&preserveMutex);
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
    /*
     * Make a reference array if it doesn't already exist, or make it bigger
     * if it is full.
     */

    if (inUse == spaceAvl) {
	spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE;
	refArray = ckrealloc(refArray, spaceAvl * sizeof(Reference));
    }

    /*
     * Make a new entry for the new reference.
     */

    refPtr = &refArray[inUse];







|







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
    /*
     * Make a reference array if it doesn't already exist, or make it bigger
     * if it is full.
     */

    if (inUse == spaceAvl) {
	spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE;
	refArray = Tcl_Realloc(refArray, spaceAvl * sizeof(Reference));
    }

    /*
     * Make a new entry for the new reference.
     */

    refPtr = &refArray[inUse];
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
 */

void
Tcl_Release(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    int i;

    Tcl_MutexLock(&preserveMutex);
    for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) {
	int mustFree;
	Tcl_FreeProc *freeProc;

	if (refPtr->clientData != clientData) {







|







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
 */

void
Tcl_Release(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    size_t i;

    Tcl_MutexLock(&preserveMutex);
    for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) {
	int mustFree;
	Tcl_FreeProc *freeProc;

	if (refPtr->clientData != clientData) {
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
	 * Only then should we dabble around with potentially-slow memory
	 * managers...
	 */

	Tcl_MutexUnlock(&preserveMutex);
	if (mustFree) {
	    if (freeProc == TCL_DYNAMIC) {
		ckfree(clientData);
	    } else {
		freeProc(clientData);
	    }
	}
	return;
    }
    Tcl_MutexUnlock(&preserveMutex);







|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
	 * Only then should we dabble around with potentially-slow memory
	 * managers...
	 */

	Tcl_MutexUnlock(&preserveMutex);
	if (mustFree) {
	    if (freeProc == TCL_DYNAMIC) {
		Tcl_Free(clientData);
	    } else {
		freeProc(clientData);
	    }
	}
	return;
    }
    Tcl_MutexUnlock(&preserveMutex);
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274

void
Tcl_EventuallyFree(
    ClientData clientData,	/* Pointer to malloc'ed block of memory. */
    Tcl_FreeProc *freeProc)	/* Function to actually do free. */
{
    Reference *refPtr;
    int i;

    /*
     * See if there is a reference for this pointer. If so, set its "mustFree"
     * flag (the flag had better not be set already!).
     */

    Tcl_MutexLock(&preserveMutex);







|







260
261
262
263
264
265
266
267
268
269
270
271
272
273
274

void
Tcl_EventuallyFree(
    ClientData clientData,	/* Pointer to malloc'ed block of memory. */
    Tcl_FreeProc *freeProc)	/* Function to actually do free. */
{
    Reference *refPtr;
    size_t i;

    /*
     * See if there is a reference for this pointer. If so, set its "mustFree"
     * flag (the flag had better not be set already!).
     */

    Tcl_MutexLock(&preserveMutex);
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
    Tcl_MutexUnlock(&preserveMutex);

    /*
     * No reference for this block.  Free it now.
     */

    if (freeProc == TCL_DYNAMIC) {
	ckfree(clientData);
    } else {
	freeProc(clientData);
    }
}

/*
 *---------------------------------------------------------------------------







|







287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
    Tcl_MutexUnlock(&preserveMutex);

    /*
     * No reference for this block.  Free it now.
     */

    if (freeProc == TCL_DYNAMIC) {
	Tcl_Free(clientData);
    } else {
	freeProc(clientData);
    }
}

/*
 *---------------------------------------------------------------------------
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337

TclHandle
TclHandleCreate(
    void *ptr)			/* Pointer to an arbitrary block of memory to
				 * be tracked for deletion. Must not be
				 * NULL. */
{
    HandleStruct *handlePtr = ckalloc(sizeof(HandleStruct));

    handlePtr->ptr = ptr;
#ifdef TCL_MEM_DEBUG
    handlePtr->ptr2 = ptr;
#endif
    handlePtr->refCount = 0;
    return (TclHandle) handlePtr;







|







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337

TclHandle
TclHandleCreate(
    void *ptr)			/* Pointer to an arbitrary block of memory to
				 * be tracked for deletion. Must not be
				 * NULL. */
{
    HandleStruct *handlePtr = Tcl_Alloc(sizeof(HandleStruct));

    handlePtr->ptr = ptr;
#ifdef TCL_MEM_DEBUG
    handlePtr->ptr2 = ptr;
#endif
    handlePtr->refCount = 0;
    return (TclHandle) handlePtr;
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
    if (handlePtr->ptr2 != handlePtr->ptr) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    handlePtr->ptr = NULL;
    if (handlePtr->refCount == 0) {
	ckfree(handlePtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclHandlePreserve --







|







373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
    if (handlePtr->ptr2 != handlePtr->ptr) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    handlePtr->ptr = NULL;
    if (handlePtr->refCount == 0) {
	Tcl_Free(handlePtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclHandlePreserve --
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
    }
    if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) {
	ckfree(handlePtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|










456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
    }
    if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) {
	Tcl_Free(handlePtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclProc.c.
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
	     * proc body was not created by substitution.
	     */

	    if (contextPtr->line
		    && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
		int isNew;
		Tcl_HashEntry *hePtr;
		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		cfPtr->line = ckalloc(sizeof(int));
		cfPtr->line[0] = contextPtr->line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);







|



|







224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
	     * proc body was not created by substitution.
	     */

	    if (contextPtr->line
		    && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
		int isNew;
		Tcl_HashEntry *hePtr;
		CmdFrame *cfPtr = Tcl_Alloc(sizeof(CmdFrame));

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		cfPtr->line = Tcl_Alloc(sizeof(int));
		cfPtr->line[0] = contextPtr->line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272

		    CmdFrame *cfOldPtr = Tcl_GetHashValue(hePtr);

		    if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
			Tcl_DecrRefCount(cfOldPtr->data.eval.path);
			cfOldPtr->data.eval.path = NULL;
		    }
		    ckfree(cfOldPtr->line);
		    cfOldPtr->line = NULL;
		    ckfree(cfOldPtr);
		}
		Tcl_SetHashValue(hePtr, cfPtr);
	    }

	    /*
	     * 'contextPtr' is going out of scope; account for the reference
	     * that it's holding to the path name.







|

|







256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272

		    CmdFrame *cfOldPtr = Tcl_GetHashValue(hePtr);

		    if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
			Tcl_DecrRefCount(cfOldPtr->data.eval.path);
			cfOldPtr->data.eval.path = NULL;
		    }
		    Tcl_Free(cfOldPtr->line);
		    cfOldPtr->line = NULL;
		    Tcl_Free(cfOldPtr);
		}
		Tcl_SetHashValue(hePtr, cfPtr);
	    }

	    /*
	     * 'contextPtr' is going out of scope; account for the reference
	     * that it's holding to the path name.
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322

323
324
325
326
327
328
329
    procArgs = TclGetString(objv[2]);

    while (*procArgs == ' ') {
	procArgs++;
    }

    if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
	int numBytes;

	procArgs +=4;
	while (*procArgs != '\0') {
	    if (*procArgs != ' ') {
		goto done;
	    }
	    procArgs++;
	}

	/*
	 * The argument list is just "args"; check the body
	 */

	procBody = TclGetStringFromObj(objv[3], &numBytes);

	if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) {
	    goto done;
	}

	/*
	 * The body is just spaces: link the compileProc
	 */







|













|
>







301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
    procArgs = TclGetString(objv[2]);

    while (*procArgs == ' ') {
	procArgs++;
    }

    if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
	size_t numBytes;

	procArgs +=4;
	while (*procArgs != '\0') {
	    if (*procArgs != ' ') {
		goto done;
	    }
	    procArgs++;
	}

	/*
	 * The argument list is just "args"; check the body
	 */

	procBody = TclGetString(objv[3]);
	numBytes = objv[3]->length;
	if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) {
	    goto done;
	}

	/*
	 * The body is just spaces: link the compileProc
	 */
367
368
369
370
371
372
373
374

375
376
377
378
379
380
381
    Tcl_Obj *argsPtr,		/* Description of arguments. */
    Tcl_Obj *bodyPtr,		/* Command body. */
    Proc **procPtrPtr)		/* Returns: pointer to proc data. */
{
    Interp *iPtr = (Interp *) interp;

    register Proc *procPtr;
    int i, result, numArgs, plen;

    const char *bytes, *argname, *argnamei;
    char argnamelast;
    register CompiledLocal *localPtr = NULL;
    Tcl_Obj *defPtr, *errorObj, **argArray;
    int precompiled = 0;

    if (bodyPtr->typePtr == &tclProcBodyType) {







|
>







368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
    Tcl_Obj *argsPtr,		/* Description of arguments. */
    Tcl_Obj *bodyPtr,		/* Command body. */
    Proc **procPtrPtr)		/* Returns: pointer to proc data. */
{
    Interp *iPtr = (Interp *) interp;

    register Proc *procPtr;
    int i, result, numArgs;
    size_t plen;
    const char *bytes, *argname, *argnamei;
    char argnamelast;
    register CompiledLocal *localPtr = NULL;
    Tcl_Obj *defPtr, *errorObj, **argArray;
    int precompiled = 0;

    if (bodyPtr->typePtr == &tclProcBodyType) {
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
	 * means that the same code can not be shared by two procedures that
	 * have a different number of arguments, even if their bodies are
	 * identical. Note that we don't use Tcl_DuplicateObj since we would
	 * not want any bytecode internal representation.
	 */

	if (Tcl_IsShared(bodyPtr)) {
	    int length;
	    Tcl_Obj *sharedBodyPtr = bodyPtr;

	    bytes = TclGetStringFromObj(bodyPtr, &length);
	    bodyPtr = Tcl_NewStringObj(bytes, length);

	    /*
	     * TIP #280.







|







410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
	 * means that the same code can not be shared by two procedures that
	 * have a different number of arguments, even if their bodies are
	 * identical. Note that we don't use Tcl_DuplicateObj since we would
	 * not want any bytecode internal representation.
	 */

	if (Tcl_IsShared(bodyPtr)) {
	    size_t length;
	    Tcl_Obj *sharedBodyPtr = bodyPtr;

	    bytes = TclGetStringFromObj(bodyPtr, &length);
	    bodyPtr = Tcl_NewStringObj(bytes, length);

	    /*
	     * TIP #280.
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
	 * Create and initialize a Proc structure for the procedure. We
	 * increment the ref count of the procedure's body object since there
	 * will be a reference to it in the Proc structure.
	 */

	Tcl_IncrRefCount(bodyPtr);

	procPtr = ckalloc(sizeof(Proc));
	procPtr->iPtr = iPtr;
	procPtr->refCount = 1;
	procPtr->bodyPtr = bodyPtr;
	procPtr->numArgs = 0;	/* Actual argument count is set below. */
	procPtr->numCompiledLocals = 0;
	procPtr->firstLocalPtr = NULL;
	procPtr->lastLocalPtr = NULL;







|







433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
	 * Create and initialize a Proc structure for the procedure. We
	 * increment the ref count of the procedure's body object since there
	 * will be a reference to it in the Proc structure.
	 */

	Tcl_IncrRefCount(bodyPtr);

	procPtr = Tcl_Alloc(sizeof(Proc));
	procPtr->iPtr = iPtr;
	procPtr->refCount = 1;
	procPtr->bodyPtr = bodyPtr;
	procPtr->numArgs = 0;	/* Actual argument count is set below. */
	procPtr->numCompiledLocals = 0;
	procPtr->firstLocalPtr = NULL;
	procPtr->lastLocalPtr = NULL;
501
502
503
504
505
506
507

508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}


	nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length);
	if (fieldCount == 2) {
	    valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]),
		fieldValues[1]->length);
	} else {
	    valueLength = 0;
	}

	/*
	 * Check that the formal parameter name is a scalar.
	 */

	argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
	argnamei = argname;
	argnamelast = argname[plen-1];
	while (plen--) {
	    if (argnamei[0] == '(') {
		if (argnamelast == ')') {	/* We have an array element. */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "formal parameter \"%s\" is an array element",







>
|

|
|








<







503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522

523
524
525
526
527
528
529
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

	argname = TclGetStringFromObj(fieldValues[0], &plen);
	nameLength = Tcl_NumUtfChars(argname, plen);
	if (fieldCount == 2) {
	    const char * value = TclGetString(fieldValues[1]);
	    valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length);
	} else {
	    valueLength = 0;
	}

	/*
	 * Check that the formal parameter name is a scalar.
	 */


	argnamei = argname;
	argnamelast = argname[plen-1];
	while (plen--) {
	    if (argnamei[0] == '(') {
		if (argnamelast == ')') {	/* We have an array element. */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "formal parameter \"%s\" is an array element",
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
	    localPtr = localPtr->nextPtr;
	} else {
	    /*
	     * Allocate an entry in the runtime procedure frame's array of
	     * local variables for the argument.
	     */

	    localPtr = ckalloc(TclOffset(CompiledLocal, name) + fieldValues[0]->length +1);
	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }
	    localPtr->nextPtr = NULL;
	    localPtr->nameLength = Tcl_NumUtfChars(argname, fieldValues[0]->length);
	    localPtr->frameIndex = i;
	    localPtr->flags = VAR_ARGUMENT;
	    localPtr->resolveInfo = NULL;

	    if (fieldCount == 2) {
		localPtr->defValuePtr = fieldValues[1];
		Tcl_IncrRefCount(localPtr->defValuePtr);







|







|







601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
	    localPtr = localPtr->nextPtr;
	} else {
	    /*
	     * Allocate an entry in the runtime procedure frame's array of
	     * local variables for the argument.
	     */

	    localPtr = Tcl_Alloc(TclOffset(CompiledLocal, name) + fieldValues[0]->length +1);
	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }
	    localPtr->nextPtr = NULL;
	    localPtr->nameLength = nameLength;
	    localPtr->frameIndex = i;
	    localPtr->flags = VAR_ARGUMENT;
	    localPtr->resolveInfo = NULL;

	    if (fieldCount == 2) {
		localPtr->defValuePtr = fieldValues[1];
		Tcl_IncrRefCount(localPtr->defValuePtr);
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
	    procPtr->firstLocalPtr = localPtr->nextPtr;

	    defPtr = localPtr->defValuePtr;
	    if (defPtr != NULL) {
		Tcl_DecrRefCount(defPtr);
	    }

	    ckfree(localPtr);
	}
	ckfree(procPtr);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *







|

|







647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
	    procPtr->firstLocalPtr = localPtr->nextPtr;

	    defPtr = localPtr->defValuePtr;
	    if (defPtr != NULL) {
		Tcl_DecrRefCount(defPtr);
	    }

	    Tcl_Free(localPtr);
	}
	Tcl_Free(procPtr);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
int
TclGetFrame(
    Tcl_Interp *interp,		/* Interpreter in which to find frame. */
    const char *name,		/* String describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{
    register Interp *iPtr = (Interp *) interp;
    int curLevel, level, result;
    CallFrame *framePtr;

    /*
     * Parse string to figure out which level number to go to.
     */

    result = 1;
    curLevel = iPtr->varFramePtr->level;
    if (*name== '#') {
	if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
	    goto levelError;
	}
    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
	if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
	    goto levelError;
	}
	level = curLevel - level;
    } else {
	level = curLevel - 1;
	result = 0;
    }

    /*
     * Figure out which frame to use, and return it to the caller.
     */

    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
	    framePtr = framePtr->callerVarPtr) {
	if (framePtr->level == level) {
	    break;
	}
    }
    if (framePtr == NULL) {
	goto levelError;
    }

    *framePtrPtr = framePtr;
    return result;

  levelError:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjGetFrame --
 *







<
|
<
|
<
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
|
<
|
<
<
<
<
|
<
<
|
<
|
<
<
<
<
<







686
687
688
689
690
691
692

693

694



695















696



697

698




699


700

701





702
703
704
705
706
707
708
int
TclGetFrame(
    Tcl_Interp *interp,		/* Interpreter in which to find frame. */
    const char *name,		/* String describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{

	int result;

	Tcl_Obj obj;



















	obj.bytes = (char *) name;



	obj.length = strlen(name);

	obj.typePtr = NULL;




	result = TclObjGetFrame(interp, &obj, framePtrPtr);


	TclFreeIntRep(&obj);

	return result;





}

/*
 *----------------------------------------------------------------------
 *
 * TclObjGetFrame --
 *
766
767
768
769
770
771
772

773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788

789


790
791

792
793
794
795
796
797
798



799
800
801
802

803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829


830
831
832
833
834
835
836
837
838
839
840
841
    Tcl_Obj *objPtr,		/* Object describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{
    register Interp *iPtr = (Interp *) interp;
    int curLevel, level, result;
    const char *name = NULL;


    /*
     * Parse object to figure out which level number to go to.
     */

    result = 0;
    curLevel = iPtr->varFramePtr->level;

    /*
     * Check for integer first, since that has potential to spare us
     * a generation of a stringrep.
     */

    if (objPtr == NULL) {
	/* Do nothing */
    } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)

	    && (level >= 0)) {


	level = curLevel - level;
	result = 1;

    } else if (objPtr->typePtr == &levelReferenceType) {
	level = (int) objPtr->internalRep.wideValue;
	result = 1;
    } else {
	name = TclGetString(objPtr);
	if (name[0] == '#') {
	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {



		TclFreeIntRep(objPtr);
		objPtr->typePtr = &levelReferenceType;
		objPtr->internalRep.wideValue = level;
		result = 1;

	    } else {
		result = -1;
	    }
	} else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */
	    /*
	     * If this were an integer, we'd have succeeded already.
	     * Docs say we have to treat this as a 'bad level'  error.
	     */
	    result = -1;
	}
    }

    if (result == 0) {
	level = curLevel - 1;
	name = "1";
    }
    if (result != -1) {
	if (level >= 0) {
	    CallFrame *framePtr;
	    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
		    framePtr = framePtr->callerVarPtr) {
		if (framePtr->level == level) {
		    *framePtrPtr = framePtr;
		    return result;
		}
	    }
	}


	if (name == NULL) {
	    name = TclGetString(objPtr);
	}
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
    return -1;
}

/*
 *----------------------------------------------------------------------







>















|
>
|
>
>
|
|
>






|
>
>
>
|
|
|
|
>



|










<












>
>
|
|
|
<
<







732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791

792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808


809
810
811
812
813
814
815
    Tcl_Obj *objPtr,		/* Object describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{
    register Interp *iPtr = (Interp *) interp;
    int curLevel, level, result;
    const char *name = NULL;
    Tcl_WideInt w;

    /*
     * Parse object to figure out which level number to go to.
     */

    result = 0;
    curLevel = iPtr->varFramePtr->level;

    /*
     * Check for integer first, since that has potential to spare us
     * a generation of a stringrep.
     */

    if (objPtr == NULL) {
	/* Do nothing */
    } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
	Tcl_GetWideIntFromObj(NULL, objPtr, &w);
	if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
	    result = -1;
	} else {
	    level = curLevel - level;
	    result = 1;
	}
    } else if (objPtr->typePtr == &levelReferenceType) {
	level = (int) objPtr->internalRep.wideValue;
	result = 1;
    } else {
	name = TclGetString(objPtr);
	if (name[0] == '#') {
	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
		if (level < 0 || (level > 0 && name[1] == '-')) {
		    result = -1;
		} else {
		    TclFreeIntRep(objPtr);
		    objPtr->typePtr = &levelReferenceType;
		    objPtr->internalRep.wideValue = level;
		    result = 1;
		}
	    } else {
		result = -1;
	    }
	} else if (TclGetWideBitsFromObj(interp, objPtr, &w) == TCL_OK) {
	    /*
	     * If this were an integer, we'd have succeeded already.
	     * Docs say we have to treat this as a 'bad level'  error.
	     */
	    result = -1;
	}
    }

    if (result == 0) {
	level = curLevel - 1;

    }
    if (result != -1) {
	if (level >= 0) {
	    CallFrame *framePtr;
	    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
		    framePtr = framePtr->callerVarPtr) {
		if (framePtr->level == level) {
		    *framePtrPtr = framePtr;
		    return result;
		}
	    }
	}
    }

    if (name == NULL) {
	name = TclGetString(objPtr);
    }


    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
    return -1;
}

/*
 *----------------------------------------------------------------------
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057

1058

1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074

1075
1076
1077
1078
1079
1080
1081
static int
ProcWrongNumArgs(
    Tcl_Interp *interp,
    int skip)
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    register Proc *procPtr = framePtr->procPtr;
    register Var *defPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, i;
    Tcl_Obj **desiredObjs;
    const char *final = NULL;

    /*
     * Build up desired argument list for Tcl_WrongNumArgs
     */

    numArgs = framePtr->procPtr->numArgs;
    desiredObjs = TclStackAlloc(interp,
	    (int) sizeof(Tcl_Obj *) * (numArgs+1));

    if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
    } else {
	desiredObjs[0] = framePtr->objv[skip-1];
    }
    Tcl_IncrRefCount(desiredObjs[0]);


    defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);

    for (i=1 ; i<=numArgs ; i++, defPtr++) {
	Tcl_Obj *argObj;
	Tcl_Obj *namePtr = localName(framePtr, i-1);

	if (defPtr->value.objPtr != NULL) {
	    TclNewObj(argObj);
	    Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
	} else if (defPtr->flags & VAR_IS_ARGS) {
	    numArgs--;
	    final = "?arg ...?";
	    break;
	} else {
	    argObj = namePtr;
	    Tcl_IncrRefCount(namePtr);
	}
	desiredObjs[i] = argObj;

    }

    Tcl_ResetResult(interp);
    Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final);

    for (i=0 ; i<=numArgs ; i++) {
	Tcl_DecrRefCount(desiredObjs[i]);







<



















>
|
>
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
>







1005
1006
1007
1008
1009
1010
1011

1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
static int
ProcWrongNumArgs(
    Tcl_Interp *interp,
    int skip)
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    register Proc *procPtr = framePtr->procPtr;

    int localCt = procPtr->numCompiledLocals, numArgs, i;
    Tcl_Obj **desiredObjs;
    const char *final = NULL;

    /*
     * Build up desired argument list for Tcl_WrongNumArgs
     */

    numArgs = framePtr->procPtr->numArgs;
    desiredObjs = TclStackAlloc(interp,
	    (int) sizeof(Tcl_Obj *) * (numArgs+1));

    if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
    } else {
	desiredObjs[0] = framePtr->objv[skip-1];
    }
    Tcl_IncrRefCount(desiredObjs[0]);

    if (localCt > 0) {
	register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);

	for (i=1 ; i<=numArgs ; i++, defPtr++) {
	    Tcl_Obj *argObj;
	    Tcl_Obj *namePtr = localName(framePtr, i-1);

	    if (defPtr->value.objPtr != NULL) {
		TclNewObj(argObj);
		Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
	    } else if (defPtr->flags & VAR_IS_ARGS) {
		numArgs--;
		final = "?arg ...?";
		break;
	    } else {
		argObj = namePtr;
		Tcl_IncrRefCount(namePtr);
	    }
	    desiredObjs[i] = argObj;
	}
    }

    Tcl_ResetResult(interp);
    Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final);

    for (i=0 ; i<=numArgs ; i++) {
	Tcl_DecrRefCount(desiredObjs[i]);
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198

    firstLocalPtr = localPtr;
    for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
	if (localPtr->resolveInfo) {
	    if (localPtr->resolveInfo->deleteProc) {
		localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
	    } else {
		ckfree(localPtr->resolveInfo);
	    }
	    localPtr->resolveInfo = NULL;
	}
	localPtr->flags &= ~VAR_RESOLVED;

	if (haveResolvers &&
		!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {







|







1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174

    firstLocalPtr = localPtr;
    for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
	if (localPtr->resolveInfo) {
	    if (localPtr->resolveInfo->deleteProc) {
		localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
	    } else {
		Tcl_Free(localPtr->resolveInfo);
	    }
	    localPtr->resolveInfo = NULL;
	}
	localPtr->flags &= ~VAR_RESOLVED;

	if (haveResolvers &&
		!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
	register Tcl_Obj *objPtr = *namePtrPtr;

	if (objPtr) {
	    /* TclReleaseLiteral calls Tcl_DecrRefCount for us */
	    TclReleaseLiteral(interp, objPtr);
	}
    }
    ckfree(localCachePtr);
}

static void
InitLocalCache(
    Proc *procPtr)
{
    Interp *iPtr = procPtr->iPtr;







|







1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
	register Tcl_Obj *objPtr = *namePtrPtr;

	if (objPtr) {
	    /* TclReleaseLiteral calls Tcl_DecrRefCount for us */
	    TclReleaseLiteral(interp, objPtr);
	}
    }
    Tcl_Free(localCachePtr);
}

static void
InitLocalCache(
    Proc *procPtr)
{
    Interp *iPtr = procPtr->iPtr;
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308

    /*
     * Cache the names and initial values of local variables; store the
     * cache in both the framePtr for this execution and in the codePtr
     * for future calls.
     */

    localCachePtr = ckalloc(sizeof(LocalCache)
	    + (localCt - 1) * sizeof(Tcl_Obj *)
	    + numArgs * sizeof(Var));

    namePtr = &localCachePtr->varName0;
    varPtr = (Var *) (namePtr + localCt);
    localPtr = procPtr->firstLocalPtr;
    while (localPtr) {







|







1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284

    /*
     * Cache the names and initial values of local variables; store the
     * cache in both the framePtr for this execution and in the codePtr
     * for future calls.
     */

    localCachePtr = Tcl_Alloc(sizeof(LocalCache)
	    + (localCt - 1) * sizeof(Tcl_Obj *)
	    + numArgs * sizeof(Var));

    namePtr = &localCachePtr->varName0;
    varPtr = (Var *) (namePtr + localCt);
    localPtr = procPtr->firstLocalPtr;
    while (localPtr) {
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
		CompiledLocal *toFree = clPtr;

		clPtr = clPtr->nextPtr;
		if (toFree->resolveInfo) {
		    if (toFree->resolveInfo->deleteProc) {
			toFree->resolveInfo->deleteProc(toFree->resolveInfo);
		    } else {
			ckfree(toFree->resolveInfo);
		    }
		}
		ckfree(toFree);
	    }
	    procPtr->numCompiledLocals = procPtr->numArgs;
	}

	(void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
		/* isProcCallFrame */ 0);








|


|







1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
		CompiledLocal *toFree = clPtr;

		clPtr = clPtr->nextPtr;
		if (toFree->resolveInfo) {
		    if (toFree->resolveInfo->deleteProc) {
			toFree->resolveInfo->deleteProc(toFree->resolveInfo);
		    } else {
			Tcl_Free(toFree->resolveInfo);
		    }
		}
		Tcl_Free(toFree);
	    }
	    procPtr->numCompiledLocals = procPtr->numArgs;
	}

	(void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
		/* isProcCallFrame */ 0);

2038
2039
2040
2041
2042
2043
2044
2045

2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
static void
MakeProcError(
    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    int overflow, limit = 60, nameLen;

    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (procedure \"%.*s%s\" line %d)",
	    (overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcDeleteProc --







|
>





|







2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
static void
MakeProcError(
    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    unsigned int overflow, limit = 60;
    size_t nameLen;
    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (procedure \"%.*s%s\" line %d)",
	    (int)(overflow ? limit :nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcDeleteProc --
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
	CompiledLocal *nextPtr = localPtr->nextPtr;

	resVarInfo = localPtr->resolveInfo;
	if (resVarInfo) {
	    if (resVarInfo->deleteProc) {
		resVarInfo->deleteProc(resVarInfo);
	    } else {
		ckfree(resVarInfo);
	    }
	}

	if (localPtr->defValuePtr != NULL) {
	    defPtr = localPtr->defValuePtr;
	    Tcl_DecrRefCount(defPtr);
	}
	ckfree(localPtr);
	localPtr = nextPtr;
    }
    ckfree(procPtr);

    /*
     * TIP #280: Release the location data associated with this Proc
     * structure, if any. The interpreter may not exist (For example for
     * procbody structures created by tbcload.
     */








|







|


|







2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
	CompiledLocal *nextPtr = localPtr->nextPtr;

	resVarInfo = localPtr->resolveInfo;
	if (resVarInfo) {
	    if (resVarInfo->deleteProc) {
		resVarInfo->deleteProc(resVarInfo);
	    } else {
		Tcl_Free(resVarInfo);
	    }
	}

	if (localPtr->defValuePtr != NULL) {
	    defPtr = localPtr->defValuePtr;
	    Tcl_DecrRefCount(defPtr);
	}
	Tcl_Free(localPtr);
	localPtr = nextPtr;
    }
    Tcl_Free(procPtr);

    /*
     * TIP #280: Release the location data associated with this Proc
     * structure, if any. The interpreter may not exist (For example for
     * procbody structures created by tbcload.
     */

2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
    cfPtr = Tcl_GetHashValue(hePtr);

    if (cfPtr) {
	if (cfPtr->type == TCL_LOCATION_SOURCE) {
	    Tcl_DecrRefCount(cfPtr->data.eval.path);
	    cfPtr->data.eval.path = NULL;
	}
	ckfree(cfPtr->line);
	cfPtr->line = NULL;
	ckfree(cfPtr);
    }
    Tcl_DeleteHashEntry(hePtr);
}

/*
 *----------------------------------------------------------------------
 *







|

|







2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
    cfPtr = Tcl_GetHashValue(hePtr);

    if (cfPtr) {
	if (cfPtr->type == TCL_LOCATION_SOURCE) {
	    Tcl_DecrRefCount(cfPtr->data.eval.path);
	    cfPtr->data.eval.path = NULL;
	}
	Tcl_Free(cfPtr->line);
	cfPtr->line = NULL;
	Tcl_Free(cfPtr);
    }
    Tcl_DeleteHashEntry(hePtr);
}

/*
 *----------------------------------------------------------------------
 *
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
		int buf[2];

		/*
		 * Move from approximation (line of list cmd word) to actual
		 * location (line of 2nd list element).
		 */

		cfPtr = ckalloc(sizeof(CmdFrame));
		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		cfPtr->line = ckalloc(sizeof(int));
		cfPtr->line[0] = buf[1];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);







|




|







2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
		int buf[2];

		/*
		 * Move from approximation (line of list cmd word) to actual
		 * location (line of 2nd list element).
		 */

		cfPtr = Tcl_Alloc(sizeof(CmdFrame));
		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		cfPtr->line = Tcl_Alloc(sizeof(int));
		cfPtr->line[0] = buf[1];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);
2695
2696
2697
2698
2699
2700
2701
2702

2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
static void
MakeLambdaError(
    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    int overflow, limit = 60, nameLen;

    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (lambda term \"%.*s%s\" line %d)",
	    (overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetCmdFrameForProcedure --







|
>





|







2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
static void
MakeLambdaError(
    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    unsigned int overflow, limit = 60;
    size_t nameLen;
    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (lambda term \"%.*s%s\" line %d)",
	    (int)(overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetCmdFrameForProcedure --
Changes to generic/tclProcess.c.
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 * Prototypes for functions defined later in this file:
 */

static void		InitProcessInfo(ProcessInfo *info, Tcl_Pid pid,
			    int resolvedPid);
static void		FreeProcessInfo(ProcessInfo *info);
static int		RefreshProcessInfo(ProcessInfo *info, int options);
static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid,
			    int options, int *codePtr, Tcl_Obj **msgPtr,
			    Tcl_Obj **errorObjPtr);
static Tcl_Obj *	BuildProcessStatusObj(ProcessInfo *info);
static int		ProcessListObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ProcessStatusObjCmd(ClientData clientData,







|







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 * Prototypes for functions defined later in this file:
 */

static void		InitProcessInfo(ProcessInfo *info, Tcl_Pid pid,
			    int resolvedPid);
static void		FreeProcessInfo(ProcessInfo *info);
static int		RefreshProcessInfo(ProcessInfo *info, int options);
static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, size_t resolvedPid,
			    int options, int *codePtr, Tcl_Obj **msgPtr,
			    Tcl_Obj **errorObjPtr);
static Tcl_Obj *	BuildProcessStatusObj(ProcessInfo *info);
static int		ProcessListObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ProcessStatusObjCmd(ClientData clientData,
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
	Tcl_DecrRefCount(info->error);
    }

    /*
     * Free allocated structure.
     */

    ckfree(info);
}

/*
 *----------------------------------------------------------------------
 *
 * RefreshProcessInfo --
 *







|







126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
	Tcl_DecrRefCount(info->error);
    }

    /*
     * Free allocated structure.
     */

    Tcl_Free(info);
}

/*
 *----------------------------------------------------------------------
 *
 * RefreshProcessInfo --
 *
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
 *
 *----------------------------------------------------------------------
 */

TclProcessWaitStatus
WaitProcessStatus(
    Tcl_Pid pid,		/* Process id. */
    int resolvedPid,		/* Resolved process id. */
    int options,		/* Options passed to Tcl_WaitPid. */
    int *codePtr,		/* If non-NULL, will receive either:
				 *  - 0 for normal exit.
				 *  - errno in case of error.
				 *  - non-zero exit code for abormal exit.
				 *  - signal number if killed or suspended.
				 *  - Tcl_WaitPid status in all other cases.







|







189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
 *
 *----------------------------------------------------------------------
 */

TclProcessWaitStatus
WaitProcessStatus(
    Tcl_Pid pid,		/* Process id. */
    size_t resolvedPid,		/* Resolved process id. */
    int options,		/* Options passed to Tcl_WaitPid. */
    int *codePtr,		/* If non-NULL, will receive either:
				 *  - 0 for normal exit.
				 *  - errno in case of error.
				 *  - non-zero exit code for abormal exit.
				 *  - signal number if killed or suspended.
				 *  - Tcl_WaitPid status in all other cases.
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
 *----------------------------------------------------------------------
 */

void
TclProcessCreated(
    Tcl_Pid pid)		/* Process id. */
{
    int resolvedPid;
    Tcl_HashEntry *entry, *entry2;
    int isNew;
    ProcessInfo *info;

    /*
     * Get resolved pid first.
     */







|







795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
 *----------------------------------------------------------------------
 */

void
TclProcessCreated(
    Tcl_Pid pid)		/* Process id. */
{
    size_t resolvedPid;
    Tcl_HashEntry *entry, *entry2;
    int isNew;
    ProcessInfo *info;

    /*
     * Get resolved pid first.
     */
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
	FreeProcessInfo(info);
    }

    /*
     * Allocate and initialize info structure.
     */

    info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo));
    InitProcessInfo(info, pid, resolvedPid);

    /*
     * Add entry to tables.
     */

    Tcl_SetHashValue(entry, info);







|







829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
	FreeProcessInfo(info);
    }

    /*
     * Allocate and initialize info structure.
     */

    info = (ProcessInfo *) Tcl_Alloc(sizeof(ProcessInfo));
    InitProcessInfo(info, pid, resolvedPid);

    /*
     * Add entry to tables.
     */

    Tcl_SetHashValue(entry, info);
Changes to generic/tclRegexp.c.
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
#define NUM_REGEXPS 30

typedef struct {
    int initialized;		/* Set to 1 when the module is initialized. */
    char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular
				 * expression patterns. NULL means that this
				 * slot isn't used. Malloc-ed. */
    int patLengths[NUM_REGEXPS];/* Number of non-null characters in
				 * corresponding entry in patterns. -1 means
				 * entry isn't used. */
    struct TclRegexp *regexps[NUM_REGEXPS];
				/* Compiled forms of above strings. Also
				 * malloc-ed, or NULL if not in use yet. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * Declarations for functions used only in this file.
 */

static TclRegexp *	CompileRegexp(Tcl_Interp *interp, const char *pattern,
			    int length, int flags);
static void		DupRegexpInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static void		FinalizeRegexp(ClientData clientData);
static void		FreeRegexp(TclRegexp *regexpPtr);
static void		FreeRegexpInternalRep(Tcl_Obj *objPtr);
static int		RegExpExecUniChar(Tcl_Interp *interp, Tcl_RegExp re,
			    const Tcl_UniChar *uniString, int numChars,
			    int nmatches, int flags);
static int		SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);

/*
 * The regular expression Tcl object type. This serves as a cache of the
 * compiled form of the regular expression.
 */








|
|













|






|
|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
#define NUM_REGEXPS 30

typedef struct {
    int initialized;		/* Set to 1 when the module is initialized. */
    char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular
				 * expression patterns. NULL means that this
				 * slot isn't used. Malloc-ed. */
    size_t patLengths[NUM_REGEXPS];/* Number of non-null characters in
				 * corresponding entry in patterns. (size_t)-1 means
				 * entry isn't used. */
    struct TclRegexp *regexps[NUM_REGEXPS];
				/* Compiled forms of above strings. Also
				 * malloc-ed, or NULL if not in use yet. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * Declarations for functions used only in this file.
 */

static TclRegexp *	CompileRegexp(Tcl_Interp *interp, const char *pattern,
			    size_t length, int flags);
static void		DupRegexpInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static void		FinalizeRegexp(ClientData clientData);
static void		FreeRegexp(TclRegexp *regexpPtr);
static void		FreeRegexpInternalRep(Tcl_Obj *objPtr);
static int		RegExpExecUniChar(Tcl_Interp *interp, Tcl_RegExp re,
			    const Tcl_UniChar *uniString, size_t numChars,
			    size_t nmatches, int flags);
static int		SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);

/*
 * The regular expression Tcl object type. This serves as a cache of the
 * compiled form of the regular expression.
 */

168
169
170
171
172
173
174
175

176
177
178
179
180
181
182
				 * returned by previous call to
				 * Tcl_GetRegExpFromObj. */
    const char *text,		/* Text against which to match re. */
    const char *start)		/* If text is part of a larger string, this
				 * identifies beginning of larger string, so
				 * that "^" won't match. */
{
    int flags, result, numChars;

    TclRegexp *regexp = (TclRegexp *) re;
    Tcl_DString ds;
    const Tcl_UniChar *ustr;

    /*
     * If the starting point is offset from the beginning of the buffer, then
     * we need to tell the regexp engine not to match "^".







|
>







168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
				 * returned by previous call to
				 * Tcl_GetRegExpFromObj. */
    const char *text,		/* Text against which to match re. */
    const char *start)		/* If text is part of a larger string, this
				 * identifies beginning of larger string, so
				 * that "^" won't match. */
{
    int flags, result;
    size_t numChars;
    TclRegexp *regexp = (TclRegexp *) re;
    Tcl_DString ds;
    const Tcl_UniChar *ustr;

    /*
     * If the starting point is offset from the beginning of the buffer, then
     * we need to tell the regexp engine not to match "^".
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
 *---------------------------------------------------------------------------
 */

void
Tcl_RegExpRange(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    int index,			/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange. */
    const char **startPtr,	/* Store address of first character in
				 * (sub-)range here. */
    const char **endPtr)	/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    const char *string;

    if ((size_t) index > regexpPtr->re.re_nsub) {
	*startPtr = *endPtr = NULL;
    } else if (regexpPtr->matches[index].rm_so < 0) {
	*startPtr = *endPtr = NULL;
    } else {
	if (regexpPtr->objPtr) {
	    string = TclGetString(regexpPtr->objPtr);
	} else {







|










|







229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
 *---------------------------------------------------------------------------
 */

void
Tcl_RegExpRange(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    size_t index,			/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange. */
    const char **startPtr,	/* Store address of first character in
				 * (sub-)range here. */
    const char **endPtr)	/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    const char *string;

    if (index > regexpPtr->re.re_nsub) {
	*startPtr = *endPtr = NULL;
    } else if (regexpPtr->matches[index].rm_so < 0) {
	*startPtr = *endPtr = NULL;
    } else {
	if (regexpPtr->objPtr) {
	    string = TclGetString(regexpPtr->objPtr);
	} else {
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310

static int
RegExpExecUniChar(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    Tcl_RegExp re,		/* Compiled regular expression; returned by a
				 * previous call to Tcl_GetRegExpFromObj */
    const Tcl_UniChar *wString,	/* String against which to match re. */
    int numChars,		/* Length of Tcl_UniChar string (must be
				 * >=0). */
    int nmatches,		/* How many subexpression matches (counting
				 * the whole match as subexpression 0) are of
				 * interest. -1 means "don't know". */
    int flags)			/* Regular expression flags. */
{
    int status;
    TclRegexp *regexpPtr = (TclRegexp *) re;
    size_t last = regexpPtr->re.re_nsub + 1;
    size_t nm = last;

    if (nmatches >= 0 && (size_t) nmatches < nm) {
	nm = (size_t) nmatches;
    }

    status = TclReExec(&regexpPtr->re, wString, (size_t) numChars,
	    &regexpPtr->details, nm, regexpPtr->matches, flags);

    /*
     * Check for errors.
     */

    if (status != REG_OKAY) {







|
<
|

|





<

|
|


|







281
282
283
284
285
286
287
288

289
290
291
292
293
294
295
296

297
298
299
300
301
302
303
304
305
306
307
308
309

static int
RegExpExecUniChar(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    Tcl_RegExp re,		/* Compiled regular expression; returned by a
				 * previous call to Tcl_GetRegExpFromObj */
    const Tcl_UniChar *wString,	/* String against which to match re. */
    size_t numChars,		/* Length of Tcl_UniChar string. */

    size_t nm,		/* How many subexpression matches (counting
				 * the whole match as subexpression 0) are of
				 * interest. (size_t)-1 means "don't know". */
    int flags)			/* Regular expression flags. */
{
    int status;
    TclRegexp *regexpPtr = (TclRegexp *) re;
    size_t last = regexpPtr->re.re_nsub + 1;


    if (nm >= last) {
	nm = last;
    }

    status = TclReExec(&regexpPtr->re, wString, numChars,
	    &regexpPtr->details, nm, regexpPtr->matches, flags);

    /*
     * Check for errors.
     */

    if (status != REG_OKAY) {
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
 *---------------------------------------------------------------------------
 */

void
TclRegExpRangeUniChar(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    int index,			/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange, -1 means the range of the
				 * rm_extend field. */
    int *startPtr,		/* Store address of first character in
				 * (sub-)range here. */
    int *endPtr)		/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;

    if ((regexpPtr->flags&REG_EXPECT) && index == -1) {
	*startPtr = regexpPtr->details.rm_extend.rm_so;
	*endPtr = regexpPtr->details.rm_extend.rm_eo;
    } else if ((size_t) index > regexpPtr->re.re_nsub) {
	*startPtr = -1;
	*endPtr = -1;
    } else {
	*startPtr = regexpPtr->matches[index].rm_so;
	*endPtr = regexpPtr->matches[index].rm_eo;
    }
}







|

|








|


|







339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
 *---------------------------------------------------------------------------
 */

void
TclRegExpRangeUniChar(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    size_t index,			/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange, (size_t)-1 means the range of the
				 * rm_extend field. */
    int *startPtr,		/* Store address of first character in
				 * (sub-)range here. */
    int *endPtr)		/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;

    if ((regexpPtr->flags&REG_EXPECT) && index == (size_t)-1) {
	*startPtr = regexpPtr->details.rm_extend.rm_so;
	*endPtr = regexpPtr->details.rm_extend.rm_eo;
    } else if (index > regexpPtr->re.re_nsub) {
	*startPtr = -1;
	*endPtr = -1;
    } else {
	*startPtr = regexpPtr->matches[index].rm_so;
	*endPtr = regexpPtr->matches[index].rm_eo;
    }
}
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
int
Tcl_RegExpExecObj(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    Tcl_RegExp re,		/* Compiled regular expression; must have been
				 * returned by previous call to
				 * Tcl_GetRegExpFromObj. */
    Tcl_Obj *textObj,		/* Text against which to match re. */
    int offset,			/* Character index that marks where matching
				 * should begin. */
    int nmatches,		/* How many subexpression matches (counting
				 * the whole match as subexpression 0) are of
				 * interest. -1 means all of them. */
    int flags)			/* Regular expression execution flags. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    Tcl_UniChar *udata;
    int length;
    int reflags = regexpPtr->flags;
#define TCL_REG_GLOBOK_FLAGS \
	(TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE)

    /*
     * Take advantage of the equivalent glob pattern, if one exists.
     * This is possible based only on the right mix of incoming flags (0)







|

|

|




|







419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
int
Tcl_RegExpExecObj(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    Tcl_RegExp re,		/* Compiled regular expression; must have been
				 * returned by previous call to
				 * Tcl_GetRegExpFromObj. */
    Tcl_Obj *textObj,		/* Text against which to match re. */
    size_t offset,			/* Character index that marks where matching
				 * should begin. */
    size_t nmatches,		/* How many subexpression matches (counting
				 * the whole match as subexpression 0) are of
				 * interest. (size_t)-1 means all of them. */
    int flags)			/* Regular expression execution flags. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    Tcl_UniChar *udata;
    size_t length;
    int reflags = regexpPtr->flags;
#define TCL_REG_GLOBOK_FLAGS \
	(TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE)

    /*
     * Take advantage of the equivalent glob pattern, if one exists.
     * This is possible based only on the right mix of incoming flags (0)
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
    /*
     * Save the target object so we can extract strings from it later.
     */

    regexpPtr->string = NULL;
    regexpPtr->objPtr = textObj;

    udata = Tcl_GetUnicodeFromObj(textObj, &length);

    if (offset > length) {
	offset = length;
    }
    udata += offset;
    length -= offset;








|







459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
    /*
     * Save the target object so we can extract strings from it later.
     */

    regexpPtr->string = NULL;
    regexpPtr->objPtr = textObj;

    udata = TclGetUnicodeFromObj(textObj, &length);

    if (offset > length) {
	offset = length;
    }
    udata += offset;
    length -= offset;

850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
 *----------------------------------------------------------------------
 */

static TclRegexp *
CompileRegexp(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    const char *string,		/* The regexp to compile (UTF-8). */
    int length,			/* The length of the string in bytes. */
    int flags)			/* Compilation flags. */
{
    TclRegexp *regexpPtr;
    const Tcl_UniChar *uniString;
    int numChars, status, i, exact;
    Tcl_DString stringBuf;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);







|







849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
 *----------------------------------------------------------------------
 */

static TclRegexp *
CompileRegexp(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    const char *string,		/* The regexp to compile (UTF-8). */
    size_t length,			/* The length of the string in bytes. */
    int flags)			/* Compilation flags. */
{
    TclRegexp *regexpPtr;
    const Tcl_UniChar *uniString;
    int numChars, status, i, exact;
    Tcl_DString stringBuf;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
	}
    }

    /*
     * This is a new expression, so compile it and add it to the cache.
     */

    regexpPtr = ckalloc(sizeof(TclRegexp));
    regexpPtr->objPtr = NULL;
    regexpPtr->string = NULL;
    regexpPtr->details.rm_extend.rm_so = -1;
    regexpPtr->details.rm_extend.rm_eo = -1;

    /*
     * Get the up-to-date string representation and map to unicode.







|







907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
	}
    }

    /*
     * This is a new expression, so compile it and add it to the cache.
     */

    regexpPtr = Tcl_Alloc(sizeof(TclRegexp));
    regexpPtr->objPtr = NULL;
    regexpPtr->string = NULL;
    regexpPtr->details.rm_extend.rm_so = -1;
    regexpPtr->details.rm_extend.rm_eo = -1;

    /*
     * Get the up-to-date string representation and map to unicode.
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
    Tcl_DStringFree(&stringBuf);

    if (status != REG_OKAY) {
	/*
	 * Clean up and report errors in the interpreter, if possible.
	 */

	ckfree(regexpPtr);
	if (interp) {
	    TclRegError(interp,
		    "couldn't compile regular expression pattern: ", status);
	}
	return NULL;
    }








|







934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
    Tcl_DStringFree(&stringBuf);

    if (status != REG_OKAY) {
	/*
	 * Clean up and report errors in the interpreter, if possible.
	 */

	Tcl_Free(regexpPtr);
	if (interp) {
	    TclRegError(interp,
		    "couldn't compile regular expression pattern: ", status);
	}
	return NULL;
    }

963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003

    /*
     * Allocate enough space for all of the subexpressions, plus one extra for
     * the entire pattern.
     */

    regexpPtr->matches =
	    ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));

    /*
     * Initialize the refcount to one initially, since it is in the cache.
     */

    regexpPtr->refCount = 1;

    /*
     * Free the last regexp, if necessary, and make room at the head of the
     * list for the new regexp.
     */

    if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {
	TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];

	if (oldRegexpPtr->refCount-- <= 1) {
	    FreeRegexp(oldRegexpPtr);
	}
	ckfree(tsdPtr->patterns[NUM_REGEXPS-1]);
    }
    for (i = NUM_REGEXPS - 2; i >= 0; i--) {
	tsdPtr->patterns[i+1] = tsdPtr->patterns[i];
	tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
	tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
    }
    tsdPtr->patterns[0] = ckalloc(length + 1);
    memcpy(tsdPtr->patterns[0], string, (unsigned) length + 1);
    tsdPtr->patLengths[0] = length;
    tsdPtr->regexps[0] = regexpPtr;

    return regexpPtr;
}








|


















|






|







962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002

    /*
     * Allocate enough space for all of the subexpressions, plus one extra for
     * the entire pattern.
     */

    regexpPtr->matches =
	    Tcl_Alloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));

    /*
     * Initialize the refcount to one initially, since it is in the cache.
     */

    regexpPtr->refCount = 1;

    /*
     * Free the last regexp, if necessary, and make room at the head of the
     * list for the new regexp.
     */

    if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {
	TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];

	if (oldRegexpPtr->refCount-- <= 1) {
	    FreeRegexp(oldRegexpPtr);
	}
	Tcl_Free(tsdPtr->patterns[NUM_REGEXPS-1]);
    }
    for (i = NUM_REGEXPS - 2; i >= 0; i--) {
	tsdPtr->patterns[i+1] = tsdPtr->patterns[i];
	tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
	tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
    }
    tsdPtr->patterns[0] = Tcl_Alloc(length + 1);
    memcpy(tsdPtr->patterns[0], string, (unsigned) length + 1);
    tsdPtr->patLengths[0] = length;
    tsdPtr->regexps[0] = regexpPtr;

    return regexpPtr;
}

1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
    TclRegexp *regexpPtr)	/* Compiled regular expression to free. */
{
    TclReFree(&regexpPtr->re);
    if (regexpPtr->globObjPtr) {
	TclDecrRefCount(regexpPtr->globObjPtr);
    }
    if (regexpPtr->matches) {
	ckfree(regexpPtr->matches);
    }
    ckfree(regexpPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FinalizeRegexp --
 *







|

|







1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
    TclRegexp *regexpPtr)	/* Compiled regular expression to free. */
{
    TclReFree(&regexpPtr->re);
    if (regexpPtr->globObjPtr) {
	TclDecrRefCount(regexpPtr->globObjPtr);
    }
    if (regexpPtr->matches) {
	Tcl_Free(regexpPtr->matches);
    }
    Tcl_Free(regexpPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FinalizeRegexp --
 *
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
	regexpPtr = tsdPtr->regexps[i];
	if (regexpPtr->refCount-- <= 1) {
	    FreeRegexp(regexpPtr);
	}
	ckfree(tsdPtr->patterns[i]);
	tsdPtr->patterns[i] = NULL;
    }

    /*
     * We may find ourselves reinitialized if another finalization routine
     * invokes regexps.
     */







|







1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
	regexpPtr = tsdPtr->regexps[i];
	if (regexpPtr->refCount-- <= 1) {
	    FreeRegexp(regexpPtr);
	}
	Tcl_Free(tsdPtr->patterns[i]);
	tsdPtr->patterns[i] = NULL;
    }

    /*
     * We may find ourselves reinitialized if another finalization routine
     * invokes regexps.
     */
Changes to generic/tclResolve.c.
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
    }

    /*
     * Otherwise, this is a new scheme. Add it to the FRONT of the linked
     * list, so that it overrides existing schemes.
     */

    resPtr = ckalloc(sizeof(ResolverScheme));
    len = strlen(name) + 1;
    resPtr->name = ckalloc(len);
    memcpy(resPtr->name, name, len);
    resPtr->cmdResProc = cmdProc;
    resPtr->varResProc = varProc;
    resPtr->compiledVarResProc = compiledVarProc;
    resPtr->nextPtr = iPtr->resolverPtr;
    iPtr->resolverPtr = resPtr;
}







|

|







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
    }

    /*
     * Otherwise, this is a new scheme. Add it to the FRONT of the linked
     * list, so that it overrides existing schemes.
     */

    resPtr = Tcl_Alloc(sizeof(ResolverScheme));
    len = strlen(name) + 1;
    resPtr->name = Tcl_Alloc(len);
    memcpy(resPtr->name, name, len);
    resPtr->cmdResProc = cmdProc;
    resPtr->varResProc = varProc;
    resPtr->compiledVarResProc = compiledVarProc;
    resPtr->nextPtr = iPtr->resolverPtr;
    iPtr->resolverPtr = resPtr;
}
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
	    iPtr->compileEpoch++;
	}
	if (resPtr->cmdResProc) {
	    BumpCmdRefEpochs(iPtr->globalNsPtr);
	}

	*prevPtrPtr = resPtr->nextPtr;
	ckfree(resPtr->name);
	ckfree(resPtr);

	return 1;
    }
    return 0;
}

/*







|
|







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
	    iPtr->compileEpoch++;
	}
	if (resPtr->cmdResProc) {
	    BumpCmdRefEpochs(iPtr->globalNsPtr);
	}

	*prevPtrPtr = resPtr->nextPtr;
	Tcl_Free(resPtr->name);
	Tcl_Free(resPtr);

	return 1;
    }
    return 0;
}

/*
Changes to generic/tclResult.c.
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

Tcl_InterpState
Tcl_SaveInterpState(
    Tcl_Interp *interp,		/* Interpreter's state to be saved */
    int status)			/* status code for current operation */
{
    Interp *iPtr = (Interp *) interp;
    InterpState *statePtr = ckalloc(sizeof(InterpState));

    statePtr->status = status;
    statePtr->flags = iPtr->flags & ERR_ALREADY_LOGGED;
    statePtr->returnLevel = iPtr->returnLevel;
    statePtr->returnCode = iPtr->returnCode;
    statePtr->errorInfo = iPtr->errorInfo;
    statePtr->errorStack = iPtr->errorStack;







|







70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

Tcl_InterpState
Tcl_SaveInterpState(
    Tcl_Interp *interp,		/* Interpreter's state to be saved */
    int status)			/* status code for current operation */
{
    Interp *iPtr = (Interp *) interp;
    InterpState *statePtr = Tcl_Alloc(sizeof(InterpState));

    statePtr->status = status;
    statePtr->flags = iPtr->flags & ERR_ALREADY_LOGGED;
    statePtr->returnLevel = iPtr->returnLevel;
    statePtr->returnCode = iPtr->returnCode;
    statePtr->errorInfo = iPtr->errorInfo;
    statePtr->errorStack = iPtr->errorStack;
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
    if (statePtr->returnOpts) {
	Tcl_DecrRefCount(statePtr->returnOpts);
    }
    if (statePtr->errorStack) {
	Tcl_DecrRefCount(statePtr->errorStack);
    }
    Tcl_DecrRefCount(statePtr->objResult);
    ckfree(statePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringResult --
 *







|







200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
    if (statePtr->returnOpts) {
	Tcl_DecrRefCount(statePtr->returnOpts);
    }
    if (statePtr->errorStack) {
	Tcl_DecrRefCount(statePtr->errorStack);
    }
    Tcl_DecrRefCount(statePtr->objResult);
    Tcl_Free(statePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringResult --
 *
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
	TclDecrRefCount(objResultPtr);
	TclNewObj(objResultPtr);
	Tcl_IncrRefCount(objResultPtr);
	iPtr->objResultPtr = objResultPtr;
    } else {
	if (objResultPtr->bytes != &tclEmptyString) {
	    if (objResultPtr->bytes) {
		ckfree(objResultPtr->bytes);
	    }
	    objResultPtr->bytes = &tclEmptyString;
	    objResultPtr->length = 0;
	}
	TclFreeIntRep(objResultPtr);
    }
}







|







508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
	TclDecrRefCount(objResultPtr);
	TclNewObj(objResultPtr);
	Tcl_IncrRefCount(objResultPtr);
	iPtr->objResultPtr = objResultPtr;
    } else {
	if (objResultPtr->bytes != &tclEmptyString) {
	    if (objResultPtr->bytes) {
		Tcl_Free(objResultPtr->bytes);
	    }
	    objResultPtr->bytes = &tclEmptyString;
	    objResultPtr->length = 0;
	}
	TclFreeIntRep(objResultPtr);
    }
}
Changes to generic/tclScan.c.
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
    while (ch != ']') {
	if (ch == '-') {
	    nranges++;
	}
	end += TclUtfToUniChar(end, &ch);
    }

    cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
    if (nranges > 0) {
	cset->ranges = ckalloc(sizeof(struct Range) * nranges);
    } else {
	cset->ranges = NULL;
    }

    /*
     * Now build the character set.
     */







|

|







98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
    while (ch != ']') {
	if (ch == '-') {
	    nranges++;
	}
	end += TclUtfToUniChar(end, &ch);
    }

    cset->chars = Tcl_Alloc(sizeof(Tcl_UniChar) * (end - format - 1));
    if (nranges > 0) {
	cset->ranges = Tcl_Alloc(sizeof(struct Range) * nranges);
    } else {
	cset->ranges = NULL;
    }

    /*
     * Now build the character set.
     */
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
 *----------------------------------------------------------------------
 */

static void
ReleaseCharSet(
    CharSet *cset)
{
    ckfree(cset->chars);
    if (cset->ranges) {
	ckfree(cset->ranges);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ValidateFormat --







|

|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
 *----------------------------------------------------------------------
 */

static void
ReleaseCharSet(
    CharSet *cset)
{
    Tcl_Free(cset->chars);
    if (cset->ranges) {
	Tcl_Free(cset->ranges);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ValidateFormat --
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
    }

    /*
     * Allocate space for the result objects.
     */

    if (totalVars > 0) {
	objs = ckalloc(sizeof(Tcl_Obj *) * totalVars);
	for (i = 0; i < totalVars; i++) {
	    objs[i] = NULL;
	}
    }

    string = Tcl_GetString(objv[1]);
    baseString = string;







|







601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
    }

    /*
     * Allocate space for the result objects.
     */

    if (totalVars > 0) {
	objs = Tcl_Alloc(sizeof(Tcl_Obj *) * totalVars);
	for (i = 0; i < totalVars; i++) {
	    objs[i] = NULL;
	}
    }

    string = Tcl_GetString(objv[1]);
    baseString = string;
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
	    string = end;
	    if (flags & SCAN_SUPPRESS) {
		Tcl_DecrRefCount(objPtr);
		break;
	    }
	    if (flags & SCAN_LONGER) {
		if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
		    wideValue = LLONG_MAX;
		    if (TclGetString(objPtr)[0] == '-') {
			wideValue = LLONG_MIN;
		    }
		}
		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
		    sprintf(buf, "%" TCL_LL_MODIFIER "u",
			    (Tcl_WideUInt)wideValue);
		    Tcl_SetStringObj(objPtr, buf, -1);
		} else {







|

|







922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
	    string = end;
	    if (flags & SCAN_SUPPRESS) {
		Tcl_DecrRefCount(objPtr);
		break;
	    }
	    if (flags & SCAN_LONGER) {
		if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
		    wideValue = WIDE_MAX;
		    if (TclGetString(objPtr)[0] == '-') {
			wideValue = WIDE_MIN;
		    }
		}
		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
		    sprintf(buf, "%" TCL_LL_MODIFIER "u",
			    (Tcl_WideUInt)wideValue);
		    Tcl_SetStringObj(objPtr, buf, -1);
		} else {
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
			    code = TCL_ERROR;
			}
			mp_clear(&big);
		    }

		    if (code == TCL_ERROR) {
			if (objs != NULL) {
			    ckfree(objs);
			}
			Tcl_DecrRefCount(objPtr);
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"unsigned bignum scans are invalid", -1));
			Tcl_SetErrorCode(interp, "TCL", "FORMAT",
				"BADUNSIGNED",NULL);
			return TCL_ERROR;







|







948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
			    code = TCL_ERROR;
			}
			mp_clear(&big);
		    }

		    if (code == TCL_ERROR) {
			if (objs != NULL) {
			    Tcl_Free(objs);
			}
			Tcl_DecrRefCount(objPtr);
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"unsigned bignum scans are invalid", -1));
			Tcl_SetErrorCode(interp, "TCL", "FORMAT",
				"BADUNSIGNED",NULL);
			return TCL_ERROR;
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
		 */

		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
	    }
	}
    }
    if (objs != NULL) {
	ckfree(objs);
    }
    if (code == TCL_OK) {
	if (underflow && (nconversions == 0)) {
	    if (numVars) {
		objPtr = Tcl_NewIntObj(-1);
	    } else {
		if (objPtr) {







|







1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
		 */

		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
	    }
	}
    }
    if (objs != NULL) {
	Tcl_Free(objs);
    }
    if (code == TCL_OK) {
	if (underflow && (nconversions == 0)) {
	    if (numVars) {
		objPtr = Tcl_NewIntObj(-1);
	    } else {
		if (objPtr) {
Changes to generic/tclStrToD.c.
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
    Tcl_Interp *interp,		/* Used for error reporting. May be NULL. */
    Tcl_Obj *objPtr,		/* Object to receive the internal rep. */
    const char *expected,	/* Description of the type of number the
				 * caller expects to be able to parse
				 * ("integer", "boolean value", etc.). */
    const char *bytes,		/* Pointer to the start of the string to
				 * scan. */
    int numBytes,		/* Maximum number of bytes to scan, see
				 * above. */
    const char **endPtrPtr,	/* Place to store pointer to the character
				 * that terminated the scan. */
    int flags)			/* Flags governing the parse. */
{
    enum State {
	INITIAL, SIGNUM, ZERO, ZERO_X,







|







470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
    Tcl_Interp *interp,		/* Used for error reporting. May be NULL. */
    Tcl_Obj *objPtr,		/* Object to receive the internal rep. */
    const char *expected,	/* Description of the type of number the
				 * caller expects to be able to parse
				 * ("integer", "boolean value", etc.). */
    const char *bytes,		/* Pointer to the start of the string to
				 * scan. */
    size_t numBytes,		/* Maximum number of bytes to scan, see
				 * above. */
    const char **endPtrPtr,	/* Place to store pointer to the character
				 * that terminated the scan. */
    int flags)			/* Flags governing the parse. */
{
    enum State {
	INITIAL, SIGNUM, ZERO, ZERO_X,
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121

	    while (len != 0 && TclIsSpaceProc(*p)) {
		p++;
		len--;
	    }
	}
	if (endPtrPtr == NULL) {
	    if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) {
		status = TCL_ERROR;
	    }
	} else {
	    *endPtrPtr = p;
	}
    }








|







1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121

	    while (len != 0 && TclIsSpaceProc(*p)) {
		p++;
		len--;
	    }
	}
	if (endPtrPtr == NULL) {
	    if ((len != 0) && ((numBytes + 1 > 1) || (*p != '\0'))) {
		status = TCL_ERROR;
	    }
	} else {
	    *endPtrPtr = p;
	}
    }

2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
 *
 * FormatInfAndNaN --
 *
 *	Bailout for formatting infinities and Not-A-Number.
 *
 * Results:
 *	Returns one of the strings 'Infinity' and 'NaN'.  The string returned
 *	must be freed by the caller using 'ckfree'.
 *
 * Side effects:
 *	Stores 9999 in *decpt, and sets '*endPtr' to designate the terminating
 *	NUL byte of the string if 'endPtr' is not NULL.
 *
 *----------------------------------------------------------------------
 */

static inline char *
FormatInfAndNaN(
    Double *d,			/* Exceptional number to format. */
    int *decpt,			/* Decimal point to set to a bogus value. */
    char **endPtr)		/* Pointer to the end of the formatted data */
{
    char *retval;

    *decpt = 9999;
    if (!(d->w.word1) && !(d->w.word0 & HI_ORDER_SIG_MASK)) {
	retval = ckalloc(9);
	strcpy(retval, "Infinity");
	if (endPtr) {
	    *endPtr = retval + 8;
	}
    } else {
	retval = ckalloc(4);
	strcpy(retval, "NaN");
	if (endPtr) {
	    *endPtr = retval + 3;
	}
    }
    return retval;
}







|


















|





|







2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
 *
 * FormatInfAndNaN --
 *
 *	Bailout for formatting infinities and Not-A-Number.
 *
 * Results:
 *	Returns one of the strings 'Infinity' and 'NaN'.  The string returned
 *	must be freed by the caller using 'Tcl_Free'.
 *
 * Side effects:
 *	Stores 9999 in *decpt, and sets '*endPtr' to designate the terminating
 *	NUL byte of the string if 'endPtr' is not NULL.
 *
 *----------------------------------------------------------------------
 */

static inline char *
FormatInfAndNaN(
    Double *d,			/* Exceptional number to format. */
    int *decpt,			/* Decimal point to set to a bogus value. */
    char **endPtr)		/* Pointer to the end of the formatted data */
{
    char *retval;

    *decpt = 9999;
    if (!(d->w.word1) && !(d->w.word0 & HI_ORDER_SIG_MASK)) {
	retval = Tcl_Alloc(9);
	strcpy(retval, "Infinity");
	if (endPtr) {
	    *endPtr = retval + 8;
	}
    } else {
	retval = Tcl_Alloc(4);
	strcpy(retval, "NaN");
	if (endPtr) {
	    *endPtr = retval + 3;
	}
    }
    return retval;
}
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
 */

static inline char *
FormatZero(
    int *decpt,			/* Location of the decimal point. */
    char **endPtr)		/* Pointer to the end of the formatted data */
{
    char *retval = ckalloc(2);

    strcpy(retval, "0");
    if (endPtr) {
	*endPtr = retval+1;
    }
    *decpt = 0;
    return retval;







|







2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
 */

static inline char *
FormatZero(
    int *decpt,			/* Location of the decimal point. */
    char **endPtr)		/* Pointer to the end of the formatted data */
{
    char *retval = Tcl_Alloc(2);

    strcpy(retval, "0");
    if (endPtr) {
	*endPtr = retval+1;
    }
    *decpt = 0;
    return retval;
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
    eps.d = ieps * d + 7.;
    eps.w.word0 -= (FP_PRECISION-1) << EXP_SHIFT;

    /*
     * Handle the peculiar case where the result has no significant digits.
     */

    retval = ckalloc(len + 1);
    if (ilim == 0) {
	d -= 5.;
	if (d > eps.d) {
	    *retval = '1';
	    *decpt = k;
	    return retval;
	} else if (d < -eps.d) {
	    *decpt = k;
	    return retval;
	} else {
	    ckfree(retval);
	    return NULL;
	}
    }

    /*
     * Format the digit string.
     */

    if (flags & TCL_DD_SHORTEN_FLAG) {
	end = ShorteningQuickFormat(d, k, ilim, eps.d, retval, decpt);
    } else {
	end = StrictQuickFormat(d, k, ilim, eps.d, retval, decpt);
    }
    if (end == NULL) {
	ckfree(retval);
	return NULL;
    }
    *end = '\0';
    if (endPtr != NULL) {
	*endPtr = end;
    }
    return retval;







|










|














|







2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
    eps.d = ieps * d + 7.;
    eps.w.word0 -= (FP_PRECISION-1) << EXP_SHIFT;

    /*
     * Handle the peculiar case where the result has no significant digits.
     */

    retval = Tcl_Alloc(len + 1);
    if (ilim == 0) {
	d -= 5.;
	if (d > eps.d) {
	    *retval = '1';
	    *decpt = k;
	    return retval;
	} else if (d < -eps.d) {
	    *decpt = k;
	    return retval;
	} else {
	    Tcl_Free(retval);
	    return NULL;
	}
    }

    /*
     * Format the digit string.
     */

    if (flags & TCL_DD_SHORTEN_FLAG) {
	end = ShorteningQuickFormat(d, k, ilim, eps.d, retval, decpt);
    } else {
	end = StrictQuickFormat(d, k, ilim, eps.d, retval, decpt);
    }
    if (end == NULL) {
	Tcl_Free(retval);
	return NULL;
    }
    *end = '\0';
    if (endPtr != NULL) {
	*endPtr = end;
    }
    return retval;
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = ckalloc(len + 1);
				/* Output buffer. */
    Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
				/* Numerator of the fraction being
				 * converted. */
    Tcl_WideUInt S = wuipow5[s5] << s2;
				/* Denominator of the fraction being
				 * converted. */







|







2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = Tcl_Alloc(len + 1);
				/* Output buffer. */
    Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
				/* Numerator of the fraction being
				 * converted. */
    Tcl_WideUInt S = wuipow5[s5] << s2;
				/* Denominator of the fraction being
				 * converted. */
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = ckalloc(len + 1);
				/* Output buffer. */
    Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
				/* Numerator of the fraction being
				 * converted. */
    Tcl_WideUInt S = wuipow5[s5] << s2;
				/* Denominator of the fraction being
				 * converted. */







|







2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = Tcl_Alloc(len + 1);
				/* Output buffer. */
    Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
				/* Numerator of the fraction being
				 * converted. */
    Tcl_WideUInt S = wuipow5[s5] << s2;
				/* Denominator of the fraction being
				 * converted. */
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = ckalloc(len + 1);
				/* Output buffer. */
    mp_int b;			/* Numerator of the fraction being
				 * converted. */
    mp_int mplus, mminus;	/* Bounds for roundoff. */
    mp_digit digit;		/* Current output digit. */
    char *s = retval;		/* Cursor in the output buffer. */
    int i;			/* Index in the output buffer. */







|







3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = Tcl_Alloc(len + 1);
				/* Output buffer. */
    mp_int b;			/* Numerator of the fraction being
				 * converted. */
    mp_int mplus, mminus;	/* Bounds for roundoff. */
    mp_digit digit;		/* Current output digit. */
    char *s = retval;		/* Cursor in the output buffer. */
    int i;			/* Index in the output buffer. */
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = ckalloc(len + 1);
				/* Output buffer. */
    mp_int b;			/* Numerator of the fraction being
				 * converted. */
    mp_digit digit;		/* Current output digit. */
    char *s = retval;		/* Cursor in the output buffer. */
    int i;			/* Index in the output buffer. */
    mp_int temp;







|







3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = Tcl_Alloc(len + 1);
				/* Output buffer. */
    mp_int b;			/* Numerator of the fraction being
				 * converted. */
    mp_digit digit;		/* Current output digit. */
    char *s = retval;		/* Cursor in the output buffer. */
    int i;			/* Index in the output buffer. */
    mp_int temp;
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
    int k,			/* Guessed position of the decimal point. */
    int len,			/* Size of the digit buffer to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Pointer to the end of the number */
{
    char *retval = ckalloc(len+1);
				/* Buffer of digits to return. */
    char *s = retval;		/* Cursor in the return value. */
    mp_int b;			/* Numerator of the result. */
    mp_int mminus;		/* 1/2 ulp below the result. */
    mp_int mplus;		/* 1/2 ulp above the result. */
    mp_int S;			/* Denominator of the result. */
    mp_int dig;			/* Current digit of the result. */







|







3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
    int k,			/* Guessed position of the decimal point. */
    int len,			/* Size of the digit buffer to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Pointer to the end of the number */
{
    char *retval = Tcl_Alloc(len+1);
				/* Buffer of digits to return. */
    char *s = retval;		/* Cursor in the return value. */
    mp_int b;			/* Numerator of the result. */
    mp_int mminus;		/* 1/2 ulp below the result. */
    mp_int mplus;		/* 1/2 ulp above the result. */
    mp_int S;			/* Denominator of the result. */
    mp_int dig;			/* Current digit of the result. */
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
    int k,			/* Guessed position of the decimal point. */
    int len,			/* Size of the digit buffer to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Pointer to the end of the number */
{
    char *retval = ckalloc(len+1);
				/* Buffer of digits to return. */
    char *s = retval;		/* Cursor in the return value. */
    mp_int b;			/* Numerator of the result. */
    mp_int S;			/* Denominator of the result. */
    mp_int dig;			/* Current digit of the result. */
    int digit;			/* Current digit of the result. */
    mp_int temp;		/* Work area. */







|







3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
    int k,			/* Guessed position of the decimal point. */
    int len,			/* Size of the digit buffer to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Pointer to the end of the number */
{
    char *retval = Tcl_Alloc(len+1);
				/* Buffer of digits to return. */
    char *s = retval;		/* Cursor in the return value. */
    mp_int b;			/* Numerator of the result. */
    mp_int S;			/* Denominator of the result. */
    mp_int dig;			/* Current digit of the result. */
    int digit;			/* Current digit of the result. */
    mp_int temp;		/* Work area. */
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332

    /*
     * Initialize table of powers of 10 expressed as wide integers.
     */

    maxpow10_wide = (int)
	    floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.));
    pow10_wide = ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
    u = 1;
    for (i = 0; i < maxpow10_wide; ++i) {
	pow10_wide[i] = u;
	u *= 10;
    }
    pow10_wide[i] = u;








|







4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332

    /*
     * Initialize table of powers of 10 expressed as wide integers.
     */

    maxpow10_wide = (int)
	    floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.));
    pow10_wide = Tcl_Alloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
    u = 1;
    for (i = 0; i < maxpow10_wide; ++i) {
	pow10_wide[i] = u;
	u *= 10;
    }
    pow10_wide[i] = u;

4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
 */

void
TclFinalizeDoubleConversion(void)
{
    int i;

    ckfree(pow10_wide);
    for (i=0; i<9; ++i) {
	mp_clear(pow5 + i);
    }
    for (i=0; i < 5; ++i) {
	mp_clear(pow5_13 + i);
    }
}







|







4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
 */

void
TclFinalizeDoubleConversion(void)
{
    int i;

    Tcl_Free(pow10_wide);
    for (i=0; i<9; ++i) {
	mp_clear(pow5 + i);
    }
    for (i=0; i < 5; ++i) {
	mp_clear(pow5_13 + i);
    }
}
Changes to generic/tclStringObj.c.
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
/*
 * Prototypes for functions defined later in this file:
 */

static void		AppendPrintfToObjVA(Tcl_Obj *objPtr,
			    const char *format, va_list argList);
static void		AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, int appendNumChars);
static void		AppendUnicodeToUtfRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, int numChars);
static void		AppendUtfToUnicodeRep(Tcl_Obj *objPtr,
			    const char *bytes, int numBytes);
static void		AppendUtfToUtfRep(Tcl_Obj *objPtr,
			    const char *bytes, int numBytes);
static void		DupStringInternalRep(Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr);
static int		ExtendStringRepWithUnicode(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, int numChars);
static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
			    const char *bytes, int numBytes,
			    int numAppendChars);
static void		FillUnicodeRep(Tcl_Obj *objPtr);
static void		FreeStringInternalRep(Tcl_Obj *objPtr);
static void		GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag);
static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed);
static int		SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		SetUnicodeObj(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, int numChars);
static int		UnicodeLength(const Tcl_UniChar *unicode);
static void		UpdateStringOfString(Tcl_Obj *objPtr);

/*
 * The structure below defines the string Tcl object type by means of
 * functions that can be invoked by generic object code.
 */








|

|

|

|


|
|

|
|


|
|


|
|







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
/*
 * Prototypes for functions defined later in this file:
 */

static void		AppendPrintfToObjVA(Tcl_Obj *objPtr,
			    const char *format, va_list argList);
static void		AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t appendNumChars);
static void		AppendUnicodeToUtfRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t numChars);
static void		AppendUtfToUnicodeRep(Tcl_Obj *objPtr,
			    const char *bytes, size_t numBytes);
static void		AppendUtfToUtfRep(Tcl_Obj *objPtr,
			    const char *bytes, size_t numBytes);
static void		DupStringInternalRep(Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr);
static size_t		ExtendStringRepWithUnicode(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t numChars);
static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
			    const char *bytes, size_t numBytes,
			    size_t numAppendChars);
static void		FillUnicodeRep(Tcl_Obj *objPtr);
static void		FreeStringInternalRep(Tcl_Obj *objPtr);
static void		GrowStringBuffer(Tcl_Obj *objPtr, size_t needed, int flag);
static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, size_t needed);
static int		SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		SetUnicodeObj(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t numChars);
static size_t		UnicodeLength(const Tcl_UniChar *unicode);
static void		UpdateStringOfString(Tcl_Obj *objPtr);

/*
 * The structure below defines the string Tcl object type by means of
 * functions that can be invoked by generic object code.
 */

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
#ifndef TCL_MIN_UNICHAR_GROWTH
#define TCL_MIN_UNICHAR_GROWTH	TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif

static void
GrowStringBuffer(
    Tcl_Obj *objPtr,
    int needed,
    int flag)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->allocated
     *	flag || objPtr->bytes != NULL
     */

    String *stringPtr = GET_STRING(objPtr);
    char *ptr = NULL;
    int attempt;

    if (objPtr->bytes == &tclEmptyString) {
	objPtr->bytes = NULL;
    }
    if (flag == 0 || stringPtr->allocated > 0) {
	if (needed <= INT_MAX / 2) {
	    attempt = 2 * needed;
	    ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
	}
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
	}
    }
    if (ptr == NULL) {
	/*
	 * First allocation - just big enough; or last chance fallback.
	 */

	attempt = needed;
	ptr = ckrealloc(objPtr->bytes, attempt + 1);
    }
    objPtr->bytes = ptr;
    stringPtr->allocated = attempt;
}

static void
GrowUnicodeBuffer(
    Tcl_Obj *objPtr,
    int needed)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->maxChars
     *	needed < STRING_MAXCHARS
     */

    String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
    int attempt;

    if (stringPtr->maxChars > 0) {
	/*
	 * Subsequent appends - apply the growth algorithm.
	 */

	if (needed <= STRING_MAXCHARS / 2) {
	    attempt = 2 * needed;
	    ptr = stringAttemptRealloc(stringPtr, attempt);
	}
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    unsigned int limit = STRING_MAXCHARS - needed;
	    unsigned int extra = needed - stringPtr->numChars
		    + TCL_MIN_UNICHAR_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = stringAttemptRealloc(stringPtr, attempt);
	}
    }
    if (ptr == NULL) {
	/*







|











|





|

|







|
|
|


|








|








|









|
















|
|

|







119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
#ifndef TCL_MIN_UNICHAR_GROWTH
#define TCL_MIN_UNICHAR_GROWTH	TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif

static void
GrowStringBuffer(
    Tcl_Obj *objPtr,
    size_t needed,
    int flag)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->allocated
     *	flag || objPtr->bytes != NULL
     */

    String *stringPtr = GET_STRING(objPtr);
    char *ptr = NULL;
    size_t attempt;

    if (objPtr->bytes == &tclEmptyString) {
	objPtr->bytes = NULL;
    }
    if (flag == 0 || stringPtr->allocated > 0) {
	if (needed <= STRING_MAXCHARS / 2) {
	    attempt = 2 * needed;
	    ptr = Tcl_AttemptRealloc(objPtr->bytes, attempt + 1);
	}
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    size_t limit = INT_MAX - needed;
	    size_t extra = needed - objPtr->length + TCL_MIN_GROWTH;
	    size_t growth = (extra > limit) ? limit : extra;

	    attempt = needed + growth;
	    ptr = Tcl_AttemptRealloc(objPtr->bytes, attempt + 1);
	}
    }
    if (ptr == NULL) {
	/*
	 * First allocation - just big enough; or last chance fallback.
	 */

	attempt = needed;
	ptr = Tcl_Realloc(objPtr->bytes, attempt + 1);
    }
    objPtr->bytes = ptr;
    stringPtr->allocated = attempt;
}

static void
GrowUnicodeBuffer(
    Tcl_Obj *objPtr,
    size_t needed)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->maxChars
     *	needed < STRING_MAXCHARS
     */

    String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
    size_t attempt;

    if (stringPtr->maxChars > 0) {
	/*
	 * Subsequent appends - apply the growth algorithm.
	 */

	if (needed <= STRING_MAXCHARS / 2) {
	    attempt = 2 * needed;
	    ptr = stringAttemptRealloc(stringPtr, attempt);
	}
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    size_t limit = STRING_MAXCHARS - needed;
	    size_t extra = needed - stringPtr->numChars
		    + TCL_MIN_UNICHAR_GROWTH;
	    size_t growth = (extra > limit) ? limit : extra;

	    attempt = needed + growth;
	    ptr = stringAttemptRealloc(stringPtr, attempt);
	}
    }
    if (ptr == NULL) {
	/*
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewStringObj
Tcl_Obj *
Tcl_NewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    int length)			/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * negative, use bytes up to the first NUL
				 * byte. */
{
    return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    int length)			/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * negative, use bytes up to the first NUL
				 * byte. */
{
    Tcl_Obj *objPtr;

    if (length < 0) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclNewStringObj(objPtr, bytes, length);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */








|











|






|







250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewStringObj
Tcl_Obj *
Tcl_NewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length)			/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * negative, use bytes up to the first NUL
				 * byte. */
{
    return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length)		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * negative, use bytes up to the first NUL
				 * byte. */
{
    Tcl_Obj *objPtr;

    if (length == (size_t)-1) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclNewStringObj(objPtr, bytes, length);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */

311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
 */

#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    int length,			/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * negative, use bytes up to the first NUL
				 * byte. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;

    if (length < 0) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclDbNewObj(objPtr, file, line);
    TclInitStringRep(objPtr, bytes, length);
    return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    int length,			/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * negative, use bytes up to the first NUL
				 * byte. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    return Tcl_NewStringObj(bytes, length);







|

|








|











|

|







311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
 */

#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length,		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * (size_t)-1, use bytes up to the first NUL
				 * byte. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;

    if (length == (size_t)-1) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclDbNewObj(objPtr, file, line);
    TclInitStringRep(objPtr, bytes, length);
    return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length,		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * (size_t)-1, use bytes up to the first NUL
				 * byte. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    return Tcl_NewStringObj(bytes, length);
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_NewUnicodeObj(
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * new object. */
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
    return objPtr;







|







370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_NewUnicodeObj(
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * new object. */
    size_t numChars)		/* Number of characters in the unicode
				 * string. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
    return objPtr;
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
 * Side effects:
 *	Frees old internal rep. Allocates memory for new "String" internal
 *	rep.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    String *stringPtr;
    int numChars;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */







|





|







397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
 * Side effects:
 *	Frees old internal rep. Allocates memory for new "String" internal
 *	rep.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_GetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    String *stringPtr;
    size_t numChars;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
     * machinery behind that test is using a proper bytearray ObjType.  We
     * could also compute length of an improper bytearray without shimmering
     * but there's no value in that. We *want* to shimmer an improper bytearray
     * because improper bytearrays have worthless internal reps.
     */

    if (TclIsPureByteArray(objPtr)) {
	int length;

	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
	return length;
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);
    numChars = stringPtr->numChars;

    /*
     * If numChars is unknown, compute it.
     */

    if (numChars == -1) {
	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;
    }
    return numChars;
}

/*







<
<
|
|














|







426
427
428
429
430
431
432


433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
     * machinery behind that test is using a proper bytearray ObjType.  We
     * could also compute length of an improper bytearray without shimmering
     * but there's no value in that. We *want* to shimmer an improper bytearray
     * because improper bytearrays have worthless internal reps.
     */

    if (TclIsPureByteArray(objPtr)) {


	(void) TclGetByteArrayFromObj(objPtr, &numChars);
	return numChars;
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);
    numChars = stringPtr->numChars;

    /*
     * If numChars is unknown, compute it.
     */

    if (numChars == (size_t)-1) {
	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;
    }
    return numChars;
}

/*
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536

537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
 *----------------------------------------------------------------------
 */

int
Tcl_GetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    int index)			/* Get the index'th Unicode character. */
{
    String *stringPtr;
    int ch, length;

    if (index < 0) {
	return -1;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the indexing operation.
     */

    if (TclIsPureByteArray(objPtr)) {

	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	return (int) bytes[index];
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == -1) {
	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    return (Tcl_UniChar) objPtr->bytes[index];
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);







|


|
<
<
<
<







>
|




|














|







513
514
515
516
517
518
519
520
521
522
523




524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
 *----------------------------------------------------------------------
 */

int
Tcl_GetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    size_t index)		/* Get the index'th Unicode character. */
{
    String *stringPtr;
    int ch;





    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the indexing operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	size_t length;
	unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	return bytes[index];
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == (size_t)-1) {
	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    return (Tcl_UniChar) objPtr->bytes[index];
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663



664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_GetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    int first,			/* First index of the range. */
    int last)			/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    String *stringPtr;
    int length;

    if (first < 0) {
	first = 0;



    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the substring operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);

	if (last >= length) {
	    last = length - 1;
	}
	if (last < first) {
	    return Tcl_NewObj();
	}







|
|



|

|

>
>
>








|







643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_GetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    size_t first,			/* First index of the range. */
    size_t last)			/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    String *stringPtr;
    size_t length;

    if (first == (size_t)-1) {
	first = 0;
    }
    if (last + 2 <= first + 1) {
	return Tcl_NewObj();
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the substring operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length);

	if (last >= length) {
	    last = length - 1;
	}
	if (last < first) {
	    return Tcl_NewObj();
	}
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == -1) {
	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    if (last >= stringPtr->numChars) {
		last = stringPtr->numChars - 1;
	    }
	    if (last < first) {







|







686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == (size_t)-1) {
	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    if (last >= stringPtr->numChars) {
		last = stringPtr->numChars - 1;
	    }
	    if (last < first) {
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
	last = stringPtr->numChars;
    }
    if (last < first) {
	return Tcl_NewObj();
    }
#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);
}







|



|







718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
	last = stringPtr->numChars;
    }
    if (last < first) {
	return Tcl_NewObj();
    }
#if TCL_UTF_MAX <= 4
    /* See: bug [11ae2be95dac9417] */
    if ((first + 1 > 1) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
	++first;
    }
    if ((last + 2 < stringPtr->numChars + 1)
	    && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
	++last;
    }
#endif
    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
 */

void
Tcl_SetStringObj(
    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the object. */
    int length)			/* The number of bytes to copy from "bytes"
				 * when initializing the object. If negative,
				 * use bytes up to the first NUL byte.*/
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
    }

    /*
     * Set the type to NULL and free any internal rep for the old type.
     */

    TclFreeIntRep(objPtr);

    /*
     * Free any old string rep, then set the string rep to a copy of the
     * length bytes starting at "bytes".
     */

    TclInvalidateStringRep(objPtr);
    if (length < 0) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclInitStringRep(objPtr, bytes, length);
}

/*
 *----------------------------------------------------------------------







|
|


















|







757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
 */

void
Tcl_SetStringObj(
    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the object. */
    size_t length)		/* The number of bytes to copy from "bytes"
				 * when initializing the object. If (size_t)-1,
				 * use bytes up to the first NUL byte.*/
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
    }

    /*
     * Set the type to NULL and free any internal rep for the old type.
     */

    TclFreeIntRep(objPtr);

    /*
     * Free any old string rep, then set the string rep to a copy of the
     * length bytes starting at "bytes".
     */

    TclInvalidateStringRep(objPtr);
    if (length == (size_t)-1) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclInitStringRep(objPtr, bytes, length);
}

/*
 *----------------------------------------------------------------------
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
 *----------------------------------------------------------------------
 */

void
Tcl_SetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    int length)			/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;

    if (length < 0) {
	/*
	 * Setting to a negative length is nonsense. This is probably the
	 * result of overflowing the signed integer range.
	 */

	Tcl_Panic("Tcl_SetObjLength: negative length requested: "
		"%d (integer overflow?)", length);
    }
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
    }

    if (objPtr->bytes && objPtr->length == length) {
	return;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (objPtr->bytes != NULL) {
	/*
	 * Change length of an existing string rep.
	 */
	if (length > stringPtr->allocated) {
	    /*
	     * Need to enlarge the buffer.
	     */
	    if (objPtr->bytes == &tclEmptyString) {
		objPtr->bytes = ckalloc(length + 1);
	    } else {
		objPtr->bytes = ckrealloc(objPtr->bytes, length + 1);
	    }
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	stringCheckLimits(length);







|





<
<
<
<
<
<
<
<
<




















|

|











|







810
811
812
813
814
815
816
817
818
819
820
821
822









823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
 *----------------------------------------------------------------------
 */

void
Tcl_SetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    size_t length)		/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;










    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
    }

    if (objPtr->bytes && objPtr->length == length) {
	return;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (objPtr->bytes != NULL) {
	/*
	 * Change length of an existing string rep.
	 */
	if (length > stringPtr->allocated) {
	    /*
	     * Need to enlarge the buffer.
	     */
	    if (objPtr->bytes == &tclEmptyString) {
		objPtr->bytes = Tcl_Alloc(length + 1);
	    } else {
		objPtr->bytes = Tcl_Realloc(objPtr->bytes, length + 1);
	    }
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = (size_t)-1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	stringCheckLimits(length);
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
 *----------------------------------------------------------------------
 */

int
Tcl_AttemptSetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    int length)			/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;

    if (length < 0) {
	/*
	 * Setting to a negative length is nonsense. This is probably the
	 * result of overflowing the signed integer range.
	 */

	return 0;
    }
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
    }
    if (objPtr->bytes && objPtr->length == length) {
	return 1;
    }








|





<
<
<
<
<
<
<
<







906
907
908
909
910
911
912
913
914
915
916
917
918








919
920
921
922
923
924
925
 *----------------------------------------------------------------------
 */

int
Tcl_AttemptSetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    size_t length)		/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;









    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
    }
    if (objPtr->bytes && objPtr->length == length) {
	return 1;
    }

953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
	    /*
	     * Need to enlarge the buffer.
	     */

	    char *newBytes;

	    if (objPtr->bytes == &tclEmptyString) {
		newBytes = attemptckalloc(length + 1);
	    } else {
		newBytes = attemptckrealloc(objPtr->bytes, length + 1);
	    }
	    if (newBytes == NULL) {
		return 0;
	    }
	    objPtr->bytes = newBytes;
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	if (length > STRING_MAXCHARS) {







|

|















|







934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
	    /*
	     * Need to enlarge the buffer.
	     */

	    char *newBytes;

	    if (objPtr->bytes == &tclEmptyString) {
		newBytes = Tcl_AttemptAlloc(length + 1);
	    } else {
		newBytes = Tcl_AttemptRealloc(objPtr->bytes, length + 1);
	    }
	    if (newBytes == NULL) {
		return 0;
	    }
	    objPtr->bytes = newBytes;
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = (size_t)-1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	if (length > STRING_MAXCHARS) {
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
 */

void
Tcl_SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * object. */
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
    }
    TclFreeIntRep(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
}

static int
UnicodeLength(
    const Tcl_UniChar *unicode)
{
    int numChars = 0;

    if (unicode) {
	while (numChars >= 0 && unicode[numChars] != 0) {
	    numChars++;
	}
    }
    stringCheckLimits(numChars);
    return numChars;
}

static void
SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * object. */
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    String *stringPtr;

    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

    /*
     * Allocate enough space for the String structure + Unicode string.
     */








|









|



|


|












|




|







1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
 */

void
Tcl_SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * object. */
    size_t numChars)		/* Number of characters in the unicode
				 * string. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
    }
    TclFreeIntRep(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
}

static size_t
UnicodeLength(
    const Tcl_UniChar *unicode)
{
    size_t numChars = 0;

    if (unicode) {
	while (numChars != (size_t)-1 && unicode[numChars] != 0) {
	    numChars++;
	}
    }
    stringCheckLimits(numChars);
    return numChars;
}

static void
SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * object. */
    size_t numChars)		/* Number of characters in the unicode
				 * string. */
{
    String *stringPtr;

    if (numChars == (size_t)-1) {
	numChars = UnicodeLength(unicode);
    }

    /*
     * Allocate enough space for the String structure + Unicode string.
     */

1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
 */

void
Tcl_AppendLimitedToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* Points to the bytes to append to the
				 * object. */
    int length,			/* The number of bytes available to be
				 * appended from "bytes". If < 0, then all
				 * bytes up to a NUL byte are available. */
    int limit,			/* The maximum number of bytes to append to
				 * the object. */
    const char *ellipsis)	/* Ellipsis marker string, appended to the
				 * object to indicate not all available bytes
				 * at "bytes" were appended. */
{
    String *stringPtr;
    int toCopy = 0;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
    }

    if (length < 0) {
	length = (bytes ? strlen(bytes) : 0);
    }
    if (length == 0) {
	return;
    }

    if (length <= limit) {
	toCopy = length;
    } else {
	if (ellipsis == NULL) {
	    ellipsis = "...";
	}
	toCopy = (bytes == NULL) ? limit
		: Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
    }

    /*
     * If objPtr has a valid Unicode rep, then append the Unicode conversion
     * of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to
     * objPtr's string rep.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= limit) {
	return;
    }

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
	AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis));
    } else {
	AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis));
    }
}

/*







|
|
|
|






|





|













|











|










|







1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
 */

void
Tcl_AppendLimitedToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* Points to the bytes to append to the
				 * object. */
    size_t length,		/* The number of bytes available to be
				 * appended from "bytes". If (size_t)-1, then
				 * all bytes up to a NUL byte are available. */
    size_t limit,		/* The maximum number of bytes to append to
				 * the object. */
    const char *ellipsis)	/* Ellipsis marker string, appended to the
				 * object to indicate not all available bytes
				 * at "bytes" were appended. */
{
    String *stringPtr;
    size_t toCopy = 0;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
    }

    if (length == (size_t)-1) {
	length = (bytes ? strlen(bytes) : 0);
    }
    if (length == 0) {
	return;
    }

    if (length <= limit) {
	toCopy = length;
    } else {
	if (ellipsis == NULL) {
	    ellipsis = "...";
	}
	toCopy = (bytes == NULL) ? limit
		: (size_t)(Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes);
    }

    /*
     * If objPtr has a valid Unicode rep, then append the Unicode conversion
     * of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to
     * objPtr's string rep.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) {
	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= limit) {
	return;
    }

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) {
	AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis));
    } else {
	AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis));
    }
}

/*
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
 */

void
Tcl_AppendToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* Points to the bytes to append to the
				 * object. */
    int length)			/* The number of bytes to append from "bytes".
				 * If < 0, then append all bytes up to NUL
				 * byte. */
{
    Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendUnicodeToObj --
 *







|
|


|







1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
 */

void
Tcl_AppendToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* Points to the bytes to append to the
				 * object. */
    size_t length)		/* The number of bytes to append from "bytes".
				 * If (size_t)-1, then append all bytes up to NUL
				 * byte. */
{
    Tcl_AppendLimitedToObj(objPtr, bytes, length, (size_t)-1, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendUnicodeToObj --
 *
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
 */

void
Tcl_AppendUnicodeToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* The unicode string to append to the
				 * object. */
    int length)			/* Number of chars in "unicode". */
{
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
    }








|







1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
 */

void
Tcl_AppendUnicodeToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* The unicode string to append to the
				 * object. */
    size_t length)		/* Number of chars in "unicode". */
{
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
    }

1273
1274
1275
1276
1277
1278
1279
1280

1281
1282
1283
1284
1285
1286
1287

void
Tcl_AppendObjToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    Tcl_Obj *appendObjPtr)	/* Object to append. */
{
    String *stringPtr;
    int length, numChars, appendNumChars = -1;

    const char *bytes;

    /*
     * Special case: second object is standard-empty is fast case. We know
     * that appending nothing to anything leaves that starting anything...
     */








|
>







1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269

void
Tcl_AppendObjToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    Tcl_Obj *appendObjPtr)	/* Object to append. */
{
    String *stringPtr;
    size_t length, numChars;
    size_t appendNumChars = (size_t)-1;
    const char *bytes;

    /*
     * Special case: second object is standard-empty is fast case. We know
     * that appending nothing to anything leaves that starting anything...
     */

1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
     */

    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
	    && TclIsPureByteArray(appendObjPtr)) {
	/*
	 * You might expect the code here to be
	 *
	 *  bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
	 *  TclAppendBytesToByteArray(objPtr, bytes, length);
	 *
	 * and essentially all of the time that would be fine. However, it
	 * would run into trouble in the case where objPtr and appendObjPtr
	 * point to the same thing. That may never be a good idea. It seems to
	 * violate Copy On Write, and we don't have any tests for the
	 * situation, since making any Tcl commands that call
	 * Tcl_AppendObjToObj() do that appears impossible (They honor Copy On
	 * Write!). For the sake of extensions that go off into that realm,
	 * though, here's a more complex approach that can handle all the
	 * cases.
	 *
	 * First, get the lengths.
	 */

	int lengthSrc;

	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
	(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);

	/*
	 * Grow buffer enough for the append.
	 */

	TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);








|















|

|
|







1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
     */

    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
	    && TclIsPureByteArray(appendObjPtr)) {
	/*
	 * You might expect the code here to be
	 *
	 *  bytes = TclGetByteArrayFromObj(appendObjPtr, &length);
	 *  TclAppendBytesToByteArray(objPtr, bytes, length);
	 *
	 * and essentially all of the time that would be fine. However, it
	 * would run into trouble in the case where objPtr and appendObjPtr
	 * point to the same thing. That may never be a good idea. It seems to
	 * violate Copy On Write, and we don't have any tests for the
	 * situation, since making any Tcl commands that call
	 * Tcl_AppendObjToObj() do that appears impossible (They honor Copy On
	 * Write!). For the sake of extensions that go off into that realm,
	 * though, here's a more complex approach that can handle all the
	 * cases.
	 *
	 * First, get the lengths.
	 */

	size_t lengthSrc;

	(void) TclGetByteArrayFromObj(objPtr, &length);
	(void) TclGetByteArrayFromObj(appendObjPtr, &lengthSrc);

	/*
	 * Grow buffer enough for the append.
	 */

	TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);

1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
    if (stringPtr->hasUnicode) {
	/*
	 * If appendObjPtr is not of the "String" type, don't convert it.
	 */

	if (appendObjPtr->typePtr == &tclStringType) {
	    Tcl_UniChar *unicode =
		    Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);

	    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
	} else {
	    bytes = TclGetStringFromObj(appendObjPtr, &length);
	    AppendUtfToUnicodeRep(objPtr, bytes, length);
	}
	return;
    }

    /*
     * Append to objPtr's UTF string rep. If we know the number of characters
     * in both objects before appending, then set the combined number of
     * characters in the final (appended-to) object.
     */

    bytes = TclGetStringFromObj(appendObjPtr, &length);

    numChars = stringPtr->numChars;
    if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);

	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if (numChars >= 0 && appendNumChars >= 0) {
	stringPtr->numChars = numChars + appendNumChars;
    }
}

/*
 *----------------------------------------------------------------------
 *







|


















|







|







1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
    if (stringPtr->hasUnicode) {
	/*
	 * If appendObjPtr is not of the "String" type, don't convert it.
	 */

	if (appendObjPtr->typePtr == &tclStringType) {
	    Tcl_UniChar *unicode =
		    TclGetUnicodeFromObj(appendObjPtr, &numChars);

	    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
	} else {
	    bytes = TclGetStringFromObj(appendObjPtr, &length);
	    AppendUtfToUnicodeRep(objPtr, bytes, length);
	}
	return;
    }

    /*
     * Append to objPtr's UTF string rep. If we know the number of characters
     * in both objects before appending, then set the combined number of
     * characters in the final (appended-to) object.
     */

    bytes = TclGetStringFromObj(appendObjPtr, &length);

    numChars = stringPtr->numChars;
    if ((numChars != (size_t)-1) && (appendObjPtr->typePtr == &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);

	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if (numChars != (size_t)-1 && appendNumChars != (size_t)-1) {
	stringPtr->numChars = numChars + appendNumChars;
    }
}

/*
 *----------------------------------------------------------------------
 *
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to append. */
    int appendNumChars)		/* Number of chars of "unicode" to append. */
{
    String *stringPtr;
    int numChars;

    if (appendNumChars < 0) {
	appendNumChars = UnicodeLength(unicode);
    }
    if (appendNumChars == 0) {
	return;
    }

    SetStringFromAny(NULL, objPtr);







|


|

|







1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to append. */
    size_t appendNumChars)		/* Number of chars of "unicode" to append. */
{
    String *stringPtr;
    size_t numChars;

    if (appendNumChars == (size_t)-1) {
	appendNumChars = UnicodeLength(unicode);
    }
    if (appendNumChars == 0) {
	return;
    }

    SetStringFromAny(NULL, objPtr);
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
     * explanation of this growth algorithm.
     */

    numChars = stringPtr->numChars + appendNumChars;
    stringCheckLimits(numChars);

    if (numChars > stringPtr->maxChars) {
	int offset = -1;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    offset = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_STRING(objPtr);

	/*
	 * Relocate unicode if needed; see above.
	 */

	if (offset >= 0) {
	    unicode = stringPtr->unicode + offset;
	}
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.







|



















|







1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
     * explanation of this growth algorithm.
     */

    numChars = stringPtr->numChars + appendNumChars;
    stringCheckLimits(numChars);

    if (numChars > stringPtr->maxChars) {
	size_t offset = (size_t)-1;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    offset = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_STRING(objPtr);

	/*
	 * Relocate unicode if needed; see above.
	 */

	if (offset != (size_t)-1) {
	    unicode = stringPtr->unicode + offset;
	}
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to convert to UTF. */
    int numChars)		/* Number of chars of "unicode" to convert. */
{
    String *stringPtr = GET_STRING(objPtr);

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

    if (stringPtr->numChars != -1) {
	stringPtr->numChars += numChars;
    }
}

/*
 *----------------------------------------------------------------------
 *







|





|







1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to convert to UTF. */
    size_t numChars)		/* Number of chars of "unicode" to convert. */
{
    String *stringPtr = GET_STRING(objPtr);

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

    if (stringPtr->numChars != (size_t)-1) {
	stringPtr->numChars += numChars;
    }
}

/*
 *----------------------------------------------------------------------
 *
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
 *----------------------------------------------------------------------
 */

static void
AppendUtfToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to convert to Unicode. */
    int numBytes)		/* Number of bytes of "bytes" to convert. */
{
    String *stringPtr;

    if (numBytes == 0) {
	return;
    }








|







1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
 *----------------------------------------------------------------------
 */

static void
AppendUtfToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to convert to Unicode. */
    size_t numBytes)		/* Number of bytes of "bytes" to convert. */
{
    String *stringPtr;

    if (numBytes == 0) {
	return;
    }

1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
 *----------------------------------------------------------------------
 */

static void
AppendUtfToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to append. */
    int numBytes)		/* Number of bytes of "bytes" to append. */
{
    String *stringPtr;
    int newLength, oldLength;

    if (numBytes == 0) {
	return;
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    if (objPtr->bytes == NULL) {
	objPtr->length = 0;
    }
    oldLength = objPtr->length;
    newLength = numBytes + oldLength;
    if (newLength < 0) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    stringPtr = GET_STRING(objPtr);
    if (newLength > stringPtr->allocated) {
	int offset = -1;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */








|


|















<
<
<



|







1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577



1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
 *----------------------------------------------------------------------
 */

static void
AppendUtfToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to append. */
    size_t numBytes)		/* Number of bytes of "bytes" to append. */
{
    String *stringPtr;
    size_t newLength, oldLength;

    if (numBytes == 0) {
	return;
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    if (objPtr->bytes == NULL) {
	objPtr->length = 0;
    }
    oldLength = objPtr->length;
    newLength = numBytes + oldLength;




    stringPtr = GET_STRING(objPtr);
    if (newLength > stringPtr->allocated) {
	size_t offset = (size_t)-1;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642

	GrowStringBuffer(objPtr, newLength, 0);

	/*
	 * Relocate bytes if needed; see above.
	 */

	if (offset >= 0) {
	    bytes = objPtr->bytes + offset;
	}
    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = -1;
    stringPtr->hasUnicode = 0;

    if (bytes) {
	memmove(objPtr->bytes + oldLength, bytes, numBytes);
    }
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;







|








|







1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621

	GrowStringBuffer(objPtr, newLength, 0);

	/*
	 * Relocate bytes if needed; see above.
	 */

	if (offset != (size_t)-1) {
	    bytes = objPtr->bytes + offset;
	}
    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = (size_t)-1;
    stringPtr->hasUnicode = 0;

    if (bytes) {
	memmove(objPtr->bytes + oldLength, bytes, numBytes);
    }
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
	"\"%n$\" argument index out of range"
    };
    static const char *overflow = "max size for a Tcl value exceeded";

    if (Tcl_IsShared(appendObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
    }
    TclGetStringFromObj(appendObj, &originalLength);
    limit = INT_MAX - originalLength;

    /*
     * Format string is NUL-terminated.
     */

    while (*format != '\0') {







|







1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
	"\"%n$\" argument index out of range"
    };
    static const char *overflow = "max size for a Tcl value exceeded";

    if (Tcl_IsShared(appendObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
    }
    (void)TclGetStringFromObj(appendObj, &originalLength);
    limit = INT_MAX - originalLength;

    /*
     * Format string is NUL-terminated.
     */

    while (*format != '\0') {
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
			goto errorMsg;
		    } else {
			ch = 'd';
		    }
		}
#ifndef TCL_WIDE_INT_IS_LONG
	    } else if (useWide) {
		if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
		    Tcl_Obj *objPtr;

		    if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
			goto error;
		    }
		    mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big);
		    objPtr = Tcl_NewBignumObj(&big);
		    Tcl_IncrRefCount(objPtr);
		    TclGetWideIntFromObj(NULL, objPtr, &w);
		    Tcl_DecrRefCount(objPtr);
		}
		isNegative = (w < (Tcl_WideInt) 0);
		if (w == (Tcl_WideInt) 0) gotHash = 0;
#endif
	    } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
		if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
		    Tcl_Obj *objPtr;

		    if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
			goto error;
		    }
		    mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
		    objPtr = Tcl_NewBignumObj(&big);
		    Tcl_IncrRefCount(objPtr);
		    TclGetLongFromObj(NULL, objPtr, &l);
		    Tcl_DecrRefCount(objPtr);
		} else {
		    l = Tcl_WideAsLong(w);
		}
		if (useShort) {
		    s = (short) l;
		    isNegative = (s < (short) 0);
		    if (s == (short) 0) gotHash = 0;
		} else {
		    isNegative = (l < (long) 0);







|
<
<
<
|
<
<
<
<
<
<





|
<
<
<
|
<
<
<
<
<
<

|







2016
2017
2018
2019
2020
2021
2022
2023



2024






2025
2026
2027
2028
2029
2030



2031






2032
2033
2034
2035
2036
2037
2038
2039
2040
			goto errorMsg;
		    } else {
			ch = 'd';
		    }
		}
#ifndef TCL_WIDE_INT_IS_LONG
	    } else if (useWide) {
		if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) {



		    goto error;






		}
		isNegative = (w < (Tcl_WideInt) 0);
		if (w == (Tcl_WideInt) 0) gotHash = 0;
#endif
	    } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
		if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) {



		    goto error;






		} else {
		    l = (long) w;
		}
		if (useShort) {
		    s = (short) l;
		    isNegative = (s < (short) 0);
		    if (s == (short) 0) gotHash = 0;
		} else {
		    isNegative = (l < (long) 0);
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
	    switch (ch) {
	    case 'd': {
		int length;
		Tcl_Obj *pure;
		const char *bytes;

		if (useShort) {
		    pure = Tcl_NewIntObj((int) s);
#ifndef TCL_WIDE_INT_IS_LONG
		} else if (useWide) {
		    pure = Tcl_NewWideIntObj(w);
#endif
		} else if (useBig) {
		    pure = Tcl_NewBignumObj(&big);
		} else {







|







2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
	    switch (ch) {
	    case 'd': {
		int length;
		Tcl_Obj *pure;
		const char *bytes;

		if (useShort) {
		    pure = Tcl_NewIntObj(s);
#ifndef TCL_WIDE_INT_IS_LONG
		} else if (useWide) {
		    pure = Tcl_NewWideIntObj(w);
#endif
		} else if (useBig) {
		    pure = Tcl_NewBignumObj(&big);
		} else {
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201

	    case 'u':
	    case 'o':
	    case 'p':
	    case 'x':
	    case 'X':
	    case 'b': {
		Tcl_WideUInt bits = (Tcl_WideUInt) 0;
		Tcl_WideInt numDigits = (Tcl_WideInt) 0;
		int length, numBits = 4, base = 16, index = 0, shift = 0;
		Tcl_Obj *pure;
		char *bytes;

		if (ch == 'u') {
		    base = 10;
		} else if (ch == 'o') {







|
|







2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162

	    case 'u':
	    case 'o':
	    case 'p':
	    case 'x':
	    case 'X':
	    case 'b': {
		Tcl_WideUInt bits = 0;
		Tcl_WideInt numDigits = 0;
		int length, numBits = 4, base = 16, index = 0, shift = 0;
		Tcl_Obj *pure;
		char *bytes;

		if (ch == 'u') {
		    base = 10;
		} else if (ch == 'o') {
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
		 * Need to be sure zero becomes "0", not "".
		 */

		if (numDigits == 0) {
		    numDigits = 1;
		}
		pure = Tcl_NewObj();
		Tcl_SetObjLength(pure, (int) numDigits);
		bytes = TclGetString(pure);
		toAppend = length = (int) numDigits;
		while (numDigits--) {
		    int digitOffset;

		    if (useBig && big.used) {
			if (index < big.used && (size_t) shift <
				CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) {
			    bits |= ((Tcl_WideUInt) big.dp[index++]) << shift;
			    shift += DIGIT_BIT;
			}
			shift -= numBits;
		    }
		    digitOffset = (int) (bits % base);
		    if (digitOffset > 9) {
			if (ch == 'X') {
			    bytes[numDigits] = 'A' + digitOffset - 10;
			} else {
			    bytes[numDigits] = 'a' + digitOffset - 10;
			}
		    } else {







|

|











|







2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
		 * Need to be sure zero becomes "0", not "".
		 */

		if (numDigits == 0) {
		    numDigits = 1;
		}
		pure = Tcl_NewObj();
		Tcl_SetObjLength(pure, numDigits);
		bytes = TclGetString(pure);
		toAppend = length = numDigits;
		while (numDigits--) {
		    int digitOffset;

		    if (useBig && big.used) {
			if (index < big.used && (size_t) shift <
				CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) {
			    bits |= ((Tcl_WideUInt) big.dp[index++]) << shift;
			    shift += DIGIT_BIT;
			}
			shift -= numBits;
		    }
		    digitOffset = bits % base;
		    if (digitOffset > 9) {
			if (ch == 'X') {
			    bytes[numDigits] = 'A' + digitOffset - 10;
			} else {
			    bytes[numDigits] = 'a' + digitOffset - 10;
			}
		    } else {
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
	    }
	    while (numChars < width) {
		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
		numChars++;
	    }
	}

	TclGetStringFromObj(segment, &segmentNumBytes);
	if (segmentNumBytes > limit) {
	    if (allocSegment) {
		Tcl_DecrRefCount(segment);
	    }
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;







|







2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
	    }
	    while (numChars < width) {
		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
		numChars++;
	    }
	}

	(void)TclGetStringFromObj(segment, &segmentNumBytes);
	if (segmentNumBytes > limit) {
	    if (allocSegment) {
		Tcl_DecrRefCount(segment);
	    }
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
		/*
		 * Within that buffer, we trim both ends if needed so that we
		 * copy only whole characters, and avoid copying any partial
		 * multi-byte characters.
		 */

		q = Tcl_UtfPrev(end, bytes);
		if (!Tcl_UtfCharComplete(q, (int)(end - q))) {
		    end = q;
		}

		q = bytes + TCL_UTF_MAX;
		while ((bytes < end) && (bytes < q)
			&& ((*bytes & 0xC0) == 0x80)) {
		    bytes++;
		}

		Tcl_ListObjAppendElement(NULL, list,
			Tcl_NewStringObj(bytes , (int)(end - bytes)));

		break;
	    }
	    case 'c':
	    case 'i':
	    case 'u':
	    case 'd':







|










|







2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
		/*
		 * Within that buffer, we trim both ends if needed so that we
		 * copy only whole characters, and avoid copying any partial
		 * multi-byte characters.
		 */

		q = Tcl_UtfPrev(end, bytes);
		if (!Tcl_UtfCharComplete(q, (end - q))) {
		    end = q;
		}

		q = bytes + TCL_UTF_MAX;
		while ((bytes < end) && (bytes < q)
			&& ((*bytes & 0xC0) == 0x80)) {
		    bytes++;
		}

		Tcl_ListObjAppendElement(NULL, list,
			Tcl_NewStringObj(bytes , (end - bytes)));

		break;
	    }
	    case 'c':
	    case 'i':
	    case 'u':
	    case 'd':
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
		} else {
			Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
				va_arg(argList, double)));
		}
		seekingConversion = 0;
		break;
	    case '*':
		lastNum = (int) va_arg(argList, int);
		Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
		p++;
		break;
	    case '0': case '1': case '2': case '3': case '4':
	    case '5': case '6': case '7': case '8': case '9': {
		char *end;

		lastNum = (int) strtoul(p, &end, 10);
		p = end;
		break;
	    }
	    case '.':
		gotPrecision = 1;
		p++;
		break;







|







|







2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
		} else {
			Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
				va_arg(argList, double)));
		}
		seekingConversion = 0;
		break;
	    case '*':
		lastNum = va_arg(argList, int);
		Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
		p++;
		break;
	    case '0': case '1': case '2': case '3': case '4':
	    case '5': case '6': case '7': case '8': case '9': {
		char *end;

		lastNum = strtoul(p, &end, 10);
		p = end;
		break;
	    }
	    case '.':
		gotPrecision = 1;
		p++;
		break;
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringRepeat(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    int count,
    int flags)
{
    Tcl_Obj *objResultPtr;
    int inPlace = flags & TCL_STRING_IN_PLACE;
    int length = 0, unichar = 0, done = 1;
    int binary = TclIsPureByteArray(objPtr);

    /* assert (count >= 2) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.







|




|







2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringRepeat(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    size_t count,
    int flags)
{
    Tcl_Obj *objResultPtr;
    int inPlace = flags & TCL_STRING_IN_PLACE;
    size_t length = 0, unichar = 0, done = 1;
    int binary = TclIsPureByteArray(objPtr);

    /* assert (count >= 2) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
		unichar = 1;
	    }
	}
    }

    if (binary) {
	/* Result will be pure byte array. Pre-size it */
	Tcl_GetByteArrayFromObj(objPtr, &length);
    } else if (unichar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	Tcl_GetUnicodeFromObj(objPtr, &length);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
	Tcl_GetStringFromObj(objPtr, &length);
    }

    if (length == 0) {
	/* Any repeats of empty is empty. */
	return objPtr;
    }








|


|


|







2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
		unichar = 1;
	    }
	}
    }

    if (binary) {
	/* Result will be pure byte array. Pre-size it */
	TclGetByteArrayFromObj(objPtr, &length);
    } else if (unichar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	TclGetUnicodeFromObj(objPtr, &length);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
	(void)TclGetStringFromObj(objPtr, &length);
    }

    if (length == 0) {
	/* Any repeats of empty is empty. */
	return objPtr;
    }

2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
	} else {
	    TclFreeIntRep(objPtr);
	    objResultPtr = objPtr;
	}
        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %u bytes",
			count*length));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {







|







2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
	} else {
	    TclFreeIntRep(objPtr);
	    objResultPtr = objPtr;
	}
        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %" TCL_Z_MODIFIER "u bytes",
			count*length));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
2942
2943
2944
2945
2946
2947
2948
2949

2950
2951
2952
2953
2954
2955
2956
TclStringCat(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[],
    int flags)
{
    Tcl_Obj *objResultPtr, * const *ov;
    int oc, length = 0, binary = 1;

    int allowUniChar = 1, requestUniChar = 0;
    int first = objc - 1;	/* Index of first value possibly not empty */
    int last = 0;		/* Index of last value possibly not empty */
    int inPlace = flags & TCL_STRING_IN_PLACE;

    /* assert ( objc >= 0 ) */








|
>







2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
TclStringCat(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[],
    int flags)
{
    Tcl_Obj *objResultPtr, * const *ov;
    int oc, binary = 1;
	size_t length = 0;
    int allowUniChar = 1, requestUniChar = 0;
    int first = objc - 1;	/* Index of first value possibly not empty */
    int last = 0;		/* Index of last value possibly not empty */
    int inPlace = flags & TCL_STRING_IN_PLACE;

    /* assert ( objc >= 0 ) */

3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
    } while (--oc && (binary || allowUniChar));

    if (binary) {
	/*
	 * Result will be pure byte array. Pre-size it
	 */

	int numBytes;
	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    /*
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to count bytes for the empty strings.
	     */

	    if (TclIsPureByteArray(objPtr)) {
		Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */

		if (numBytes) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    } else if (numBytes > INT_MAX - length) {
			goto overflow;
		    }
		    length += numBytes;
		}
	    }
	} while (--oc);
    } else if (allowUniChar && requestUniChar) {
	/*
	 * Result will be pure Tcl_UniChar array. Pre-size it.
	 */

	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int numChars;

		Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
		if (numChars) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    } else if (numChars > INT_MAX - length) {
			goto overflow;
		    }
		    length += numChars;
		}
	    }
	} while (--oc);
    } else {
	/* Result will be concat of string reps. Pre-size it. */







|












|





<
<
















|

|




<
<







2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989


2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012


3013
3014
3015
3016
3017
3018
3019
    } while (--oc && (binary || allowUniChar));

    if (binary) {
	/*
	 * Result will be pure byte array. Pre-size it
	 */

	size_t numBytes;
	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    /*
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to count bytes for the empty strings.
	     */

	    if (TclIsPureByteArray(objPtr)) {
		TclGetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */

		if (numBytes) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;


		    }
		    length += numBytes;
		}
	    }
	} while (--oc);
    } else if (allowUniChar && requestUniChar) {
	/*
	 * Result will be pure Tcl_UniChar array. Pre-size it.
	 */

	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		size_t numChars;

		TclGetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
		if (numChars) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;


		    }
		    length += numChars;
		}
	    }
	} while (--oc);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107

3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133

3134
3135
3136
3137
3138
3139
3140
3141
3142
3143

		Tcl_Obj *objPtr = *ov++;

		if (objPtr->bytes == NULL) {
		    /* No string rep; Take the chance we can avoid making it */
		    pendingPtr = objPtr;
		} else {
		    Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */
		}
	    } while (--oc && (length == 0) && (pendingPtr == NULL));

	    /*
 	     * Either we found a possibly non-empty value, and we remember
 	     * this index as the first and last such value so far seen,
	     * or (oc == 0) and all values are known empty,
 	     * so first = last = objc - 1 signals the right quick return.
 	     */

	    first = last = objc - oc - 1;

	    if (oc && (length == 0)) {
		int numBytes;

		/* assert ( pendingPtr != NULL ) */

		/*
		 * There's a pending value followed by more values.  Loop over
		 * remaining values generating strings until a non-empty value
		 * is found, or the pending value gets its string generated.
		 */

		do {
		    Tcl_Obj *objPtr = *ov++;
		    Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */

		} while (--oc && numBytes == 0 && pendingPtr->bytes == NULL);

		if (numBytes) {
		    last = objc -oc -1;
		}
		if (oc || numBytes) {
		    Tcl_GetStringFromObj(pendingPtr, &length);
		}
		if (length == 0) {
		    if (numBytes) {
			first = last;
		    }
		} else if (numBytes > INT_MAX - length) {
		    goto overflow;
		}
		length += numBytes;
	    }
	} while (oc && (length == 0));

	while (oc) {
	    int numBytes;
	    Tcl_Obj *objPtr = *ov++;

	    /* assert ( length > 0 && pendingPtr == NULL )  */

	    Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */

	    if (numBytes) {
		last = objc - oc;
		if (numBytes > INT_MAX - length) {
		    goto overflow;
		}
		length += numBytes;
	    }
	    --oc;
	}
    }







|













|











|
>






|





|







|




|
>


|







3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103

		Tcl_Obj *objPtr = *ov++;

		if (objPtr->bytes == NULL) {
		    /* No string rep; Take the chance we can avoid making it */
		    pendingPtr = objPtr;
		} else {
		    (void)TclGetStringFromObj(objPtr, &length); /* PANIC? */
		}
	    } while (--oc && (length == 0) && (pendingPtr == NULL));

	    /*
 	     * Either we found a possibly non-empty value, and we remember
 	     * this index as the first and last such value so far seen,
	     * or (oc == 0) and all values are known empty,
 	     * so first = last = objc - 1 signals the right quick return.
 	     */

	    first = last = objc - oc - 1;

	    if (oc && (length == 0)) {
		size_t numBytes;

		/* assert ( pendingPtr != NULL ) */

		/*
		 * There's a pending value followed by more values.  Loop over
		 * remaining values generating strings until a non-empty value
		 * is found, or the pending value gets its string generated.
		 */

		do {
		    Tcl_Obj *objPtr = *ov++;
		    Tcl_GetString(objPtr); /* PANIC? */
		    numBytes = objPtr->length;
		} while (--oc && numBytes == 0 && pendingPtr->bytes == NULL);

		if (numBytes) {
		    last = objc -oc -1;
		}
		if (oc || numBytes) {
		    (void)TclGetStringFromObj(pendingPtr, &length);
		}
		if (length == 0) {
		    if (numBytes) {
			first = last;
		    }
		} else if (numBytes + length > (size_t)INT_MAX) {
		    goto overflow;
		}
		length += numBytes;
	    }
	} while (oc && (length == 0));

	while (oc) {
	    size_t numBytes;
	    Tcl_Obj *objPtr = *ov++;

	    /* assert ( length > 0 && pendingPtr == NULL )  */

	    Tcl_GetString(objPtr); /* PANIC? */
	    numBytes = objPtr->length;
	    if (numBytes) {
		last = objc - oc;
		if (numBytes + length > (size_t)INT_MAX) {
		    goto overflow;
		}
		length += numBytes;
	    }
	    --oc;
	}
    }
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205

	/*
	 * Broken interface! Byte array value routines offer no way to handle
	 * failure to allocate enough space. Following stanza may panic.
	 */

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;
	    Tcl_GetByteArrayFromObj(objResultPtr, &start);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
	} else {
	    objResultPtr = Tcl_NewByteArrayObj(NULL, length);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    /*
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to copy bytes from the empty strings.
	     */

	    if (TclIsPureByteArray(objPtr)) {
		int more;
		unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
		memcpy(dst, src, (size_t) more);
		dst += more;
	    }
	}
    } else if (allowUniChar && requestUniChar) {
	/* Efficiently produce a pure Tcl_UniChar array result */
	Tcl_UniChar *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    Tcl_GetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %"
			TCL_Z_MODIFIER "u bytes",
			STRING_SIZE(length)));







|


|















|
|
|








|




|







3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165

	/*
	 * Broken interface! Byte array value routines offer no way to handle
	 * failure to allocate enough space. Following stanza may panic.
	 */

	if (inPlace && !Tcl_IsShared(*objv)) {
	    size_t start;

	    objResultPtr = *objv++; objc--;
	    TclGetByteArrayFromObj(objResultPtr, &start);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
	} else {
	    objResultPtr = Tcl_NewByteArrayObj(NULL, length);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    /*
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to copy bytes from the empty strings.
	     */

	    if (TclIsPureByteArray(objPtr)) {
		size_t more;
		unsigned char *src = TclGetByteArrayFromObj(objPtr, &more);
		memcpy(dst, src, more);
		dst += more;
	    }
	}
    } else if (allowUniChar && requestUniChar) {
	/* Efficiently produce a pure Tcl_UniChar array result */
	Tcl_UniChar *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    size_t start;

	    objResultPtr = *objv++; objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    TclGetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %"
			TCL_Z_MODIFIER "u bytes",
			STRING_SIZE(length)));
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
	    }
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int more;
		Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more);
		memcpy(dst, src, more * sizeof(Tcl_UniChar));
		dst += more;
	    }
	}
    } else {
	/* Efficiently concatenate string reps */
	char *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;

	    Tcl_GetStringFromObj(objResultPtr, &start);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = Tcl_GetString(objResultPtr) + start;

	    /* assert ( length > start ) */
	    TclFreeIntRep(objResultPtr);
	} else {
	    objResultPtr = Tcl_NewObj();	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		Tcl_DecrRefCount(objResultPtr);
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = Tcl_GetString(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int more;
		char *src = Tcl_GetStringFromObj(objPtr, &more);

		memcpy(dst, src, (size_t) more);
		dst += more;
	    }
	}
	/* Must NUL-terminate! */
	*dst = '\0';







|
|









|



|



|















|











|
|







3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
	    }
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		size_t more;
		Tcl_UniChar *src = TclGetUnicodeFromObj(objPtr, &more);
		memcpy(dst, src, more * sizeof(Tcl_UniChar));
		dst += more;
	    }
	}
    } else {
	/* Efficiently concatenate string reps */
	char *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    size_t start;

	    objResultPtr = *objv++; objc--;

	    (void)TclGetStringFromObj(objResultPtr, &start);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = Tcl_GetString(objResultPtr) + start;

	    /* assert ( length > start ) */
	    TclFreeIntRep(objResultPtr);
	} else {
	    objResultPtr = Tcl_NewObj();	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		Tcl_DecrRefCount(objResultPtr);
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = Tcl_GetString(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		size_t more;
		char *src = TclGetStringFromObj(objPtr, &more);

		memcpy(dst, src, (size_t) more);
		dst += more;
	    }
	}
	/* Must NUL-terminate! */
	*dst = '\0';
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325

3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
 */

int TclStringCmp(
    Tcl_Obj *value1Ptr,
    Tcl_Obj *value2Ptr,
    int checkEq,		/* comparison is only for equality */
    int nocase,			/* comparison is not case sensitive */
    int reqlength)		/* requested length */
{
    char *s1, *s2;
    int empty, length, match, s1len, s2len;

    memCmpFn_t memCmpFn;

    if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
	/*
	 * Always match at 0 chars of if it is the same obj.
	 */
	match = 0;
    } else {

	if (!nocase && TclIsPureByteArray(value1Ptr)
		&& TclIsPureByteArray(value2Ptr)) {
	    /*
	     * Use binary versions of comparisons since that won't cause undue
	     * type conversions and it is much faster. Only do this if we're
	     * case-sensitive (which is all that really makes sense with byte
	     * arrays anyway, and we have no memcasecmp() for some reason... :^)
	     */

	    s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
	    s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
	    memCmpFn = memcmp;
	} else if ((value1Ptr->typePtr == &tclStringType)
		&& (value2Ptr->typePtr == &tclStringType)) {
	    /*
	     * Do a unicode-specific comparison if both of the args are of
	     * String type. If the char length == byte length, we can do a
	     * memcmp. In benchmark testing this proved the most efficient
	     * check between the unicode and string comparison operations.
	     */

	    if (nocase) {
		s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
		s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
		memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp;
	    } else {
		s1len = Tcl_GetCharLength(value1Ptr);
		s2len = Tcl_GetCharLength(value2Ptr);
		if ((s1len == value1Ptr->length)
			&& (value1Ptr->bytes != NULL)
			&& (s2len == value2Ptr->length)







|


|
>


















|
|











|
|







3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
 */

int TclStringCmp(
    Tcl_Obj *value1Ptr,
    Tcl_Obj *value2Ptr,
    int checkEq,		/* comparison is only for equality */
    int nocase,			/* comparison is not case sensitive */
    size_t reqlength)		/* requested length */
{
    char *s1, *s2;
    int empty, match;
    size_t length, s1len, s2len;
    memCmpFn_t memCmpFn;

    if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
	/*
	 * Always match at 0 chars of if it is the same obj.
	 */
	match = 0;
    } else {

	if (!nocase && TclIsPureByteArray(value1Ptr)
		&& TclIsPureByteArray(value2Ptr)) {
	    /*
	     * Use binary versions of comparisons since that won't cause undue
	     * type conversions and it is much faster. Only do this if we're
	     * case-sensitive (which is all that really makes sense with byte
	     * arrays anyway, and we have no memcasecmp() for some reason... :^)
	     */

	    s1 = (char *) TclGetByteArrayFromObj(value1Ptr, &s1len);
	    s2 = (char *) TclGetByteArrayFromObj(value2Ptr, &s2len);
	    memCmpFn = memcmp;
	} else if ((value1Ptr->typePtr == &tclStringType)
		&& (value2Ptr->typePtr == &tclStringType)) {
	    /*
	     * Do a unicode-specific comparison if both of the args are of
	     * String type. If the char length == byte length, we can do a
	     * memcmp. In benchmark testing this proved the most efficient
	     * check between the unicode and string comparison operations.
	     */

	    if (nocase) {
		s1 = (char *) TclGetUnicodeFromObj(value1Ptr, &s1len);
		s2 = (char *) TclGetUnicodeFromObj(value2Ptr, &s2len);
		memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp;
	    } else {
		s1len = Tcl_GetCharLength(value1Ptr);
		s2len = Tcl_GetCharLength(value2Ptr);
		if ((s1len == value1Ptr->length)
			&& (value1Ptr->bytes != NULL)
			&& (s2len == value2Ptr->length)
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460


3461
3462
3463
3464
3465
3466
3467
		 * As a catch-all we will work with UTF-8. We cannot use
		 * memcmp() as that is unsafe with any string containing NUL
		 * (\xC0\x80 in Tcl's utf rep). We can use the more efficient
		 * TclpUtfNcmp2 if we are case-sensitive and no specific
		 * length was requested.
		 */

		if ((reqlength < 0) && !nocase) {
		    memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
		} else {
		    s1len = Tcl_NumUtfChars(s1, s1len);
		    s2len = Tcl_NumUtfChars(s2, s2len);
		    memCmpFn = (memCmpFn_t)
			    (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
		}
	    }
	}

	length = (s1len < s2len) ? s1len : s2len;
	if (reqlength > 0 && reqlength < length) {
	    length = reqlength;
	} else if (reqlength < 0) {
	    /*
	     * The requested length is negative, so we ignore it by setting it
	     * to length + 1 so we correct the match var.
	     */

	    reqlength = length + 1;


	}

	if (checkEq && (s1len != s2len)) {
	    match = 1;		/* This will be reversed below. */
	} else {
	    /*
	     * The comparison function should compare up to the minimum byte







|











<
<
|






>
>







3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412


3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
		 * As a catch-all we will work with UTF-8. We cannot use
		 * memcmp() as that is unsafe with any string containing NUL
		 * (\xC0\x80 in Tcl's utf rep). We can use the more efficient
		 * TclpUtfNcmp2 if we are case-sensitive and no specific
		 * length was requested.
		 */

		if ((reqlength == (size_t)-1) && !nocase) {
		    memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
		} else {
		    s1len = Tcl_NumUtfChars(s1, s1len);
		    s2len = Tcl_NumUtfChars(s2, s2len);
		    memCmpFn = (memCmpFn_t)
			    (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
		}
	    }
	}

	length = (s1len < s2len) ? s1len : s2len;


	if (reqlength == (size_t)-1) {
	    /*
	     * The requested length is negative, so we ignore it by setting it
	     * to length + 1 so we correct the match var.
	     */

	    reqlength = length + 1;
	} else if (reqlength > 0 && reqlength < length) {
	    length = reqlength;
	}

	if (checkEq && (s1len != s2len)) {
	    match = 1;		/* This will be reversed below. */
	} else {
	    /*
	     * The comparison function should compare up to the minimum byte
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
 * TclStringFirst --
 *
 *	Implements the [string first] operation.
 *
 * Results:
 *	If needle is found as a substring of haystack, the index of the
 *	first instance of such a find is returned.  If needle is not present
 *	as a substring of haystack, -1 is returned.
 *
 * Side effects:
 *	needle and haystack may have their Tcl_ObjType changed.
 *
 *---------------------------------------------------------------------------
 */

int
TclStringFirst(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    int start)
{
    int lh, ln = Tcl_GetCharLength(needle);

    if (start < 0) {
	start = 0;
    }
    if (ln == 0) {
	/* We don't find empty substrings.  Bizarre!
	 * Whenever this routine is turned into a proper substring
	 * finder, change to `return start` after limits imposed. */
	return -1;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *end, *try, *bh;
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	/* Find bytes in bytes */
	bh = Tcl_GetByteArrayFromObj(haystack, &lh);
	end = bh + lh;

	try = bh + start;
	while (try + ln <= end) {
	    /*
	     * Look for the leading byte of the needle in the haystack
	     * starting at try and stopping when there's not enough room







|







|



|

|

|











|


|







3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
 * TclStringFirst --
 *
 *	Implements the [string first] operation.
 *
 * Results:
 *	If needle is found as a substring of haystack, the index of the
 *	first instance of such a find is returned.  If needle is not present
 *	as a substring of haystack, (size_t)-1 is returned.
 *
 * Side effects:
 *	needle and haystack may have their Tcl_ObjType changed.
 *
 *---------------------------------------------------------------------------
 */

size_t
TclStringFirst(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    size_t start)
{
    size_t lh, ln = Tcl_GetCharLength(needle);

    if (start == (size_t)-1) {
	start = 0;
    }
    if (ln == 0) {
	/* We don't find empty substrings.  Bizarre!
	 * Whenever this routine is turned into a proper substring
	 * finder, change to `return start` after limits imposed. */
	return -1;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *end, *try, *bh;
	unsigned char *bn = TclGetByteArrayFromObj(needle, &ln);

	/* Find bytes in bytes */
	bh = TclGetByteArrayFromObj(haystack, &lh);
	end = bh + lh;

	try = bh + start;
	while (try + ln <= end) {
	    /*
	     * Look for the leading byte of the needle in the haystack
	     * starting at try and stopping when there's not enough room
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
     * locking down in practice more firmly just what encodings produce
     * what supported results for the objPtr->bytes values.  For now,
     * do only the well-defined Tcl_UniChar array search.
     */

    {
	Tcl_UniChar *try, *end, *uh;
	Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);

	uh = Tcl_GetUnicodeFromObj(haystack, &lh);
	end = uh + lh;

	for (try = uh + start; try + ln <= end; try++) {
	    if ((*try == *un) && (0 ==
		    memcmp(try + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) {
		return (try - uh);
	    }







|

|







3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
     * locking down in practice more firmly just what encodings produce
     * what supported results for the objPtr->bytes values.  For now,
     * do only the well-defined Tcl_UniChar array search.
     */

    {
	Tcl_UniChar *try, *end, *uh;
	Tcl_UniChar *un = TclGetUnicodeFromObj(needle, &ln);

	uh = TclGetUnicodeFromObj(haystack, &lh);
	end = uh + lh;

	for (try = uh + start; try + ln <= end; try++) {
	    if ((*try == *un) && (0 ==
		    memcmp(try + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) {
		return (try - uh);
	    }
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
 *
 * Side effects:
 *	needle and haystack may have their Tcl_ObjType changed.
 *
 *---------------------------------------------------------------------------
 */

int
TclStringLast(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    int last)
{
    int lh, ln = Tcl_GetCharLength(needle);

    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!
	 *
	 * 	TODO: When we one day make this a true substring
	 * 	finder, change this to "return last", after limitation.
	 */
	return -1;
    }

    lh = Tcl_GetCharLength(haystack);
    if (last >= lh) {
	last = lh - 1;
    }

    if (last < ln - 1) {
	return -1;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *try, *bh = Tcl_GetByteArrayFromObj(haystack, &lh);
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	try = bh + last + 1 - ln;
	while (try >= bh) {
	    if ((*try == bn[0])
		    && (0 == memcmp(try+1, bn+1, ln-1))) {
		return (try - bh);
	    }
	    try--;
	}
	return -1;
    }

    {
	Tcl_UniChar *try, *uh = Tcl_GetUnicodeFromObj(haystack, &lh);
	Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);

	try = uh + last + 1 - ln;
	while (try >= uh) {
	    if ((*try == un[0])
		    && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
		return (try - uh);
	    }







|



|

|








|








|



|
|













|
|







3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
 *
 * Side effects:
 *	needle and haystack may have their Tcl_ObjType changed.
 *
 *---------------------------------------------------------------------------
 */

size_t
TclStringLast(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    size_t last)
{
    size_t lh, ln = Tcl_GetCharLength(needle);

    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!
	 *
	 * 	TODO: When we one day make this a true substring
	 * 	finder, change this to "return last", after limitation.
	 */
	return (size_t)-1;
    }

    lh = Tcl_GetCharLength(haystack);
    if (last >= lh) {
	last = lh - 1;
    }

    if (last < ln - 1) {
	return (size_t)-1;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *try, *bh = TclGetByteArrayFromObj(haystack, &lh);
	unsigned char *bn = TclGetByteArrayFromObj(needle, &ln);

	try = bh + last + 1 - ln;
	while (try >= bh) {
	    if ((*try == bn[0])
		    && (0 == memcmp(try+1, bn+1, ln-1))) {
		return (try - bh);
	    }
	    try--;
	}
	return -1;
    }

    {
	Tcl_UniChar *try, *uh = TclGetUnicodeFromObj(haystack, &lh);
	Tcl_UniChar *un = TclGetUnicodeFromObj(needle, &ln);

	try = uh + last + 1 - ln;
	while (try >= uh) {
	    if ((*try == un[0])
		    && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
		return (try - uh);
	    }
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
 *---------------------------------------------------------------------------
 */

static void
ReverseBytes(
    unsigned char *to,		/* Copy bytes into here... */
    unsigned char *from,	/* ...from here... */
    int count)			/* Until this many are copied, */
				/* reversing as you go. */
{
    unsigned char *src = from + count;

    if (to == from) {
	/* Reversing in place */
	while (--src > to) {







|







3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
 *---------------------------------------------------------------------------
 */

static void
ReverseBytes(
    unsigned char *to,		/* Copy bytes into here... */
    unsigned char *from,	/* ...from here... */
    size_t count)		/* Until this many are copied, */
				/* reversing as you go. */
{
    unsigned char *src = from + count;

    if (to == from) {
	/* Reversing in place */
	while (--src > to) {
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
    int flags)
{
    String *stringPtr;
    Tcl_UniChar ch = 0;
    int inPlace = flags & TCL_STRING_IN_PLACE;

    if (TclIsPureByteArray(objPtr)) {
	int numBytes;
	unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
	}
	ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
	return objPtr;
    }







|
|







3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
    int flags)
{
    String *stringPtr;
    Tcl_UniChar ch = 0;
    int inPlace = flags & TCL_STRING_IN_PLACE;

    if (TclIsPureByteArray(objPtr)) {
	size_t numBytes;
	unsigned char *from = TclGetByteArrayFromObj(objPtr, &numBytes);

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
	}
	ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
	return objPtr;
    }
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
		*src = *from;
		*from++ = ch;
	    }
	}
    }

    if (objPtr->bytes) {
	int numChars = stringPtr->numChars;
	int numBytes = objPtr->length;
	char *to, *from = objPtr->bytes;

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewObj();
	    Tcl_SetObjLength(objPtr, numBytes);
	}
	to = objPtr->bytes;

	if (numChars < numBytes) {
	    /*
	     * Either numChars == -1 and we don't know how many chars are
	     * represented by objPtr->bytes and we need Pass 1 just in case,
	     * or numChars >= 0 and we know we have fewer chars than bytes, so
	     * we know there's a multibyte character needing Pass 1.
	     *
	     * Pass 1. Reverse the bytes of each multi-byte character.
	     */

	    int charCount = 0;
	    int bytesLeft = numBytes;

	    while (bytesLeft) {
		/*
		 * NOTE: We know that the from buffer is NUL-terminated. It's
		 * part of the contract for objPtr->bytes values. Thus, we can
		 * skip calling Tcl_UtfCharComplete() here.
		 */

		int bytesInChar = TclUtfToUniChar(from, &ch);

		ReverseBytes((unsigned char *)to, (unsigned char *)from,
			bytesInChar);
		to += bytesInChar;
		from += bytesInChar;
		bytesLeft -= bytesInChar;
		charCount++;







|
|








|









|
|








|







3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
		*src = *from;
		*from++ = ch;
	    }
	}
    }

    if (objPtr->bytes) {
	size_t numChars = stringPtr->numChars;
	size_t numBytes = objPtr->length;
	char *to, *from = objPtr->bytes;

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewObj();
	    Tcl_SetObjLength(objPtr, numBytes);
	}
	to = objPtr->bytes;

	if ((numChars == (size_t)-1) || (numChars < numBytes)) {
	    /*
	     * Either numChars == -1 and we don't know how many chars are
	     * represented by objPtr->bytes and we need Pass 1 just in case,
	     * or numChars >= 0 and we know we have fewer chars than bytes, so
	     * we know there's a multibyte character needing Pass 1.
	     *
	     * Pass 1. Reverse the bytes of each multi-byte character.
	     */

	    size_t charCount = 0;
	    size_t bytesLeft = numBytes;

	    while (bytesLeft) {
		/*
		 * NOTE: We know that the from buffer is NUL-terminated. It's
		 * part of the contract for objPtr->bytes values. Thus, we can
		 * skip calling Tcl_UtfCharComplete() here.
		 */

		size_t bytesInChar = TclUtfToUniChar(from, &ch);

		ReverseBytes((unsigned char *)to, (unsigned char *)from,
			bytesInChar);
		to += bytesInChar;
		from += bytesInChar;
		bytesLeft -= bytesInChar;
		charCount++;
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringReplace(
    Tcl_Interp *interp,		/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,		/* String to act upon */
    int first,			/* First index to replace */
    int count,			/* How many chars to replace */
    Tcl_Obj *insertPtr,		/* Replacement string, may be NULL */
    int flags)			/* TCL_STRING_IN_PLACE => attempt in-place */
{
    int inPlace = flags & TCL_STRING_IN_PLACE;
    Tcl_Obj *result;

    /* Caller is expected to pass sensible arguments */
    assert ( count >= 0 ) ;
    assert ( first >= 0 ) ;

    /* Replace nothing with nothing */
    if ((insertPtr == NULL) && (count == 0)) {
	if (inPlace) {
	    return objPtr;
	} else {
	    return Tcl_DuplicateObj(objPtr);
	}
    }

    /*
     * The caller very likely had to call Tcl_GetCharLength() or similar
     * to be able to process index values.  This means it is like that
     * objPtr is either a proper "bytearray" or a "string" or else it has
     * a known and short string rep.
     */

    if (TclIsPureByteArray(objPtr)) {
	int numBytes;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (insertPtr == NULL) {
	    /* Replace something with nothing. */

	    assert ( first <= numBytes ) ;
	    assert ( count <= numBytes ) ;
	    assert ( first + count <= numBytes ) ;







|
|






<
<
<
<

















|
|







3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798




3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringReplace(
    Tcl_Interp *interp,		/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,		/* String to act upon */
    size_t first,		/* First index to replace */
    size_t count,		/* How many chars to replace */
    Tcl_Obj *insertPtr,		/* Replacement string, may be NULL */
    int flags)			/* TCL_STRING_IN_PLACE => attempt in-place */
{
    int inPlace = flags & TCL_STRING_IN_PLACE;
    Tcl_Obj *result;





    /* Replace nothing with nothing */
    if ((insertPtr == NULL) && (count == 0)) {
	if (inPlace) {
	    return objPtr;
	} else {
	    return Tcl_DuplicateObj(objPtr);
	}
    }

    /*
     * The caller very likely had to call Tcl_GetCharLength() or similar
     * to be able to process index values.  This means it is like that
     * objPtr is either a proper "bytearray" or a "string" or else it has
     * a known and short string rep.
     */

    if (TclIsPureByteArray(objPtr)) {
	size_t numBytes;
	unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &numBytes);

	if (insertPtr == NULL) {
	    /* Replace something with nothing. */

	    assert ( first <= numBytes ) ;
	    assert ( count <= numBytes ) ;
	    assert ( first + count <= numBytes ) ;
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904

	/* Replace everything */
	if ((first == 0) && (count == numBytes)) {
	    return insertPtr;
	}

	if (TclIsPureByteArray(insertPtr)) {
	    int newBytes;
	    unsigned char *iBytes
		    = Tcl_GetByteArrayFromObj(insertPtr, &newBytes);

	    if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) {
		/*
		 * Removal count and replacement count are equal.
		 * Other conditions permit. Do in-place splice.
		 */

		memcpy(bytes + first, iBytes, count);
		Tcl_InvalidateStringRep(objPtr);
		return objPtr;
	    }

	    if (newBytes > INT_MAX - (numBytes - count)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "max size for a Tcl value (%d bytes) exceeded",
			    INT_MAX));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;







|

|












|







3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861

	/* Replace everything */
	if ((first == 0) && (count == numBytes)) {
	    return insertPtr;
	}

	if (TclIsPureByteArray(insertPtr)) {
	    size_t newBytes;
	    unsigned char *iBytes
		    = TclGetByteArrayFromObj(insertPtr, &newBytes);

	    if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) {
		/*
		 * Removal count and replacement count are equal.
		 * Other conditions permit. Do in-place splice.
		 */

		memcpy(bytes + first, iBytes, count);
		Tcl_InvalidateStringRep(objPtr);
		return objPtr;
	    }

	    if ((size_t)newBytes > INT_MAX - (numBytes - count)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "max size for a Tcl value (%d bytes) exceeded",
			    INT_MAX));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
     * TODO: Figure out how not to generate a Tcl_UniChar array rep
     * when it can be determined objPtr->bytes points to a string of
     * all single-byte characters so we can index it directly.
     */

    /* The traditional implementation... */
    {
	int numChars;
	Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars);

	/* TODO: Is there an in-place option worth pursuing here? */

	result = Tcl_NewUnicodeObj(ustring, first);
	if (insertPtr) {
	    Tcl_AppendObjToObj(result, insertPtr);
	}
	if (first + count < numChars) {
	    Tcl_AppendUnicodeToObj(result, ustring + first + count,
		    numChars - first - count);
	}

	return result;
    }
}







|
|







|







3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
     * TODO: Figure out how not to generate a Tcl_UniChar array rep
     * when it can be determined objPtr->bytes points to a string of
     * all single-byte characters so we can index it directly.
     */

    /* The traditional implementation... */
    {
	size_t numChars;
	Tcl_UniChar *ustring = TclGetUnicodeFromObj(objPtr, &numChars);

	/* TODO: Is there an in-place option worth pursuing here? */

	result = Tcl_NewUnicodeObj(ustring, first);
	if (insertPtr) {
	    Tcl_AppendObjToObj(result, insertPtr);
	}
	if (first + count < (size_t)numChars) {
	    Tcl_AppendUnicodeToObj(result, ustring + first + count,
		    numChars - first - count);
	}

	return result;
    }
}
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
	    stringPtr->numChars);
}

static void
ExtendUnicodeRepWithString(
    Tcl_Obj *objPtr,
    const char *bytes,
    int numBytes,
    int numAppendChars)
{
    String *stringPtr = GET_STRING(objPtr);
    int needed, numOrigChars = 0;
    Tcl_UniChar *dst, unichar = 0;

    if (stringPtr->hasUnicode) {
	numOrigChars = stringPtr->numChars;
    }
    if (numAppendChars == -1) {
	TclNumUtfChars(numAppendChars, bytes, numBytes);
    }
    needed = numOrigChars + numAppendChars;
    stringCheckLimits(needed);

    if (needed > stringPtr->maxChars) {
	GrowUnicodeBuffer(objPtr, needed);







|
|


|





|







3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
	    stringPtr->numChars);
}

static void
ExtendUnicodeRepWithString(
    Tcl_Obj *objPtr,
    const char *bytes,
    size_t numBytes,
    size_t numAppendChars)
{
    String *stringPtr = GET_STRING(objPtr);
    size_t needed, numOrigChars = 0;
    Tcl_UniChar *dst, unichar = 0;

    if (stringPtr->hasUnicode) {
	numOrigChars = stringPtr->numChars;
    }
    if (numAppendChars == (size_t)-1) {
	TclNumUtfChars(numAppendChars, bytes, numBytes);
    }
    needed = numOrigChars + numAppendChars;
    stringCheckLimits(needed);

    if (needed > stringPtr->maxChars) {
	GrowUnicodeBuffer(objPtr, needed);
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
				 * an internal rep of type "String". */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. Must not
				 * currently have an internal rep.*/
{
    String *srcStringPtr = GET_STRING(srcPtr);
    String *copyStringPtr = NULL;

    if (srcStringPtr->numChars == -1) {
	/*
	 * The String struct in the source value holds zero useful data. Don't
	 * bother copying it. Don't even bother allocating space in which to
	 * copy it. Just let the copy be untyped.
	 */

	return;







|







3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
				 * an internal rep of type "String". */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. Must not
				 * currently have an internal rep.*/
{
    String *srcStringPtr = GET_STRING(srcPtr);
    String *copyStringPtr = NULL;

    if (srcStringPtr->numChars == (size_t)-1) {
	/*
	 * The String struct in the source value holds zero useful data. Don't
	 * bother copying it. Don't even bother allocating space in which to
	 * copy it. Just let the copy be untyped.
	 */

	return;
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
	TclInitStringRep(objPtr, &tclEmptyString, 0);
    } else {
	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
		stringPtr->numChars);
    }
}

static int
ExtendStringRepWithUnicode(
    Tcl_Obj *objPtr,
    const Tcl_UniChar *unicode,
    int numChars)
{
    /*
     * Pre-condition: this is the "string" Tcl_ObjType.
     */

    int i, origLength, size = 0;
    char *dst;
    String *stringPtr = GET_STRING(objPtr);

    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

    if (numChars == 0) {
	return 0;
    }








|



|





|



|







4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
	TclInitStringRep(objPtr, &tclEmptyString, 0);
    } else {
	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
		stringPtr->numChars);
    }
}

static size_t
ExtendStringRepWithUnicode(
    Tcl_Obj *objPtr,
    const Tcl_UniChar *unicode,
    size_t numChars)
{
    /*
     * Pre-condition: this is the "string" Tcl_ObjType.
     */

    size_t i, origLength, size = 0;
    char *dst;
    String *stringPtr = GET_STRING(objPtr);

    if (numChars == (size_t)-1) {
	numChars = UnicodeLength(unicode);
    }

    if (numChars == 0) {
	return 0;
    }

4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
     */

    if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
	    && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
	goto copyBytes;
    }

    for (i = 0; i < numChars && size >= 0; i++) {
	size += TclUtfCount(unicode[i]);
    }
    if (size < 0) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    /*
     * Grow space if needed.
     */

    if (size > stringPtr->allocated) {
	GrowStringBuffer(objPtr, size, 1);
    }

  copyBytes:
    dst = objPtr->bytes + origLength;
    for (i = 0; i < numChars; i++) {
	dst += Tcl_UniCharToUtf((int) unicode[i], dst);
    }
    *dst = '\0';
    objPtr->length = dst - objPtr->bytes;
    return numChars;
}

/*







|


<
<
<












|







4161
4162
4163
4164
4165
4166
4167
4168
4169
4170



4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
     */

    if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
	    && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
	goto copyBytes;
    }

    for (i = 0; i < numChars; i++) {
	size += TclUtfCount(unicode[i]);
    }




    /*
     * Grow space if needed.
     */

    if (size > stringPtr->allocated) {
	GrowStringBuffer(objPtr, size, 1);
    }

  copyBytes:
    dst = objPtr->bytes + origLength;
    for (i = 0; i < numChars; i++) {
	dst += Tcl_UniCharToUtf(unicode[i], dst);
    }
    *dst = '\0';
    objPtr->length = dst - objPtr->bytes;
    return numChars;
}

/*
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
 *----------------------------------------------------------------------
 */

static void
FreeStringInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    ckfree(GET_STRING(objPtr));
    objPtr->typePtr = NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|










4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
 *----------------------------------------------------------------------
 */

static void
FreeStringInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    Tcl_Free(GET_STRING(objPtr));
    objPtr->typePtr = NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclStringRep.h.
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
 * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
 * can be officially modified by altering the definition of Tcl_UniChar in
 * tcl.h, but do not do that unless you are sure what you're doing!
 */

typedef struct {
    int numChars;		/* The number of chars in the string. -1 means
				 * this value has not been calculated. >= 0
				 * means that there is a valid Unicode rep, or
				 * that the number of UTF bytes == the number
				 * of chars. */
    int allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */
    int maxChars;		/* Max number of chars that can fit in the
				 * space allocated for the unicode array. */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Unicode representation. */
    Tcl_UniChar unicode[1];	/* The array of Unicode chars. The actual size
				 * of this field depends on the 'maxChars'
				 * field above. */
} String;

#define STRING_MAXCHARS \
    (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
#define STRING_SIZE(numChars) \
    (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
#define stringCheckLimits(numChars) \
    do {								\
	if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) {		\
	    Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
		      (int)STRING_MAXCHARS);					\
	}								\
    } while (0)
#define stringAttemptAlloc(numChars) \
    (String *) attemptckalloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
    (String *) ckalloc(STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \
    (String *) ckrealloc((ptr), STRING_SIZE(numChars))
#define stringAttemptRealloc(ptr, numChars) \
    (String *) attemptckrealloc((ptr), STRING_SIZE(numChars))
#define GET_STRING(objPtr) \
    ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
    ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL),			\
    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))

/*







|
|



|


|









|




|
|
|



|

|

|

|







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
 * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
 * can be officially modified by altering the definition of Tcl_UniChar in
 * tcl.h, but do not do that unless you are sure what you're doing!
 */

typedef struct {
    size_t numChars;		/* The number of chars in the string. (size_t)-1 means
				 * this value has not been calculated. Any other
				 * means that there is a valid Unicode rep, or
				 * that the number of UTF bytes == the number
				 * of chars. */
    size_t allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */
    size_t maxChars;		/* Max number of chars that can fit in the
				 * space allocated for the unicode array. */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Unicode representation. */
    Tcl_UniChar unicode[1];	/* The array of Unicode chars. The actual size
				 * of this field depends on the 'maxChars'
				 * field above. */
} String;

#define STRING_MAXCHARS \
    ((UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
#define STRING_SIZE(numChars) \
    (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
#define stringCheckLimits(numChars) \
    do {								\
	if ((size_t)(numChars) > STRING_MAXCHARS) {		\
	    Tcl_Panic("max length for a Tcl unicode value (%" TCL_Z_MODIFIER "u chars) exceeded", \
		      STRING_MAXCHARS);					\
	}								\
    } while (0)
#define stringAttemptAlloc(numChars) \
    (String *) Tcl_AttemptAlloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
    (String *) Tcl_Alloc(STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \
    (String *) Tcl_Realloc((ptr), STRING_SIZE(numChars))
#define stringAttemptRealloc(ptr, numChars) \
    (String *) Tcl_AttemptRealloc((ptr), STRING_SIZE(numChars))
#define GET_STRING(objPtr) \
    ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
    ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL),			\
    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))

/*
Changes to generic/tclStubInit.c.
9
10
11
12
13
14
15




16
17
18
19
20
21
22
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclOOInt.h"
#include "tommath.h"





/*
 * The actual definition of the variable holding the TclOO stub table.
 */

MODULE_SCOPE const TclOOStubs tclOOStubs;
MODULE_SCOPE const TclOOIntStubs tclOOIntStubs;








>
>
>
>







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclOOInt.h"
#include "tommath.h"

#ifdef __CYGWIN__
#   include <wchar.h>
#endif

/*
 * The actual definition of the variable holding the TclOO stub table.
 */

MODULE_SCOPE const TclOOStubs tclOOStubs;
MODULE_SCOPE const TclOOIntStubs tclOOIntStubs;

66
67
68
69
70
71
72










73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
     * The best we can do is provide an error-message, as if the
     * extension originally called:
     *     Tcl_StubsInit(interp, "8", 0)
     */
	Tcl_PkgRequireEx(interp, "Tcl", "8", 0, NULL);
	return TCL_ERROR;
}











#ifdef _WIN32
#   define TclUnixWaitForFile 0
#   define TclUnixCopyFile 0
#   define TclUnixOpenTemporaryFile 0
#   define TclpIsAtty 0
#elif defined(__CYGWIN__)
#   define TclpIsAtty TclPlatIsAtty
static void
doNothing(void)
{
    /* dummy implementation, no need to do anything */
}
#   define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
#   define TclWinFlushDirtyChannels doNothing
static int
TclpIsAtty(int fd)
{
    return isatty(fd);
}








>
>
>
>
>
>
>
>
>
>













|







70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
     * The best we can do is provide an error-message, as if the
     * extension originally called:
     *     Tcl_StubsInit(interp, "8", 0)
     */
	Tcl_PkgRequireEx(interp, "Tcl", "8", 0, NULL);
	return TCL_ERROR;
}

#ifdef TCL_MEM_DEBUG
#   define Tcl_Alloc TclpAlloc
#   define Tcl_Free TclpFree
#   define Tcl_Realloc TclpRealloc
#   undef Tcl_AttemptAlloc
#   define Tcl_AttemptAlloc TclpAlloc
#   undef Tcl_AttemptRealloc
#   define Tcl_AttemptRealloc TclpRealloc
#endif

#ifdef _WIN32
#   define TclUnixWaitForFile 0
#   define TclUnixCopyFile 0
#   define TclUnixOpenTemporaryFile 0
#   define TclpIsAtty 0
#elif defined(__CYGWIN__)
#   define TclpIsAtty TclPlatIsAtty
static void
doNothing(void)
{
    /* dummy implementation, no need to do anything */
}
#   define TclWinAddProcess (void (*) (void *, size_t)) doNothing
#   define TclWinFlushDirtyChannels doNothing
static int
TclpIsAtty(int fd)
{
    return isatty(fd);
}

109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138


139
140
141
142
143
144
145
146
147
148

149
150


151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
	if (*p == '\\') {
	    *p = '/';
	}
    }
    return path;
}

int
TclpGetPid(Tcl_Pid pid)
{
    return (int) (size_t) pid;
}

char *
Tcl_WinUtfToTChar(
    const char *string,
    int len,
    Tcl_DString *dsPtr)
{
    WCHAR *wp;
    int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);

    Tcl_DStringInit(dsPtr);
    Tcl_DStringSetLength(dsPtr, 2*size+2);
    wp = (WCHAR *)Tcl_DStringValue(dsPtr);
    MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1);
    if (len == -1) --size; /* account for 0-byte at string end */
    Tcl_DStringSetLength(dsPtr, 2*size);
    wp[size] = 0;
    return (char *)wp;


}

char *
Tcl_WinTCharToUtf(
    const char *string,
    int len,
    Tcl_DString *dsPtr)
{
    char *p;
    int size;


    if (len > 0) {


	len /= 2;
    }
    size = WideCharToMultiByte(CP_UTF8, 0, string, len, 0, 0, NULL, NULL);
    Tcl_DStringInit(dsPtr);
    Tcl_DStringSetLength(dsPtr, size+1);
    p = (char *)Tcl_DStringValue(dsPtr);
    WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL);
    if (len == -1) --size; /* account for 0-byte at string end */
    Tcl_DStringSetLength(dsPtr, size);
    p[size] = 0;
    return p;
}

#if defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
 * we have to make sure that all stub entries on Cygwin64 follow the Win64
 * signature. Tcl 9 must find a better solution, but that cannot be done
 * without introducing a binary incompatibility.
 */
static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
    long longValue;
    int result = Tcl_ExprLong(interp, expr, &longValue);
    if (result == TCL_OK) {
	    if ((longValue >= -(long)(UINT_MAX))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}
    }
    return result;
}
#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))exprInt
static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
    long longValue;
    int result = Tcl_ExprLongObj(interp, expr, &longValue);
    if (result == TCL_OK) {
	    if ((longValue >= -(long)(UINT_MAX))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}







|


|





|


<
<
<

|
<
<
<
<
<
|
>
>





|


|
|
>
|
|
>
>


<
<
<
<
<
<
<
<
|












|















|







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141



142
143





144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163








164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
	if (*p == '\\') {
	    *p = '/';
	}
    }
    return path;
}

size_t
TclpGetPid(Tcl_Pid pid)
{
    return (size_t) pid;
}

char *
Tcl_WinUtfToTChar(
    const char *string,
    size_t len,
    Tcl_DString *dsPtr)
{



    Tcl_DStringInit(dsPtr);
    if (!string) {





	return NULL;
    }
    return (char *)Tcl_UtfToUniCharDString(string, len, dsPtr);
}

char *
Tcl_WinTCharToUtf(
    const char *string,
    size_t len,
    Tcl_DString *dsPtr)
{
    Tcl_DStringInit(dsPtr);
    if (!string) {
	return NULL;
    }
    if (len == TCL_AUTO_LENGTH) {
	len = wcslen((wchar_t *)string);
    } else {
	len /= 2;
    }








    return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr);
}

#if defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
 * we have to make sure that all stub entries on Cygwin64 follow the Win64
 * signature. Tcl 9 must find a better solution, but that cannot be done
 * without introducing a binary incompatibility.
 */
static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
    long longValue;
    int result = Tcl_ExprLong(interp, expr, &longValue);
    if (result == TCL_OK) {
	    if ((longValue >= (long)(INT_MIN))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}
    }
    return result;
}
#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))exprInt
static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
    long longValue;
    int result = Tcl_ExprLongObj(interp, expr, &longValue);
    if (result == TCL_OK) {
	    if ((longValue >= (long)(INT_MIN))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}
1344
1345
1346
1347
1348
1349
1350




1351
1352
1353
    Tcl_NRExprObj, /* 625 */
    Tcl_NRSubstObj, /* 626 */
    Tcl_LoadFile, /* 627 */
    Tcl_FindSymbol, /* 628 */
    Tcl_FSUnloadFile, /* 629 */
    Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
    Tcl_OpenTcpServerEx, /* 631 */




};

/* !END!: Do not edit above this line. */







>
>
>
>



1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
    Tcl_NRExprObj, /* 625 */
    Tcl_NRSubstObj, /* 626 */
    Tcl_LoadFile, /* 627 */
    Tcl_FindSymbol, /* 628 */
    Tcl_FSUnloadFile, /* 629 */
    Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
    Tcl_OpenTcpServerEx, /* 631 */
    TclZipfs_Mount, /* 632 */
    TclZipfs_Unmount, /* 633 */
    TclZipfs_TclLibrary, /* 634 */
    TclZipfs_MountBuffer, /* 635 */
};

/* !END!: Do not edit above this line. */
Changes to generic/tclTest.c.
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
			    Tcl_Obj *const objv[]);
static int		ObjTraceProc(ClientData clientData,
			    Tcl_Interp *interp, int level, const char *command,
			    Tcl_Command commandToken, int objc,
			    Tcl_Obj *const objv[]);
static void		ObjTraceDeleteProc(ClientData clientData);
static void		PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
static void		SpecialFree(char *blockPtr);
static int		StaticInitProc(Tcl_Interp *interp);
static int		TestasyncCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestbytestringObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TeststringbytesObjCmd(ClientData clientData,







|







216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
			    Tcl_Obj *const objv[]);
static int		ObjTraceProc(ClientData clientData,
			    Tcl_Interp *interp, int level, const char *command,
			    Tcl_Command commandToken, int objc,
			    Tcl_Obj *const objv[]);
static void		ObjTraceDeleteProc(ClientData clientData);
static void		PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
static void		SpecialFree(void *blockPtr);
static int		StaticInitProc(Tcl_Interp *interp);
static int		TestasyncCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestbytestringObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TeststringbytesObjCmd(ClientData clientData,
288
289
290
291
292
293
294


295
296
297
298
299
300
301
static int		TestfilelinkCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int		TestfeventCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetassocdataCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetintCmd(ClientData dummy,


			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetplatformCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetvarfullnameCmd(
			    ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestinterpdeleteCmd(ClientData dummy,







>
>







288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
static int		TestfilelinkCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int		TestfeventCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetassocdataCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetintCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestlongsizeCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetplatformCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetvarfullnameCmd(
			    ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestinterpdeleteCmd(ClientData dummy,
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		TestregexpXflags(const char *string,
			    int length, int *cflagsPtr, int *eflagsPtr);
static int		TestsaveresultCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		TestsaveresultFree(char *blockPtr);
static int		TestsetassocdataCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestsetCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		Testset2Cmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestseterrorcodeCmd(ClientData dummy,







|







339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		TestregexpXflags(const char *string,
			    int length, int *cflagsPtr, int *eflagsPtr);
static int		TestsaveresultCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		TestsaveresultFree(void *blockPtr);
static int		TestsetassocdataCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestsetCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		Testset2Cmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestseterrorcodeCmd(ClientData dummy,
640
641
642
643
644
645
646


647
648
649
650
651
652
653
    Tcl_CreateObjCommand(interp, "testfile", TestfileCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testhashsystemhash",
	    TestHashSystemHashCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testgetint", TestgetintCmd,


	    NULL, NULL);
    Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetvarfullname",
	    TestgetvarfullnameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
	    NULL, NULL);







>
>







642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
    Tcl_CreateObjCommand(interp, "testfile", TestfileCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testhashsystemhash",
	    TestHashSystemHashCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testgetint", TestgetintCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testlongsize", TestlongsizeCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetvarfullname",
	    TestgetvarfullnameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
	    NULL, NULL);
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	asyncPtr = ckalloc(sizeof(TestAsyncHandler));
	asyncPtr->command = ckalloc(strlen(argv[2]) + 1);
	strcpy(asyncPtr->command, argv[2]);
        Tcl_MutexLock(&asyncTestMutex);
	asyncPtr->id = nextId;
	nextId++;
	asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
                                            INT2PTR(asyncPtr->id));
	asyncPtr->nextPtr = firstHandler;
	firstHandler = asyncPtr;
        Tcl_MutexUnlock(&asyncTestMutex);
	Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id));
    } else if (strcmp(argv[1], "delete") == 0) {
	if (argc == 2) {
            Tcl_MutexLock(&asyncTestMutex);
	    while (firstHandler != NULL) {
		asyncPtr = firstHandler;
		firstHandler = asyncPtr->nextPtr;
		Tcl_AsyncDelete(asyncPtr->handler);
		ckfree(asyncPtr->command);
		ckfree(asyncPtr);
	    }
            Tcl_MutexUnlock(&asyncTestMutex);
	    return TCL_OK;
	}
	if (argc != 3) {
	    goto wrongNumArgs;
	}







|
|

















|
|







835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	asyncPtr = Tcl_Alloc(sizeof(TestAsyncHandler));
	asyncPtr->command = Tcl_Alloc(strlen(argv[2]) + 1);
	strcpy(asyncPtr->command, argv[2]);
        Tcl_MutexLock(&asyncTestMutex);
	asyncPtr->id = nextId;
	nextId++;
	asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
                                            INT2PTR(asyncPtr->id));
	asyncPtr->nextPtr = firstHandler;
	firstHandler = asyncPtr;
        Tcl_MutexUnlock(&asyncTestMutex);
	Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id));
    } else if (strcmp(argv[1], "delete") == 0) {
	if (argc == 2) {
            Tcl_MutexLock(&asyncTestMutex);
	    while (firstHandler != NULL) {
		asyncPtr = firstHandler;
		firstHandler = asyncPtr->nextPtr;
		Tcl_AsyncDelete(asyncPtr->handler);
		Tcl_Free(asyncPtr->command);
		Tcl_Free(asyncPtr);
	    }
            Tcl_MutexUnlock(&asyncTestMutex);
	    return TCL_OK;
	}
	if (argc != 3) {
	    goto wrongNumArgs;
	}
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
	    }
	    if (prevPtr == NULL) {
		firstHandler = asyncPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = asyncPtr->nextPtr;
	    }
	    Tcl_AsyncDelete(asyncPtr->handler);
	    ckfree(asyncPtr->command);
	    ckfree(asyncPtr);
	    break;
	}
        Tcl_MutexUnlock(&asyncTestMutex);
    } else if (strcmp(argv[1], "mark") == 0) {
	if (argc != 5) {
	    goto wrongNumArgs;
	}







|
|







878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
	    }
	    if (prevPtr == NULL) {
		firstHandler = asyncPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = asyncPtr->nextPtr;
	    }
	    Tcl_AsyncDelete(asyncPtr->handler);
	    Tcl_Free(asyncPtr->command);
	    Tcl_Free(asyncPtr);
	    break;
	}
        Tcl_MutexUnlock(&asyncTestMutex);
    } else if (strcmp(argv[1], "mark") == 0) {
	if (argc != 5) {
	    goto wrongNumArgs;
	}
946
947
948
949
950
951
952
953

954
955
956
957
958
959
960
                                 * in global list. */
    Tcl_Interp *interp,		/* Interpreter in which command was
				 * executed, or NULL. */
    int code)			/* Current return code from command. */
{
    TestAsyncHandler *asyncPtr;
    int id = PTR2INT(clientData);
    const char *listArgv[4], *cmd;

    char string[TCL_INTEGER_SPACE];

    Tcl_MutexLock(&asyncTestMutex);
    for (asyncPtr = firstHandler; asyncPtr != NULL;
         asyncPtr = asyncPtr->nextPtr) {
        if (asyncPtr->id == id) break;
    }







|
>







950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
                                 * in global list. */
    Tcl_Interp *interp,		/* Interpreter in which command was
				 * executed, or NULL. */
    int code)			/* Current return code from command. */
{
    TestAsyncHandler *asyncPtr;
    int id = PTR2INT(clientData);
    const char *listArgv[4];
    char *cmd;
    char string[TCL_INTEGER_SPACE];

    Tcl_MutexLock(&asyncTestMutex);
    for (asyncPtr = firstHandler; asyncPtr != NULL;
         asyncPtr = asyncPtr->nextPtr) {
        if (asyncPtr->id == id) break;
    }
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
	code = Tcl_EvalEx(interp, cmd, -1, 0);
    } else {
	/*
	 * this should not happen, but by definition of how async handlers are
	 * invoked, it's possible.  Better error checking is needed here.
	 */
    }
    ckfree(cmd);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * AsyncThreadProc --







|







980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
	code = Tcl_EvalEx(interp, cmd, -1, 0);
    } else {
	/*
	 * this should not happen, but by definition of how async handlers are
	 * invoked, it's possible.  Better error checking is needed here.
	 */
    }
    Tcl_Free(cmd);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * AsyncThreadProc --
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
    }

    slave = Tcl_GetSlave(interp, argv[1]);
    if (slave == NULL) {
	return TCL_ERROR;
    }

    dPtr = ckalloc(sizeof(DelCmd));
    dPtr->interp = interp;
    dPtr->deleteCmd = ckalloc(strlen(argv[3]) + 1);
    strcpy(dPtr->deleteCmd, argv[3]);

    Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
	    DelDeleteProc);
    return TCL_OK;
}

static int
DelCmdProc(
    ClientData clientData,	/* String result to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    DelCmd *dPtr = (DelCmd *) clientData;

    Tcl_AppendResult(interp, dPtr->deleteCmd, NULL);
    ckfree(dPtr->deleteCmd);
    ckfree(dPtr);
    return TCL_OK;
}

static void
DelDeleteProc(
    ClientData clientData)	/* String command to evaluate. */
{
    DelCmd *dPtr = clientData;

    Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0);
    Tcl_ResetResult(dPtr->interp);
    ckfree(dPtr->deleteCmd);
    ckfree(dPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestdelassocdataCmd --
 *







|

|

















|
|











|
|







1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
    }

    slave = Tcl_GetSlave(interp, argv[1]);
    if (slave == NULL) {
	return TCL_ERROR;
    }

    dPtr = Tcl_Alloc(sizeof(DelCmd));
    dPtr->interp = interp;
    dPtr->deleteCmd = Tcl_Alloc(strlen(argv[3]) + 1);
    strcpy(dPtr->deleteCmd, argv[3]);

    Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
	    DelDeleteProc);
    return TCL_OK;
}

static int
DelCmdProc(
    ClientData clientData,	/* String result to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    DelCmd *dPtr = (DelCmd *) clientData;

    Tcl_AppendResult(interp, dPtr->deleteCmd, NULL);
    Tcl_Free(dPtr->deleteCmd);
    Tcl_Free(dPtr);
    return TCL_OK;
}

static void
DelDeleteProc(
    ClientData clientData)	/* String command to evaluate. */
{
    DelCmd *dPtr = clientData;

    Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0);
    Tcl_ResetResult(dPtr->interp);
    Tcl_Free(dPtr->deleteCmd);
    Tcl_Free(dPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestdelassocdataCmd --
 *
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
	    return TCL_ERROR;
	}
	type |= TCL_DD_SHORTEN_FLAG;
    }
    str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
    strObj = Tcl_NewStringObj(str, endPtr-str);
    ckfree(str);
    retval = Tcl_NewListObj(1, &strObj);
    Tcl_ListObjAppendElement(NULL, retval, Tcl_NewIntObj(decpt));
    strObj = Tcl_NewStringObj(signum ? "-" : "+", 1);
    Tcl_ListObjAppendElement(NULL, retval, strObj);
    Tcl_SetObjResult(interp, retval);
    return TCL_OK;
}







|







1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
	    return TCL_ERROR;
	}
	type |= TCL_DD_SHORTEN_FLAG;
    }
    str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
    strObj = Tcl_NewStringObj(str, endPtr-str);
    Tcl_Free(str);
    retval = Tcl_NewListObj(1, &strObj);
    Tcl_ListObjAppendElement(NULL, retval, Tcl_NewIntObj(decpt));
    strObj = Tcl_NewStringObj(signum ? "-" : "+", 1);
    Tcl_ListObjAppendElement(NULL, retval, strObj);
    Tcl_SetObjResult(interp, retval);
    return TCL_OK;
}
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
	    goto wrongNumArgs;
	}
	if (strcmp(argv[2], "staticsmall") == 0) {
	    Tcl_AppendResult(interp, "short", NULL);
	} else if (strcmp(argv[2], "staticlarge") == 0) {
	    Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL);
	} else if (strcmp(argv[2], "free") == 0) {
	    char *s = ckalloc(100);
	    strcpy(s, "This is a malloc-ed string");
	    Tcl_SetResult(interp, s, TCL_DYNAMIC);
	} else if (strcmp(argv[2], "special") == 0) {
	    char *s = (char*)ckalloc(100) + 16;
	    strcpy(s, "This is a specially-allocated string");
	    Tcl_SetResult(interp, s, SpecialFree);
	} else {
	    Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
		    "\": must be staticsmall, staticlarge, free, or special",
		    NULL);
	    return TCL_ERROR;







|



|







1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
	    goto wrongNumArgs;
	}
	if (strcmp(argv[2], "staticsmall") == 0) {
	    Tcl_AppendResult(interp, "short", NULL);
	} else if (strcmp(argv[2], "staticlarge") == 0) {
	    Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL);
	} else if (strcmp(argv[2], "free") == 0) {
	    char *s = Tcl_Alloc(100);
	    strcpy(s, "This is a malloc-ed string");
	    Tcl_SetResult(interp, s, TCL_DYNAMIC);
	} else if (strcmp(argv[2], "special") == 0) {
	    char *s = (char*)Tcl_Alloc(100) + 16;
	    strcpy(s, "This is a specially-allocated string");
	    Tcl_SetResult(interp, s, SpecialFree);
	} else {
	    Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
		    "\": must be staticsmall, staticlarge, free, or special",
		    NULL);
	    return TCL_ERROR;
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908

/*
 * The procedure below is used as a special freeProc to test how well
 * Tcl_DStringGetResult handles freeProc's other than free.
 */

static void SpecialFree(blockPtr)
    char *blockPtr;			/* Block to free. */
{
    ckfree(blockPtr - 16);
}

/*
 *----------------------------------------------------------------------
 *
 * TestencodingCmd --
 *







|

|







1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913

/*
 * The procedure below is used as a special freeProc to test how well
 * Tcl_DStringGetResult handles freeProc's other than free.
 */

static void SpecialFree(blockPtr)
    void *blockPtr;			/* Block to free. */
{
    Tcl_Free(((char *)blockPtr) - 16);
}

/*
 *----------------------------------------------------------------------
 *
 * TestencodingCmd --
 *
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
    switch ((enum options) index) {
    case ENC_CREATE: {
	Tcl_EncodingType type;

	if (objc != 5) {
	    return TCL_ERROR;
	}
	encodingPtr = ckalloc(sizeof(TclEncoding));
	encodingPtr->interp = interp;

	string = Tcl_GetStringFromObj(objv[3], &length);
	encodingPtr->toUtfCmd = ckalloc(length + 1);
	memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);

	string = Tcl_GetStringFromObj(objv[4], &length);
	encodingPtr->fromUtfCmd = ckalloc(length + 1);
	memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));

	string = Tcl_GetStringFromObj(objv[2], &length);

	type.encodingName = string;
	type.toUtfProc = EncodingToUtfProc;
	type.fromUtfProc = EncodingFromUtfProc;







|



|



|







1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
    switch ((enum options) index) {
    case ENC_CREATE: {
	Tcl_EncodingType type;

	if (objc != 5) {
	    return TCL_ERROR;
	}
	encodingPtr = Tcl_Alloc(sizeof(TclEncoding));
	encodingPtr->interp = interp;

	string = Tcl_GetStringFromObj(objv[3], &length);
	encodingPtr->toUtfCmd = Tcl_Alloc(length + 1);
	memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);

	string = Tcl_GetStringFromObj(objv[4], &length);
	encodingPtr->fromUtfCmd = Tcl_Alloc(length + 1);
	memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));

	string = Tcl_GetStringFromObj(objv[2], &length);

	type.encodingName = string;
	type.toUtfProc = EncodingToUtfProc;
	type.fromUtfProc = EncodingFromUtfProc;
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069

static void
EncodingFreeProc(
    ClientData clientData)	/* ClientData associated with type. */
{
    TclEncoding *encodingPtr = clientData;

    ckfree(encodingPtr->toUtfCmd);
    ckfree(encodingPtr->fromUtfCmd);
    ckfree(encodingPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestevalexObjCmd --
 *







|
|
|







2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074

static void
EncodingFreeProc(
    ClientData clientData)	/* ClientData associated with type. */
{
    TclEncoding *encodingPtr = clientData;

    Tcl_Free(encodingPtr->toUtfCmd);
    Tcl_Free(encodingPtr->fromUtfCmd);
    Tcl_Free(encodingPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestevalexObjCmd --
 *
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
	    Tcl_WrongNumArgs(interp, 2, objv, "name position script");
	    return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObj(interp, objv[3], positions,
		"position specifier", TCL_EXACT, &posIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	ev = ckalloc(sizeof(TestEvent));
	ev->header.proc = TesteventProc;
	ev->header.nextPtr = NULL;
	ev->interp = interp;
	ev->command = objv[4];
	Tcl_IncrRefCount(ev->command);
	ev->tag = objv[2];
	Tcl_IncrRefCount(ev->tag);







|







2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
	    Tcl_WrongNumArgs(interp, 2, objv, "name position script");
	    return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObj(interp, objv[3], positions,
		"position specifier", TCL_EXACT, &posIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	ev = Tcl_Alloc(sizeof(TestEvent));
	ev->header.proc = TesteventProc;
	ev->header.nextPtr = NULL;
	ev->interp = interp;
	ev->command = objv[4];
	Tcl_IncrRefCount(ev->command);
	ev->tag = objv[2];
	Tcl_IncrRefCount(ev->tag);
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    static int intVar = 43;
    static int boolVar = 4;
    static double realVar = 1.23;
    static Tcl_WideInt wideVar = Tcl_LongAsWide(79);
    static char *stringVar = NULL;
    static char charVar = '@';
    static unsigned char ucharVar = 130;
    static short shortVar = 3000;
    static unsigned short ushortVar = 60000;
    static unsigned int uintVar = 0xbeeffeed;
    static long longVar = 123456789L;
    static unsigned long ulongVar = 3456789012UL;
    static float floatVar = 4.5;
    static Tcl_WideUInt uwideVar = (Tcl_WideUInt) Tcl_LongAsWide(123);
    static int created = 0;
    char buffer[2*TCL_DOUBLE_SPACE];
    int writable, flag;
    Tcl_Obj *tmp;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],







|









|







2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    static int intVar = 43;
    static int boolVar = 4;
    static double realVar = 1.23;
    static Tcl_WideInt wideVar = 79;
    static char *stringVar = NULL;
    static char charVar = '@';
    static unsigned char ucharVar = 130;
    static short shortVar = 3000;
    static unsigned short ushortVar = 60000;
    static unsigned int uintVar = 0xbeeffeed;
    static long longVar = 123456789L;
    static unsigned long ulongVar = 3456789012UL;
    static float floatVar = 4.5;
    static Tcl_WideUInt uwideVar = 123;
    static int created = 0;
    char buffer[2*TCL_DOUBLE_SPACE];
    int writable, flag;
    Tcl_Obj *tmp;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
	if (argv[4][0] != 0) {
	    if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	if (argv[5][0] != 0) {
	    if (stringVar != NULL) {
		ckfree(stringVar);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		stringVar = ckalloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);







|




|







3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
	if (argv[4][0] != 0) {
	    if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	if (argv[5][0] != 0) {
	    if (stringVar != NULL) {
		Tcl_Free(stringVar);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		stringVar = Tcl_Alloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
	    if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_UpdateLinkedVar(interp, "bool");
	}
	if (argv[5][0] != 0) {
	    if (stringVar != NULL) {
		ckfree(stringVar);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		stringVar = ckalloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	    Tcl_UpdateLinkedVar(interp, "string");
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {







|




|







3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
	    if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_UpdateLinkedVar(interp, "bool");
	}
	if (argv[5][0] != 0) {
	    if (stringVar != NULL) {
		Tcl_Free(stringVar);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		stringVar = Tcl_Alloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	    Tcl_UpdateLinkedVar(interp, "string");
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
 */
	/* ARGSUSED */
static void
CleanupTestSetassocdataTests(
    ClientData clientData,	/* Data to be released. */
    Tcl_Interp *interp)		/* Interpreter being deleted. */
{
    ckfree(clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * TestparserObjCmd --
 *







|







3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
 */
	/* ARGSUSED */
static void
CleanupTestSetassocdataTests(
    ClientData clientData,	/* Data to be released. */
    Tcl_Interp *interp)		/* Interpreter being deleted. */
{
    Tcl_Free(clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * TestparserObjCmd --
 *
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" data_key data_item\"", NULL);
	return TCL_ERROR;
    }

    buf = ckalloc(strlen(argv[2]) + 1);
    strcpy(buf, argv[2]);

    /*
     * If we previously associated a malloced value with the variable,
     * free it before associating a new value.
     */

    oldData = (char *) Tcl_GetAssocData(interp, argv[1], &procPtr);
    if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) {
	ckfree(oldData);
    }

    Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests,
	(ClientData) buf);
    return TCL_OK;
}








|









|







4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" data_key data_item\"", NULL);
	return TCL_ERROR;
    }

    buf = Tcl_Alloc(strlen(argv[2]) + 1);
    strcpy(buf, argv[2]);

    /*
     * If we previously associated a malloced value with the variable,
     * free it before associating a new value.
     */

    oldData = (char *) Tcl_GetAssocData(interp, argv[1], &procPtr);
    if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) {
	Tcl_Free(oldData);
    }

    Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests,
	(ClientData) buf);
    return TCL_OK;
}

4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
    /*
     *  Put the arguments into a var args structure
     *  Append all of the arguments together separated by spaces
     */

    argString = Tcl_Merge(argc-1, argv+1);
    Tcl_Panic("%s", argString);
    ckfree(argString);

    return TCL_OK;
}

static int
TestfileCmd(
    ClientData dummy,		/* Not used. */







|







4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
    /*
     *  Put the arguments into a var args structure
     *  Append all of the arguments together separated by spaces
     */

    argString = Tcl_Merge(argc-1, argv+1);
    Tcl_Panic("%s", argString);
    Tcl_Free(argString);

    return TCL_OK;
}

static int
TestfileCmd(
    ClientData dummy,		/* Not used. */
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
    const char *s;
    char newString[TCL_INTEGER_SPACE];

    /* alloc & free 100000 times */
    fprintf(stderr, "alloc & free 100000 6 word items\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	objPtr = ckalloc(sizeof(Tcl_Obj));
	ckfree(objPtr);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per alloc+free\n", timePer/100000);

    /* alloc 5000 times */
    fprintf(stderr, "alloc 5000 6 word items\n");
    objv = ckalloc(5000 * sizeof(Tcl_Obj *));
    Tcl_GetTime(&start);
    for (i = 0;  i < 5000;  i++) {
	objv[i] = ckalloc(sizeof(Tcl_Obj));
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per alloc\n", timePer/5000);

    /* free 5000 times */
    fprintf(stderr, "free 5000 6 word items\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 5000;  i++) {
	ckfree(objv[i]);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per free\n", timePer/5000);

    /* Tcl_NewObj 5000 times */
    fprintf(stderr, "Tcl_NewObj 5000 times\n");







|
|







|


|









|







4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
    const char *s;
    char newString[TCL_INTEGER_SPACE];

    /* alloc & free 100000 times */
    fprintf(stderr, "alloc & free 100000 6 word items\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	objPtr = Tcl_Alloc(sizeof(Tcl_Obj));
	Tcl_Free(objPtr);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per alloc+free\n", timePer/100000);

    /* alloc 5000 times */
    fprintf(stderr, "alloc 5000 6 word items\n");
    objv = Tcl_Alloc(5000 * sizeof(Tcl_Obj *));
    Tcl_GetTime(&start);
    for (i = 0;  i < 5000;  i++) {
	objv[i] = Tcl_Alloc(sizeof(Tcl_Obj));
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per alloc\n", timePer/5000);

    /* free 5000 times */
    fprintf(stderr, "free 5000 6 word items\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 5000;  i++) {
	Tcl_Free(objv[i]);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per free\n", timePer/5000);

    /* Tcl_NewObj 5000 times */
    fprintf(stderr, "Tcl_NewObj 5000 times\n");
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
    for (i = 0;  i < 5000;  i++) {
	objPtr = objv[i];
	Tcl_DecrRefCount(objPtr);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
    ckfree(objv);

    /* TclGetString 100000 times */
    fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n");
    objPtr = Tcl_NewStringObj("12345", -1);
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	(void) TclGetString(objPtr);







|







4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
    for (i = 0;  i < 5000;  i++) {
	objPtr = objv[i];
	Tcl_DecrRefCount(objPtr);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
    Tcl_Free(objv);

    /* TclGetString 100000 times */
    fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n");
    objPtr = Tcl_NewStringObj("12345", -1);
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	(void) TclGetString(objPtr);
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
    case RESULT_SMALL:
	Tcl_AppendResult(interp, "small result", NULL);
	break;
    case RESULT_APPEND:
	Tcl_AppendResult(interp, "append result", NULL);
	break;
    case RESULT_FREE: {
	char *buf = ckalloc(200);

	strcpy(buf, "free result");
	Tcl_SetResult(interp, buf, TCL_DYNAMIC);
	break;
    }
    case RESULT_DYNAMIC:
	Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);







|







5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
    case RESULT_SMALL:
	Tcl_AppendResult(interp, "small result", NULL);
	break;
    case RESULT_APPEND:
	Tcl_AppendResult(interp, "append result", NULL);
	break;
    case RESULT_FREE: {
	char *buf = Tcl_Alloc(200);

	strcpy(buf, "free result");
	Tcl_SetResult(interp, buf, TCL_DYNAMIC);
	break;
    }
    case RESULT_DYNAMIC:
	Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
 *	Increments the freeCount.
 *
 *----------------------------------------------------------------------
 */

static void
TestsaveresultFree(
    char *blockPtr)
{
    freeCount++;
}

/*
 *----------------------------------------------------------------------
 *







|







5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
 *	Increments the freeCount.
 *
 *----------------------------------------------------------------------
 */

static void
TestsaveresultFree(
    void *blockPtr)
{
    freeCount++;
}

/*
 *----------------------------------------------------------------------
 *
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
		 curPtr != NULL;
		 nextPtrPtr = &(curPtr->nextPtr), curPtr = curPtr->nextPtr) {

		if (strcmp(argv[2], Tcl_GetChannelName(curPtr->chan)) == 0) {
		    *nextPtrPtr = curPtr->nextPtr;
		    curPtr->nextPtr = NULL;
		    chan = curPtr->chan;
		    ckfree(curPtr);
		    break;
		}
	    }
	} else {
	    chan = Tcl_GetChannel(interp, argv[2], &mode);
	}
	if (chan == (Tcl_Channel) NULL) {







|







5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
		 curPtr != NULL;
		 nextPtrPtr = &(curPtr->nextPtr), curPtr = curPtr->nextPtr) {

		if (strcmp(argv[2], Tcl_GetChannelName(curPtr->chan)) == 0) {
		    *nextPtrPtr = curPtr->nextPtr;
		    curPtr->nextPtr = NULL;
		    chan = curPtr->chan;
		    Tcl_Free(curPtr);
		    break;
		}
	    }
	} else {
	    chan = Tcl_GetChannel(interp, argv[2], &mode);
	}
	if (chan == (Tcl_Channel) NULL) {
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
	Tcl_RegisterChannel(NULL, chan); /* prevent closing */
	Tcl_UnregisterChannel(interp, chan);

	Tcl_CutChannel(chan);

	/* Remember the channel in the pool of detached channels */

	det = ckalloc(sizeof(TestChannel));
	det->chan     = chan;
	det->nextPtr  = firstDetached;
	firstDetached = det;

	return TCL_OK;
    }








|







5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
	Tcl_RegisterChannel(NULL, chan); /* prevent closing */
	Tcl_UnregisterChannel(interp, chan);

	Tcl_CutChannel(chan);

	/* Remember the channel in the pool of detached channels */

	det = Tcl_Alloc(sizeof(TestChannel));
	det->chan     = chan;
	det->nextPtr  = firstDetached;
	firstDetached = det;

	return TCL_OK;
    }

5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
	    mask = 0;
	} else {
	    Tcl_AppendResult(interp, "bad event name \"", argv[3],
		    "\": must be readable, writable, or none", NULL);
	    return TCL_ERROR;
	}

	esPtr = ckalloc(sizeof(EventScriptRecord));
	esPtr->nextPtr = statePtr->scriptRecordPtr;
	statePtr->scriptRecordPtr = esPtr;

	esPtr->chanPtr = chanPtr;
	esPtr->interp = interp;
	esPtr->mask = mask;
	esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);







|







5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
	    mask = 0;
	} else {
	    Tcl_AppendResult(interp, "bad event name \"", argv[3],
		    "\": must be readable, writable, or none", NULL);
	    return TCL_ERROR;
	}

	esPtr = Tcl_Alloc(sizeof(EventScriptRecord));
	esPtr->nextPtr = statePtr->scriptRecordPtr;
	statePtr->scriptRecordPtr = esPtr;

	esPtr->chanPtr = chanPtr;
	esPtr->interp = interp;
	esPtr->mask = mask;
	esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
		Tcl_Panic("TestChannelEventCmd: damaged event script list");
	    }
	    prevEsPtr->nextPtr = esPtr->nextPtr;
	}
	Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		TclChannelEventScriptInvoker, (ClientData) esPtr);
	Tcl_DecrRefCount(esPtr->scriptPtr);
	ckfree(esPtr);

	return TCL_OK;
    }

    if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],







|







5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
		Tcl_Panic("TestChannelEventCmd: damaged event script list");
	    }
	    prevEsPtr->nextPtr = esPtr->nextPtr;
	}
	Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		TclChannelEventScriptInvoker, (ClientData) esPtr);
	Tcl_DecrRefCount(esPtr->scriptPtr);
	Tcl_Free(esPtr);

	return TCL_OK;
    }

    if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
	for (esPtr = statePtr->scriptRecordPtr;
	     esPtr != NULL;
	     esPtr = nextEsPtr) {
	    nextEsPtr = esPtr->nextPtr;
	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, (ClientData) esPtr);
	    Tcl_DecrRefCount(esPtr->scriptPtr);
	    ckfree(esPtr);
	}
	statePtr->scriptRecordPtr = NULL;
	return TCL_OK;
    }

    if	((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
	if (argc != 5) {







|







5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
	for (esPtr = statePtr->scriptRecordPtr;
	     esPtr != NULL;
	     esPtr = nextEsPtr) {
	    nextEsPtr = esPtr->nextPtr;
	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, (ClientData) esPtr);
	    Tcl_DecrRefCount(esPtr->scriptPtr);
	    Tcl_Free(esPtr);
	}
	statePtr->scriptRecordPtr = NULL;
	return TCL_OK;
    }

    if	((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
	if (argc != 5) {
6866
6867
6868
6869
6870
6871
6872
6873
6874
6875
6876
6877
6878
6879
6880
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, INT2PTR(i+42));
    }

    if (hash.numEntries != limit) {
	Tcl_AppendResult(interp, "unexpected maximal size", NULL);
	Tcl_DeleteHashTable(&hash);
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));







|







6871
6872
6873
6874
6875
6876
6877
6878
6879
6880
6881
6882
6883
6884
6885
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, INT2PTR(i+42));
    }

    if (hash.numEntries != (size_t)limit) {
	Tcl_AppendResult(interp, "unexpected maximal size", NULL);
	Tcl_DeleteHashTable(&hash);
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
6927
6928
6929
6930
6931
6932
6933


















6934
6935
6936
6937
6938
6939
6940
	    }
	    total += val;
	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
	return TCL_OK;
    }
}



















static int
NREUnwind_callback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







6932
6933
6934
6935
6936
6937
6938
6939
6940
6941
6942
6943
6944
6945
6946
6947
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963
	    }
	    total += val;
	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
	return TCL_OK;
    }
}

/*
 * Used for determining sizeof(long) at script level.
 */
static int
TestlongsizeCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int argc,
    const char **argv)
{
    if (argc != 1) {
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long)));
    return TCL_OK;
}

static int
NREUnwind_callback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
7053
7054
7055
7056
7057
7058
7059
7060
7061
7062
7063
7064
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
	    Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1));

    emptyPtr = Tcl_NewObj();

    list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
    Tcl_ListObjLength(NULL, list1Ptr, &len);
    if (list1Ptr->bytes != NULL) {
	ckfree(list1Ptr->bytes);
	list1Ptr->bytes = NULL;
    }

    list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
    Tcl_ListObjLength(NULL, list2Ptr, &len);
    if (list2Ptr->bytes != NULL) {
	ckfree(list2Ptr->bytes);
	list2Ptr->bytes = NULL;
    }

    /*
     * Verify that concat'ing a list obj with one or more empty strings does
     * return a fresh Tcl_Obj (see also [Bug 2055782]).
     */







|






|







7076
7077
7078
7079
7080
7081
7082
7083
7084
7085
7086
7087
7088
7089
7090
7091
7092
7093
7094
7095
7096
7097
	    Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1));

    emptyPtr = Tcl_NewObj();

    list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
    Tcl_ListObjLength(NULL, list1Ptr, &len);
    if (list1Ptr->bytes != NULL) {
	Tcl_Free(list1Ptr->bytes);
	list1Ptr->bytes = NULL;
    }

    list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
    Tcl_ListObjLength(NULL, list2Ptr, &len);
    if (list2Ptr->bytes != NULL) {
	Tcl_Free(list2Ptr->bytes);
	list2Ptr->bytes = NULL;
    }

    /*
     * Verify that concat'ing a list obj with one or more empty strings does
     * return a fresh Tcl_Obj (see also [Bug 2055782]).
     */
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367
7368
7369
    if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
        return TCL_ERROR;
    }
    result[0] = Tcl_NewIntObj(foo);
    result[1] = Tcl_NewIntObj(count);
    result[2] = Tcl_NewListObj(count, remObjv);
    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
    ckfree(remObjv);
    return TCL_OK;
}

/**
 * Test harness for command and variable resolvers.
 */








|







7378
7379
7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390
7391
7392
    if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
        return TCL_ERROR;
    }
    result[0] = Tcl_NewIntObj(foo);
    result[1] = Tcl_NewIntObj(count);
    result[2] = Tcl_NewListObj(count, remObjv);
    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
    Tcl_Free(remObjv);
    return TCL_OK;
}

/**
 * Test harness for command and variable resolvers.
 */

7482
7483
7484
7485
7486
7487
7488
7489
7490
7491
7492
7493
7494
7495
7496
7497
7498
7499
7500
7501
7502
7503
7504
7505
7506
7507
7508
7509
7510
7511
7512
} MyResolvedVarInfo;

static inline void
HashVarFree(
    Tcl_Var var)
{
    if (VarHashRefCount(var) < 2) {
        ckfree(var);
    } else {
        VarHashRefCount(var)--;
    }
}

static void
MyCompiledVarFree(
    Tcl_ResolvedVarInfo *vInfoPtr)
{
    MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vInfoPtr;

    Tcl_DecrRefCount(resVarInfo->nameObj);
    if (resVarInfo->var) {
        HashVarFree(resVarInfo->var);
    }
    ckfree(vInfoPtr);
}

#define TclVarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))

static Tcl_Var
MyCompiledVarFetch(







|















|







7505
7506
7507
7508
7509
7510
7511
7512
7513
7514
7515
7516
7517
7518
7519
7520
7521
7522
7523
7524
7525
7526
7527
7528
7529
7530
7531
7532
7533
7534
7535
} MyResolvedVarInfo;

static inline void
HashVarFree(
    Tcl_Var var)
{
    if (VarHashRefCount(var) < 2) {
        Tcl_Free(var);
    } else {
        VarHashRefCount(var)--;
    }
}

static void
MyCompiledVarFree(
    Tcl_ResolvedVarInfo *vInfoPtr)
{
    MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vInfoPtr;

    Tcl_DecrRefCount(resVarInfo->nameObj);
    if (resVarInfo->var) {
        HashVarFree(resVarInfo->var);
    }
    Tcl_Free(vInfoPtr);
}

#define TclVarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))

static Tcl_Var
MyCompiledVarFetch(
7541
7542
7543
7544
7545
7546
7547
7548
7549
7550
7551
7552
7553
7554
7555
7556
7557
7558
7559
7560
7561
7562
7563
7564
7565
7566
7567
7568
7569
7570
7571
7572
        var = (Tcl_Var) TclVarHashGetValue(hPtr);
    } else {
        var = NULL;
    }
    resVarInfo->var = var;

    /*
     * Increment the reference counter to avoid ckfree() of the variable in
     * Tcl's FreeVarEntry(); for cleanup, we provide our own HashVarFree();
     */

    VarHashRefCount(var)++;
    return var;
}

static int
InterpCompiledVarResolver(
    Tcl_Interp *interp,
    const char *name,
    int length,
    Tcl_Namespace *context,
    Tcl_ResolvedVarInfo **rPtr)
{
    if (*name == 'T') {
 	MyResolvedVarInfo *resVarInfo = ckalloc(sizeof(MyResolvedVarInfo));

 	resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
 	resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
 	resVarInfo->var = NULL;
 	resVarInfo->nameObj = Tcl_NewStringObj(name, -1);
 	Tcl_IncrRefCount(resVarInfo->nameObj);
 	*rPtr = &resVarInfo->vInfo;







|
















|







7564
7565
7566
7567
7568
7569
7570
7571
7572
7573
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
7589
7590
7591
7592
7593
7594
7595
        var = (Tcl_Var) TclVarHashGetValue(hPtr);
    } else {
        var = NULL;
    }
    resVarInfo->var = var;

    /*
     * Increment the reference counter to avoid Tcl_Free() of the variable in
     * Tcl's FreeVarEntry(); for cleanup, we provide our own HashVarFree();
     */

    VarHashRefCount(var)++;
    return var;
}

static int
InterpCompiledVarResolver(
    Tcl_Interp *interp,
    const char *name,
    int length,
    Tcl_Namespace *context,
    Tcl_ResolvedVarInfo **rPtr)
{
    if (*name == 'T') {
 	MyResolvedVarInfo *resVarInfo = Tcl_Alloc(sizeof(MyResolvedVarInfo));

 	resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
 	resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
 	resVarInfo->var = NULL;
 	resVarInfo->nameObj = Tcl_NewStringObj(name, -1);
 	Tcl_IncrRefCount(resVarInfo->nameObj);
 	*rPtr = &resVarInfo->vInfo;
Changes to generic/tclTestObj.c.
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
{
    register int i;
    Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
    }
    Tcl_DeleteAssocData(interp, VARPTR_KEY);
    ckfree(varPtr);
}

static Tcl_Obj **GetVarPtr(Tcl_Interp *interp)
{
    Tcl_InterpDeleteProc *proc;

    return (Tcl_Obj **) Tcl_GetAssocData(interp, VARPTR_KEY, &proc);







|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
{
    register int i;
    Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
    }
    Tcl_DeleteAssocData(interp, VARPTR_KEY);
    Tcl_Free(varPtr);
}

static Tcl_Obj **GetVarPtr(Tcl_Interp *interp)
{
    Tcl_InterpDeleteProc *proc;

    return (Tcl_Obj **) Tcl_GetAssocData(interp, VARPTR_KEY, &proc);
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
    /*
     * An array of Tcl_Obj pointers used in the commands that operate on or get
     * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
     * Tcl_Obj *.
     */
    Tcl_Obj **varPtr;

    varPtr = (Tcl_Obj **) ckalloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0]));
    if (!varPtr) {
	return TCL_ERROR;
    }
    Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr);
    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	varPtr[i] = NULL;
    }







|







95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
    /*
     * An array of Tcl_Obj pointers used in the commands that operate on or get
     * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
     * Tcl_Obj *.
     */
    Tcl_Obj **varPtr;

    varPtr = (Tcl_Obj **) Tcl_Alloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0]));
    if (!varPtr) {
	return TCL_ERROR;
    }
    Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr);
    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	varPtr[i] = NULL;
    }
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
    const char **argv;
    static const char *const tablePtr[] = {"a", "b", "check", NULL};
    /*
     * Keep this structure declaration in sync with tclIndexObj.c
     */
    struct IndexRep {
	void *tablePtr;		/* Pointer to the table of strings. */
	int offset;		/* Offset between table entries. */
	int index;		/* Selected index into table. */
    };
    struct IndexRep *indexRep;

    if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
	    "check") == 0)) {
	/*
	 * This code checks to be sure that the results of Tcl_GetIndexFromObj







|
|







572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
    const char **argv;
    static const char *const tablePtr[] = {"a", "b", "check", NULL};
    /*
     * Keep this structure declaration in sync with tclIndexObj.c
     */
    struct IndexRep {
	void *tablePtr;		/* Pointer to the table of strings. */
	size_t offset;		/* Offset between table entries. */
	size_t index;		/* Selected index into table. */
    };
    struct IndexRep *indexRep;

    if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
	    "check") == 0)) {
	/*
	 * This code checks to be sure that the results of Tcl_GetIndexFromObj
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
    if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
	return TCL_ERROR;
    }

    argv = ckalloc((objc-3) * sizeof(char *));
    for (i = 4; i < objc; i++) {
	argv[i-4] = Tcl_GetString(objv[i]);
    }
    argv[objc-4] = NULL;

    result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
	    argv, "token", INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
	    &index);
    ckfree(argv);
    if (result == TCL_OK) {
	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
    }
    return result;
}

/*







|








|







612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
    if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
	return TCL_ERROR;
    }

    argv = Tcl_Alloc((objc-3) * sizeof(char *));
    for (i = 4; i < objc; i++) {
	argv[i-4] = Tcl_GetString(objv[i]);
    }
    argv[objc-4] = NULL;

    result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
	    argv, "token", INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
	    &index);
    Tcl_Free(argv);
    if (result == TCL_OK) {
	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
    }
    return result;
}

/*
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
	    string = Tcl_GetString(varPtr[varIndex]);
	    Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
	    break;
	case 4:				/* length */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
		    ? varPtr[varIndex]->length : -1);
	    break;
	case 5:				/* length2 */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],







|
|







1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
	    string = Tcl_GetString(varPtr[varIndex]);
	    Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
	    break;
	case 4:				/* length */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
		    ? (Tcl_WideInt)varPtr[varIndex]->length : (Tcl_WideInt)-1);
	    break;
	case 5:				/* length2 */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
Changes to generic/tclThread.c.
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_GetThreadData(
    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk */
    int size)			/* Size of storage block */
{
    void *result;
#if TCL_THREADS
    /*
     * Initialize the key for this thread.
     */

    result = TclThreadStorageKeyGet(keyPtr);

    if (result == NULL) {
	result = ckalloc(size);
	memset(result, 0, (size_t) size);
	TclThreadStorageKeySet(keyPtr, result);
    }
#else /* TCL_THREADS */
    if (*keyPtr == NULL) {
	result = ckalloc(size);
	memset(result, 0, (size_t)size);
	*keyPtr = result;
	RememberSyncObject(keyPtr, &keyRecord);
    } else {
	result = *keyPtr;
    }
#endif /* TCL_THREADS */
    return result;







|










|
|




|
|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_GetThreadData(
    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk */
    size_t size)		/* Size of storage block */
{
    void *result;
#if TCL_THREADS
    /*
     * Initialize the key for this thread.
     */

    result = TclThreadStorageKeyGet(keyPtr);

    if (result == NULL) {
	result = Tcl_Alloc(size);
	memset(result, 0, size);
	TclThreadStorageKeySet(keyPtr, result);
    }
#else /* TCL_THREADS */
    if (*keyPtr == NULL) {
	result = Tcl_Alloc(size);
	memset(result, 0, size);
	*keyPtr = result;
	RememberSyncObject(keyPtr, &keyRecord);
    } else {
	result = *keyPtr;
    }
#endif /* TCL_THREADS */
    return result;
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
    /*
     * Grow the list of pointers if necessary, copying only non-NULL
     * pointers to the new list.
     */

    if (recPtr->num >= recPtr->max) {
	recPtr->max += 8;
	newList = ckalloc(recPtr->max * sizeof(void *));
	for (i=0,j=0 ; i<recPtr->num ; i++) {
	    if (recPtr->list[i] != NULL) {
		newList[j++] = recPtr->list[i];
	    }
	}
	if (recPtr->list != NULL) {
	    ckfree(recPtr->list);
	}
	recPtr->list = newList;
	recPtr->num = j;
    }

    recPtr->list[recPtr->num] = objPtr;
    recPtr->num++;







|






|







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
    /*
     * Grow the list of pointers if necessary, copying only non-NULL
     * pointers to the new list.
     */

    if (recPtr->num >= recPtr->max) {
	recPtr->max += 8;
	newList = Tcl_Alloc(recPtr->max * sizeof(void *));
	for (i=0,j=0 ; i<recPtr->num ; i++) {
	    if (recPtr->list[i] != NULL) {
		newList[j++] = recPtr->list[i];
	    }
	}
	if (recPtr->list != NULL) {
	    Tcl_Free(recPtr->list);
	}
	recPtr->list = newList;
	recPtr->num = j;
    }

    recPtr->list[recPtr->num] = objPtr;
    recPtr->num++;
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
     * their thread data keys. Free them here.
     */

    if (keyRecord.list != NULL) {
	for (i=0 ; i<keyRecord.num ; i++) {
	    keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i];
	    blockPtr = *keyPtr;
	    ckfree(blockPtr);
	}
	ckfree(keyRecord.list);
	keyRecord.list = NULL;
    }
    keyRecord.max = 0;
    keyRecord.num = 0;

#if TCL_THREADS
    /*
     * Call thread storage master cleanup.
     */

    TclFinalizeThreadStorage();

    for (i=0 ; i<mutexRecord.num ; i++) {
	mutexPtr = (Tcl_Mutex *)mutexRecord.list[i];
	if (mutexPtr != NULL) {
	    TclpFinalizeMutex(mutexPtr);
	}
    }
    if (mutexRecord.list != NULL) {
	ckfree(mutexRecord.list);
	mutexRecord.list = NULL;
    }
    mutexRecord.max = 0;
    mutexRecord.num = 0;

    for (i=0 ; i<condRecord.num ; i++) {
	condPtr = (Tcl_Condition *) condRecord.list[i];
	if (condPtr != NULL) {
	    TclpFinalizeCondition(condPtr);
	}
    }
    if (condRecord.list != NULL) {
	ckfree(condRecord.list);
	condRecord.list = NULL;
    }
    condRecord.max = 0;
    condRecord.num = 0;

    TclpMasterUnlock();
#endif /* TCL_THREADS */







|

|



















|












|







388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
     * their thread data keys. Free them here.
     */

    if (keyRecord.list != NULL) {
	for (i=0 ; i<keyRecord.num ; i++) {
	    keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i];
	    blockPtr = *keyPtr;
	    Tcl_Free(blockPtr);
	}
	Tcl_Free(keyRecord.list);
	keyRecord.list = NULL;
    }
    keyRecord.max = 0;
    keyRecord.num = 0;

#if TCL_THREADS
    /*
     * Call thread storage master cleanup.
     */

    TclFinalizeThreadStorage();

    for (i=0 ; i<mutexRecord.num ; i++) {
	mutexPtr = (Tcl_Mutex *)mutexRecord.list[i];
	if (mutexPtr != NULL) {
	    TclpFinalizeMutex(mutexPtr);
	}
    }
    if (mutexRecord.list != NULL) {
	Tcl_Free(mutexRecord.list);
	mutexRecord.list = NULL;
    }
    mutexRecord.max = 0;
    mutexRecord.num = 0;

    for (i=0 ; i<condRecord.num ; i++) {
	condPtr = (Tcl_Condition *) condRecord.list[i];
	if (condPtr != NULL) {
	    TclpFinalizeCondition(condPtr);
	}
    }
    if (condRecord.list != NULL) {
	Tcl_Free(condRecord.list);
	condRecord.list = NULL;
    }
    condRecord.max = 0;
    condRecord.num = 0;

    TclpMasterUnlock();
#endif /* TCL_THREADS */
Changes to generic/tclThreadAlloc.c.
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
 *
 * Side effects:
 *	May allocate more blocks for a bucket.
 *
 *----------------------------------------------------------------------
 */

char *
TclpAlloc(
    unsigned int reqSize)
{
    Cache *cachePtr;
    Block *blockPtr;
    register int bucket;
    size_t size;

#ifndef __LP64__
    if (sizeof(int) >= sizeof(size_t)) {
	/* An unsigned int overflow can also be a size_t overflow */
	const size_t zero = 0;
	const size_t max = ~zero;

	if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
	    /* Requested allocation exceeds memory */
	    return NULL;
	}
    }
#endif

    GETCACHE(cachePtr);







|

|












|







295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
 *
 * Side effects:
 *	May allocate more blocks for a bucket.
 *
 *----------------------------------------------------------------------
 */

void *
TclpAlloc(
    size_t reqSize)
{
    Cache *cachePtr;
    Block *blockPtr;
    register int bucket;
    size_t size;

#ifndef __LP64__
    if (sizeof(int) >= sizeof(size_t)) {
	/* An unsigned int overflow can also be a size_t overflow */
	const size_t zero = 0;
	const size_t max = ~zero;

	if (reqSize > max - sizeof(Block) - RCHECK) {
	    /* Requested allocation exceeds memory */
	    return NULL;
	}
    }
#endif

    GETCACHE(cachePtr);
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
 *	May move blocks to shared cache.
 *
 *----------------------------------------------------------------------
 */

void
TclpFree(
    char *ptr)
{
    Cache *cachePtr;
    Block *blockPtr;
    int bucket;

    if (ptr == NULL) {
	return;







|







374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
 *	May move blocks to shared cache.
 *
 *----------------------------------------------------------------------
 */

void
TclpFree(
    void *ptr)
{
    Cache *cachePtr;
    Block *blockPtr;
    int bucket;

    if (ptr == NULL) {
	return;
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
 *
 * Side effects:
 *	Previous memory, if any, may be freed.
 *
 *----------------------------------------------------------------------
 */

char *
TclpRealloc(
    char *ptr,
    unsigned int reqSize)
{
    Cache *cachePtr;
    Block *blockPtr;
    void *newPtr;
    size_t size, min;
    int bucket;

    if (ptr == NULL) {
	return TclpAlloc(reqSize);
    }

#ifndef __LP64__
    if (sizeof(int) >= sizeof(size_t)) {
	/* An unsigned int overflow can also be a size_t overflow */
	const size_t zero = 0;
	const size_t max = ~zero;

	if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
	    /* Requested allocation exceeds memory */
	    return NULL;
	}
    }
#endif

    GETCACHE(cachePtr);







|

|
|

















|







431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
 *
 * Side effects:
 *	Previous memory, if any, may be freed.
 *
 *----------------------------------------------------------------------
 */

void *
TclpRealloc(
    void *ptr,
    size_t reqSize)
{
    Cache *cachePtr;
    Block *blockPtr;
    void *newPtr;
    size_t size, min;
    int bucket;

    if (ptr == NULL) {
	return TclpAlloc(reqSize);
    }

#ifndef __LP64__
    if (sizeof(int) >= sizeof(size_t)) {
	/* An unsigned int overflow can also be a size_t overflow */
	const size_t zero = 0;
	const size_t max = ~zero;

	if ((reqSize) > max - sizeof(Block) - RCHECK) {
	    /* Requested allocation exceeds memory */
	    return NULL;
	}
    }
#endif

    GETCACHE(cachePtr);
Changes to generic/tclThreadJoin.c.
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
     * the structure and return.
     */

    *result = threadPtr->result;

    Tcl_ConditionFinalize(&threadPtr->cond);
    Tcl_MutexFinalize(&threadPtr->threadMutex);
    ckfree(threadPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
     * the structure and return.
     */

    *result = threadPtr->result;

    Tcl_ConditionFinalize(&threadPtr->cond);
    Tcl_MutexFinalize(&threadPtr->threadMutex);
    Tcl_Free(threadPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240

void
TclRememberJoinableThread(
    Tcl_ThreadId id)		/* The thread to remember as joinable */
{
    JoinableThread *threadPtr;

    threadPtr = ckalloc(sizeof(JoinableThread));
    threadPtr->id = id;
    threadPtr->done = 0;
    threadPtr->waitedUpon = 0;
    threadPtr->threadMutex = (Tcl_Mutex) NULL;
    threadPtr->cond = (Tcl_Condition) NULL;

    Tcl_MutexLock(&joinMutex);







|







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240

void
TclRememberJoinableThread(
    Tcl_ThreadId id)		/* The thread to remember as joinable */
{
    JoinableThread *threadPtr;

    threadPtr = Tcl_Alloc(sizeof(JoinableThread));
    threadPtr->id = id;
    threadPtr->done = 0;
    threadPtr->waitedUpon = 0;
    threadPtr->threadMutex = (Tcl_Mutex) NULL;
    threadPtr->cond = (Tcl_Condition) NULL;

    Tcl_MutexLock(&joinMutex);
Changes to generic/tclThreadStorage.c.
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
    for (i=0 ; i<tsdTablePtr->allocated ; i++) {
	if (tsdTablePtr->tablePtr[i] != NULL) {
	    /*
	     * These values were allocated in Tcl_GetThreadData in tclThread.c
	     * and must now be deallocated or they will leak.
	     */

	    ckfree(tsdTablePtr->tablePtr[i]);
	}
    }

    TclpSysFree(tsdTablePtr->tablePtr);
    TclpSysFree(tsdTablePtr);
}








|







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
    for (i=0 ; i<tsdTablePtr->allocated ; i++) {
	if (tsdTablePtr->tablePtr[i] != NULL) {
	    /*
	     * These values were allocated in Tcl_GetThreadData in tclThread.c
	     * and must now be deallocated or they will leak.
	     */

	    Tcl_Free(tsdTablePtr->tablePtr[i]);
	}
    }

    TclpSysFree(tsdTablePtr->tablePtr);
    TclpSysFree(tsdTablePtr);
}

Changes to generic/tclThreadTest.c.
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "proc");
	    return TCL_ERROR;
	}
	Tcl_MutexLock(&threadMutex);
	errorThreadId = Tcl_GetCurrentThread();
	if (errorProcString) {
	    ckfree(errorProcString);
	}
	proc = Tcl_GetString(objv[2]);
	errorProcString = ckalloc(strlen(proc) + 1);
	strcpy(errorProcString, proc);
	Tcl_MutexUnlock(&threadMutex);
	return TCL_OK;
    }
    case THREAD_WAIT:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");







|


|







428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "proc");
	    return TCL_ERROR;
	}
	Tcl_MutexLock(&threadMutex);
	errorThreadId = Tcl_GetCurrentThread();
	if (errorProcString) {
	    Tcl_Free(errorProcString);
	}
	proc = Tcl_GetString(objv[2]);
	errorProcString = Tcl_Alloc(strlen(proc) + 1);
	strcpy(errorProcString, proc);
	Tcl_MutexUnlock(&threadMutex);
	return TCL_OK;
    }
    case THREAD_WAIT:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
    ListUpdateInner(tsdPtr);

    /*
     * We need to keep a pointer to the alloc'ed mem of the script we are
     * eval'ing, for the case that we exit during evaluation
     */

    threadEvalScript = ckalloc(strlen(ctrlPtr->script) + 1);
    strcpy(threadEvalScript, ctrlPtr->script);

    Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript);

    /*
     * Notify the parent we are alive.
     */







|







591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
    ListUpdateInner(tsdPtr);

    /*
     * We need to keep a pointer to the alloc'ed mem of the script we are
     * eval'ing, for the case that we exit during evaluation
     */

    threadEvalScript = Tcl_Alloc(strlen(ctrlPtr->script) + 1);
    strcpy(threadEvalScript, ctrlPtr->script);

    Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript);

    /*
     * Notify the parent we are alive.
     */
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
	Tcl_WriteChars(errChannel, "\n", 1);
    } else {
	argv[0] = errorProcString;
	argv[1] = buf;
	argv[2] = errorInfo;
	script = Tcl_Merge(3, argv);
	ThreadSend(interp, errorThreadId, script, 0);
	ckfree(script);
    }
}


/*
 *------------------------------------------------------------------------
 *







|







666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
	Tcl_WriteChars(errChannel, "\n", 1);
    } else {
	argv[0] = errorProcString;
	argv[1] = buf;
	argv[2] = errorInfo;
	script = Tcl_Merge(3, argv);
	ThreadSend(interp, errorThreadId, script, 0);
	Tcl_Free(script);
    }
}


/*
 *------------------------------------------------------------------------
 *
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
	return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
    }

    /*
     * Create the event for its event queue.
     */

    threadEventPtr = ckalloc(sizeof(ThreadEvent));
    threadEventPtr->script = ckalloc(strlen(script) + 1);
    strcpy(threadEventPtr->script, script);
    if (!wait) {
	resultPtr = threadEventPtr->resultPtr = NULL;
    } else {
	resultPtr = ckalloc(sizeof(ThreadEventResult));
	threadEventPtr->resultPtr = resultPtr;

	/*
	 * Initialize the result fields.
	 */

	resultPtr->done = NULL;







|
|




|







836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
	return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
    }

    /*
     * Create the event for its event queue.
     */

    threadEventPtr = Tcl_Alloc(sizeof(ThreadEvent));
    threadEventPtr->script = Tcl_Alloc(strlen(script) + 1);
    strcpy(threadEventPtr->script, script);
    if (!wait) {
	resultPtr = threadEventPtr->resultPtr = NULL;
    } else {
	resultPtr = Tcl_Alloc(sizeof(ThreadEventResult));
	threadEventPtr->resultPtr = resultPtr;

	/*
	 * Initialize the result fields.
	 */

	resultPtr->done = NULL;
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
    resultPtr->prevPtr = NULL;

    Tcl_MutexUnlock(&threadMutex);

    if (resultPtr->code != TCL_OK) {
	if (resultPtr->errorCode) {
	    Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
	    ckfree(resultPtr->errorCode);
	}
	if (resultPtr->errorInfo) {
	    Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
	    ckfree(resultPtr->errorInfo);
	}
    }
    Tcl_AppendResult(interp, resultPtr->result, NULL);
    Tcl_ConditionFinalize(&resultPtr->done);
    code = resultPtr->code;

    ckfree(resultPtr->result);
    ckfree(resultPtr);

    return code;
}

/*
 *------------------------------------------------------------------------
 *







|



|






|
|







914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
    resultPtr->prevPtr = NULL;

    Tcl_MutexUnlock(&threadMutex);

    if (resultPtr->code != TCL_OK) {
	if (resultPtr->errorCode) {
	    Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
	    Tcl_Free(resultPtr->errorCode);
	}
	if (resultPtr->errorInfo) {
	    Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
	    Tcl_Free(resultPtr->errorInfo);
	}
    }
    Tcl_AppendResult(interp, resultPtr->result, NULL);
    Tcl_ConditionFinalize(&resultPtr->done);
    code = resultPtr->code;

    Tcl_Free(resultPtr->result);
    Tcl_Free(resultPtr);

    return code;
}

/*
 *------------------------------------------------------------------------
 *
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
	    errorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
	    errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
	} else {
	    errorCode = errorInfo = NULL;
	}
	result = Tcl_GetStringResult(interp);
    }
    ckfree(threadEventPtr->script);
    if (resultPtr) {
	Tcl_MutexLock(&threadMutex);
	resultPtr->code = code;
	resultPtr->result = ckalloc(strlen(result) + 1);
	strcpy(resultPtr->result, result);
	if (errorCode != NULL) {
	    resultPtr->errorCode = ckalloc(strlen(errorCode) + 1);
	    strcpy(resultPtr->errorCode, errorCode);
	}
	if (errorInfo != NULL) {
	    resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1);
	    strcpy(resultPtr->errorInfo, errorInfo);
	}
	Tcl_ConditionNotify(&resultPtr->done);
	Tcl_MutexUnlock(&threadMutex);
    }
    if (interp != NULL) {
	Tcl_Release(interp);







|



|


|



|







1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
	    errorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
	    errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
	} else {
	    errorCode = errorInfo = NULL;
	}
	result = Tcl_GetStringResult(interp);
    }
    Tcl_Free(threadEventPtr->script);
    if (resultPtr) {
	Tcl_MutexLock(&threadMutex);
	resultPtr->code = code;
	resultPtr->result = Tcl_Alloc(strlen(result) + 1);
	strcpy(resultPtr->result, result);
	if (errorCode != NULL) {
	    resultPtr->errorCode = Tcl_Alloc(strlen(errorCode) + 1);
	    strcpy(resultPtr->errorCode, errorCode);
	}
	if (errorInfo != NULL) {
	    resultPtr->errorInfo = Tcl_Alloc(strlen(errorInfo) + 1);
	    strcpy(resultPtr->errorInfo, errorInfo);
	}
	Tcl_ConditionNotify(&resultPtr->done);
	Tcl_MutexUnlock(&threadMutex);
    }
    if (interp != NULL) {
	Tcl_Release(interp);
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094

     /* ARGSUSED */
static void
ThreadFreeProc(
    ClientData clientData)
{
    if (clientData) {
	ckfree(clientData);
    }
}

/*
 *------------------------------------------------------------------------
 *
 * ThreadDeleteEvent --







|







1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094

     /* ARGSUSED */
static void
ThreadFreeProc(
    ClientData clientData)
{
    if (clientData) {
	Tcl_Free(clientData);
    }
}

/*
 *------------------------------------------------------------------------
 *
 * ThreadDeleteEvent --
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
     /* ARGSUSED */
static int
ThreadDeleteEvent(
    Tcl_Event *eventPtr,	/* Really ThreadEvent */
    ClientData clientData)	/* dummy */
{
    if (eventPtr->proc == ThreadEventProc) {
	ckfree(((ThreadEvent *) eventPtr)->script);
	return 1;
    }

    /*
     * If it was NULL, we were in the middle of servicing the event and it
     * should be removed
     */







|







1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
     /* ARGSUSED */
static int
ThreadDeleteEvent(
    Tcl_Event *eventPtr,	/* Really ThreadEvent */
    ClientData clientData)	/* dummy */
{
    if (eventPtr->proc == ThreadEventProc) {
	Tcl_Free(((ThreadEvent *) eventPtr)->script);
	return 1;
    }

    /*
     * If it was NULL, we were in the middle of servicing the event and it
     * should be removed
     */
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
	ListRemove(tsdPtr);
    }

    Tcl_MutexLock(&threadMutex);

    if (self == errorThreadId) {
	if (errorProcString) {	/* Extra safety */
	    ckfree(errorProcString);
	    errorProcString = NULL;
	}
	errorThreadId = 0;
    }

    if (threadEvalScript) {
	ckfree(threadEvalScript);
	threadEvalScript = NULL;
    }
    Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);

    for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
	nextPtr = resultPtr->nextPtr;
	if (resultPtr->srcThreadId == self) {







|






|







1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
	ListRemove(tsdPtr);
    }

    Tcl_MutexLock(&threadMutex);

    if (self == errorThreadId) {
	if (errorProcString) {	/* Extra safety */
	    Tcl_Free(errorProcString);
	    errorProcString = NULL;
	}
	errorThreadId = 0;
    }

    if (threadEvalScript) {
	Tcl_Free(threadEvalScript);
	threadEvalScript = NULL;
    }
    Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);

    for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
	nextPtr = resultPtr->nextPtr;
	if (resultPtr->srcThreadId == self) {
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
		resultList = resultPtr->nextPtr;
	    }
	    if (resultPtr->nextPtr) {
		resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
	    }
	    resultPtr->nextPtr = resultPtr->prevPtr = 0;
	    resultPtr->eventPtr->resultPtr = NULL;
	    ckfree(resultPtr);
	} else if (resultPtr->dstThreadId == self) {
	    /*
	     * Dang. The target is going away. Unblock the caller. The result
	     * string must be dynamically allocated because the main thread is
	     * going to call free on it.
	     */

	    const char *msg = "target thread died";

	    resultPtr->result = ckalloc(strlen(msg) + 1);
	    strcpy(resultPtr->result, msg);
	    resultPtr->code = TCL_ERROR;
	    Tcl_ConditionNotify(&resultPtr->done);
	}
    }
    Tcl_MutexUnlock(&threadMutex);
}







|









|







1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
		resultList = resultPtr->nextPtr;
	    }
	    if (resultPtr->nextPtr) {
		resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
	    }
	    resultPtr->nextPtr = resultPtr->prevPtr = 0;
	    resultPtr->eventPtr->resultPtr = NULL;
	    Tcl_Free(resultPtr);
	} else if (resultPtr->dstThreadId == self) {
	    /*
	     * Dang. The target is going away. Unblock the caller. The result
	     * string must be dynamically allocated because the main thread is
	     * going to call free on it.
	     */

	    const char *msg = "target thread died";

	    resultPtr->result = Tcl_Alloc(strlen(msg) + 1);
	    strcpy(resultPtr->result, msg);
	    resultPtr->code = TCL_ERROR;
	    Tcl_ConditionNotify(&resultPtr->done);
	}
    }
    Tcl_MutexUnlock(&threadMutex);
}
Changes to generic/tclTimer.c.
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
    Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
    if (tsdPtr != NULL) {
	register TimerHandler *timerHandlerPtr;

	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	while (timerHandlerPtr != NULL) {
	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
	    ckfree(timerHandlerPtr);
	    timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	}
    }
}

/*
 *--------------------------------------------------------------







|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
    Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
    if (tsdPtr != NULL) {
	register TimerHandler *timerHandlerPtr;

	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	while (timerHandlerPtr != NULL) {
	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
	    Tcl_Free(timerHandlerPtr);
	    timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	}
    }
}

/*
 *--------------------------------------------------------------
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
    Tcl_Time *timePtr,
    Tcl_TimerProc *proc,
    ClientData clientData)
{
    register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    timerHandlerPtr = ckalloc(sizeof(TimerHandler));

    /*
     * Fill in fields for the event.
     */

    memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time));
    timerHandlerPtr->proc = proc;







|







293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
    Tcl_Time *timePtr,
    Tcl_TimerProc *proc,
    ClientData clientData)
{
    register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    timerHandlerPtr = Tcl_Alloc(sizeof(TimerHandler));

    /*
     * Fill in fields for the event.
     */

    memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time));
    timerHandlerPtr->proc = proc;
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
	    continue;
	}
	if (prevPtr == NULL) {
	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = timerHandlerPtr->nextPtr;
	}
	ckfree(timerHandlerPtr);
	return;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
	    continue;
	}
	if (prevPtr == NULL) {
	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = timerHandlerPtr->nextPtr;
	}
	Tcl_Free(timerHandlerPtr);
	return;
    }
}

/*
 *----------------------------------------------------------------------
 *
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
	/*
	 * If the first timer has expired, stick an event on the queue.
	 */

	if (blockTime.sec == 0 && blockTime.usec == 0 &&
		!tsdPtr->timerPending) {
	    tsdPtr->timerPending = 1;
	    timerEvPtr = ckalloc(sizeof(Tcl_Event));
	    timerEvPtr->proc = TimerHandlerEventProc;
	    Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
	}
    }
}

/*







|







484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
	/*
	 * If the first timer has expired, stick an event on the queue.
	 */

	if (blockTime.sec == 0 && blockTime.usec == 0 &&
		!tsdPtr->timerPending) {
	    tsdPtr->timerPending = 1;
	    timerEvPtr = Tcl_Alloc(sizeof(Tcl_Event));
	    timerEvPtr->proc = TimerHandlerEventProc;
	    Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
	}
    }
}

/*
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
	/*
	 * Remove the handler from the queue before invoking it, to avoid
	 * potential reentrancy problems.
	 */

	*nextPtrPtr = timerHandlerPtr->nextPtr;
	timerHandlerPtr->proc(timerHandlerPtr->clientData);
	ckfree(timerHandlerPtr);
    }
    TimerSetupProc(NULL, TCL_TIMER_EVENTS);
    return 1;
}

/*
 *--------------------------------------------------------------







|







587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
	/*
	 * Remove the handler from the queue before invoking it, to avoid
	 * potential reentrancy problems.
	 */

	*nextPtrPtr = timerHandlerPtr->nextPtr;
	timerHandlerPtr->proc(timerHandlerPtr->clientData);
	Tcl_Free(timerHandlerPtr);
    }
    TimerSetupProc(NULL, TCL_TIMER_EVENTS);
    return 1;
}

/*
 *--------------------------------------------------------------
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
    Tcl_IdleProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    register IdleHandler *idlePtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    idlePtr = ckalloc(sizeof(IdleHandler));
    idlePtr->proc = proc;
    idlePtr->clientData = clientData;
    idlePtr->generation = tsdPtr->idleGeneration;
    idlePtr->nextPtr = NULL;
    if (tsdPtr->lastIdlePtr == NULL) {
	tsdPtr->idleList = idlePtr;
    } else {







|







621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
    Tcl_IdleProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    register IdleHandler *idlePtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    idlePtr = Tcl_Alloc(sizeof(IdleHandler));
    idlePtr->proc = proc;
    idlePtr->clientData = clientData;
    idlePtr->generation = tsdPtr->idleGeneration;
    idlePtr->nextPtr = NULL;
    if (tsdPtr->lastIdlePtr == NULL) {
	tsdPtr->idleList = idlePtr;
    } else {
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
    ThreadSpecificData *tsdPtr = InitTimer();

    for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
	    prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
	while ((idlePtr->proc == proc)
		&& (idlePtr->clientData == clientData)) {
	    nextPtr = idlePtr->nextPtr;
	    ckfree(idlePtr);
	    idlePtr = nextPtr;
	    if (prevPtr == NULL) {
		tsdPtr->idleList = idlePtr;
	    } else {
		prevPtr->nextPtr = idlePtr;
	    }
	    if (idlePtr == NULL) {







|







670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
    ThreadSpecificData *tsdPtr = InitTimer();

    for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
	    prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
	while ((idlePtr->proc == proc)
		&& (idlePtr->clientData == clientData)) {
	    nextPtr = idlePtr->nextPtr;
	    Tcl_Free(idlePtr);
	    idlePtr = nextPtr;
	    if (prevPtr == NULL) {
		tsdPtr->idleList = idlePtr;
	    } else {
		prevPtr->nextPtr = idlePtr;
	    }
	    if (idlePtr == NULL) {
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
		    && ((oldGeneration - idlePtr->generation) >= 0));
	    idlePtr = tsdPtr->idleList) {
	tsdPtr->idleList = idlePtr->nextPtr;
	if (tsdPtr->idleList == NULL) {
	    tsdPtr->lastIdlePtr = NULL;
	}
	idlePtr->proc(idlePtr->clientData);
	ckfree(idlePtr);
    }
    if (tsdPtr->idleList) {
	blockTime.sec = 0;
	blockTime.usec = 0;
	Tcl_SetMaxBlockTime(&blockTime);
    }
    return 1;







|







745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
		    && ((oldGeneration - idlePtr->generation) >= 0));
	    idlePtr = tsdPtr->idleList) {
	tsdPtr->idleList = idlePtr->nextPtr;
	if (tsdPtr->idleList == NULL) {
	    tsdPtr->lastIdlePtr = NULL;
	}
	idlePtr->proc(idlePtr->clientData);
	Tcl_Free(idlePtr);
    }
    if (tsdPtr->idleList) {
	blockTime.sec = 0;
	blockTime.usec = 0;
	Tcl_SetMaxBlockTime(&blockTime);
    }
    return 1;
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
    /*
     * Create the "after" information associated for this interpreter, if it
     * doesn't already exist.
     */

    assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL);
    if (assocPtr == NULL) {
	assocPtr = ckalloc(sizeof(AfterAssocData));
	assocPtr->interp = interp;
	assocPtr->firstAfterPtr = NULL;
	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
    }

    /*
     * First lets see if the command was passed a number as the first argument.







|







804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
    /*
     * Create the "after" information associated for this interpreter, if it
     * doesn't already exist.
     */

    assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL);
    if (assocPtr == NULL) {
	assocPtr = Tcl_Alloc(sizeof(AfterAssocData));
	assocPtr->interp = interp;
	assocPtr->firstAfterPtr = NULL;
	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
    }

    /*
     * First lets see if the command was passed a number as the first argument.
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
    case -1: {
	if (ms < 0) {
	    ms = 0;
	}
	if (objc == 2) {
	    return AfterDelay(interp, ms);
	}
	afterPtr = ckalloc(sizeof(AfterInfo));
	afterPtr->assocPtr = assocPtr;
	if (objc == 3) {
	    afterPtr->commandPtr = objv[2];
	} else {
	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
	}
	Tcl_IncrRefCount(afterPtr->commandPtr);







|







844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
    case -1: {
	if (ms < 0) {
	    ms = 0;
	}
	if (objc == 2) {
	    return AfterDelay(interp, ms);
	}
	afterPtr = Tcl_Alloc(sizeof(AfterInfo));
	afterPtr->assocPtr = assocPtr;
	if (objc == 3) {
	    afterPtr->commandPtr = objv[2];
	} else {
	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
	}
	Tcl_IncrRefCount(afterPtr->commandPtr);
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
	break;
    }
    case AFTER_IDLE:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
	    return TCL_ERROR;
	}
	afterPtr = ckalloc(sizeof(AfterInfo));
	afterPtr->assocPtr = assocPtr;
	if (objc == 3) {
	    afterPtr->commandPtr = objv[2];
	} else {
	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
	}
	Tcl_IncrRefCount(afterPtr->commandPtr);







|







924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
	break;
    }
    case AFTER_IDLE:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
	    return TCL_ERROR;
	}
	afterPtr = Tcl_Alloc(sizeof(AfterInfo));
	afterPtr->assocPtr = assocPtr;
	if (objc == 3) {
	    afterPtr->commandPtr = objv[2];
	} else {
	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
	}
	Tcl_IncrRefCount(afterPtr->commandPtr);
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
    Tcl_Release(interp);

    /*
     * Free the memory for the callback.
     */

    Tcl_DecrRefCount(afterPtr->commandPtr);
    ckfree(afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeAfterPtr --
 *







|







1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
    Tcl_Release(interp);

    /*
     * Free the memory for the callback.
     */

    Tcl_DecrRefCount(afterPtr->commandPtr);
    Tcl_Free(afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeAfterPtr --
 *
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
	for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
		prevPtr = prevPtr->nextPtr) {
	    /* Empty loop body. */
	}
	prevPtr->nextPtr = afterPtr->nextPtr;
    }
    Tcl_DecrRefCount(afterPtr->commandPtr);
    ckfree(afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * AfterCleanupProc --
 *







|







1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
	for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
		prevPtr = prevPtr->nextPtr) {
	    /* Empty loop body. */
	}
	prevPtr->nextPtr = afterPtr->nextPtr;
    }
    Tcl_DecrRefCount(afterPtr->commandPtr);
    Tcl_Free(afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * AfterCleanupProc --
 *
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
	assocPtr->firstAfterPtr = afterPtr->nextPtr;
	if (afterPtr->token != NULL) {
	    Tcl_DeleteTimerHandler(afterPtr->token);
	} else {
	    Tcl_CancelIdleCall(AfterProc, afterPtr);
	}
	Tcl_DecrRefCount(afterPtr->commandPtr);
	ckfree(afterPtr);
    }
    ckfree(assocPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */







|

|











1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
	assocPtr->firstAfterPtr = afterPtr->nextPtr;
	if (afterPtr->token != NULL) {
	    Tcl_DeleteTimerHandler(afterPtr->token);
	} else {
	    Tcl_CancelIdleCall(AfterProc, afterPtr);
	}
	Tcl_DecrRefCount(afterPtr->commandPtr);
	Tcl_Free(afterPtr);
    }
    Tcl_Free(assocPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */
Changes to generic/tclTomMathDecls.h.
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
#define Tcl_TomMath_InitStubs(interp,version) \
    (TclTomMathInitializeStubs((interp),(version),\
                               TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION))

/* Define custom memory allocation for libtommath */

/* MODULE_SCOPE void* TclBNAlloc( size_t ); */
#define TclBNAlloc(s) ((void*)ckalloc((size_t)(s)))
/* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */
#define TclBNRealloc(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s)))
/* MODULE_SCOPE void  TclBNFree( void* ); */
#define TclBNFree(x) (ckfree((char*)(x)))
/* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */
/* unused - no macro */

#define XMALLOC(x) TclBNAlloc(x)
#define XFREE(x) TclBNFree(x)
#define XREALLOC(x,n) TclBNRealloc(x,n)
#define XCALLOC(n,x) TclBNCalloc(n,x)







|

|

|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
#define Tcl_TomMath_InitStubs(interp,version) \
    (TclTomMathInitializeStubs((interp),(version),\
                               TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION))

/* Define custom memory allocation for libtommath */

/* MODULE_SCOPE void* TclBNAlloc( size_t ); */
#define TclBNAlloc(s) ((void*)Tcl_Alloc((size_t)(s)))
/* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */
#define TclBNRealloc(x,s) ((void*)Tcl_Realloc((char*)(x),(size_t)(s)))
/* MODULE_SCOPE void  TclBNFree( void* ); */
#define TclBNFree(x) (Tcl_Free((char*)(x)))
/* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */
/* unused - no macro */

#define XMALLOC(x) TclBNAlloc(x)
#define XFREE(x) TclBNFree(x)
#define XREALLOC(x,n) TclBNRealloc(x,n)
#define XCALLOC(n,x) TclBNCalloc(n,x)
Changes to generic/tclTrace.c.
267
268
269
270
271
272
273
274

275
276
277
278
279
280
281
    }

#ifndef TCL_REMOVE_OBSOLETE_TRACES
    case TRACE_OLD_VARIABLE:
    case TRACE_OLD_VDELETE: {
	Tcl_Obj *copyObjv[6];
	Tcl_Obj *opsList;
	int code, numFlags;


	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
	    return TCL_ERROR;
	}

	opsList = Tcl_NewObj();







|
>







267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
    }

#ifndef TCL_REMOVE_OBSOLETE_TRACES
    case TRACE_OLD_VARIABLE:
    case TRACE_OLD_VDELETE: {
	Tcl_Obj *copyObjv[6];
	Tcl_Obj *opsList;
	int code;
	size_t numFlags;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
	    return TCL_ERROR;
	}

	opsList = Tcl_NewObj();
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
static int
TraceExecutionObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int commandLength, index;
    const char *name, *command;
    size_t length;
    enum traceOptions {
	TRACE_ADD, TRACE_INFO, TRACE_REMOVE
    };
    static const char *const opStrings[] = {
	"enter", "leave", "enterstep", "leavestep", NULL
    };
    enum operations {







|

|







400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
static int
TraceExecutionObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int index;
    const char *name, *command;
    size_t commandLength, length;
    enum traceOptions {
	TRACE_ADD, TRACE_INFO, TRACE_REMOVE
    };
    static const char *const opStrings[] = {
	"enter", "leave", "enterstep", "leavestep", NULL
    };
    enum operations {
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
		    TCL_TRACE_LEAVE_DURING_EXEC)) {
		flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
	    }
	    memcpy(tcmdPtr->command, command, length+1);
	    name = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		ckfree(tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.







|

















|







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = Tcl_Alloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
		    TCL_TRACE_LEAVE_DURING_EXEC)) {
		flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
	    }
	    memcpy(tcmdPtr->command, command, length+1);
	    name = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		Tcl_Free(tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
			 * We need to remove the interpreter-wide trace which
			 * we created to allow 'step' traces.
			 */

			Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
			tcmdPtr->stepTrace = NULL;
			if (tcmdPtr->startCmd != NULL) {
			    ckfree(tcmdPtr->startCmd);
			}
		    }
		    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
			/*
			 * Postpone deletion.
			 */

			tcmdPtr->flags = 0;
		    }
		    if (tcmdPtr->refCount-- <= 1) {
			ckfree(tcmdPtr);
		    }
		    break;
		}
	    }
	}
	break;
    }







|










|







535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
			 * We need to remove the interpreter-wide trace which
			 * we created to allow 'step' traces.
			 */

			Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
			tcmdPtr->stepTrace = NULL;
			if (tcmdPtr->startCmd != NULL) {
			    Tcl_Free(tcmdPtr->startCmd);
			}
		    }
		    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
			/*
			 * Postpone deletion.
			 */

			tcmdPtr->flags = 0;
		    }
		    if (tcmdPtr->refCount-- <= 1) {
			Tcl_Free(tcmdPtr);
		    }
		    break;
		}
	    }
	}
	break;
    }
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
static int
TraceCommandObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int commandLength, index;
    const char *name, *command;
    size_t length;
    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
    static const char *const opStrings[] = { "delete", "rename", NULL };
    enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };

    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {







|

|







650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
static int
TraceCommandObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int index;
    const char *name, *command;
    size_t commandLength, length;
    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
    static const char *const opStrings[] = { "delete", "rename", NULL };
    enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };

    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
		break;
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    memcpy(tcmdPtr->command, command, length+1);
	    name = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		ckfree(tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.







|













|







705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
		break;
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = Tcl_Alloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    memcpy(tcmdPtr->command, command, length+1);
	    name = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		Tcl_Free(tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
		if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags)
			&& (strncmp(command, tcmdPtr->command,
				(size_t) length) == 0)) {
		    Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE,
			    TraceCommandProc, clientData);
		    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
		    if (tcmdPtr->refCount-- <= 1) {
			ckfree(tcmdPtr);
		    }
		    break;
		}
	    }
	}
	break;
    }







|







750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
		if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags)
			&& (strncmp(command, tcmdPtr->command,
				(size_t) length) == 0)) {
		    Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE,
			    TraceCommandProc, clientData);
		    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
		    if (tcmdPtr->refCount-- <= 1) {
			Tcl_Free(tcmdPtr);
		    }
		    break;
		}
	    }
	}
	break;
    }
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
static int
TraceVariableObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int commandLength, index;
    const char *name, *command;
    size_t length;
    ClientData clientData;
    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
    static const char *const opStrings[] = {
	"array", "read", "unset", "write", NULL
    };
    enum operations {
	TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE







|

|







844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
static int
TraceVariableObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int index;
    const char *name, *command;
    size_t commandLength, length;
    ClientData clientData;
    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
    static const char *const opStrings[] = {
	"array", "read", "unset", "write", NULL
    };
    enum operations {
	TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = ckalloc(
		    TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (objv[0] == NULL) {
		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
	    }
#endif
	    ctvarPtr->traceCmdInfo.length = length;
	    flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
	    memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
	    ctvarPtr->traceInfo.traceProc = TraceVarProc;
	    ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo;
	    ctvarPtr->traceInfo.flags = flags;
	    name = Tcl_GetString(objv[3]);
	    if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr)
		    != TCL_OK) {
		ckfree(ctvarPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this variable to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.







|


















|







908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = Tcl_Alloc(
		    TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (objv[0] == NULL) {
		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
	    }
#endif
	    ctvarPtr->traceCmdInfo.length = length;
	    flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
	    memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
	    ctvarPtr->traceInfo.traceProc = TraceVarProc;
	    ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo;
	    ctvarPtr->traceInfo.flags = flags;
	    name = Tcl_GetString(objv[3]);
	    if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr)
		    != TCL_OK) {
		Tcl_Free(ctvarPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this variable to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
	return TCL_ERROR;
    }

    /*
     * Set up trace information.
     */

    tracePtr = ckalloc(sizeof(CommandTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;
    tracePtr->flags = flags &
	    (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
    tracePtr->nextPtr = cmdPtr->tracePtr;
    tracePtr->refCount = 1;
    cmdPtr->tracePtr = tracePtr;







|







1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
	return TCL_ERROR;
    }

    /*
     * Set up trace information.
     */

    tracePtr = Tcl_Alloc(sizeof(CommandTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;
    tracePtr->flags = flags &
	    (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
    tracePtr->nextPtr = cmdPtr->tracePtr;
    tracePtr->refCount = 1;
    cmdPtr->tracePtr = tracePtr;
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
	cmdPtr->tracePtr = tracePtr->nextPtr;
    } else {
	prevPtr->nextPtr = tracePtr->nextPtr;
    }
    tracePtr->flags = 0;

    if (tracePtr->refCount-- <= 1) {
	ckfree(tracePtr);
    }

    if (hasExecTraces) {
	for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ;
		prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
	    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
		return;







|







1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
	cmdPtr->tracePtr = tracePtr->nextPtr;
    } else {
	prevPtr->nextPtr = tracePtr->nextPtr;
    }
    tracePtr->flags = 0;

    if (tracePtr->refCount-- <= 1) {
	Tcl_Free(tracePtr);
    }

    if (hasExecTraces) {
	for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ;
		prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
	    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
		return;
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
	int untraceFlags = tcmdPtr->flags;
	Tcl_InterpState state;

	if (tcmdPtr->stepTrace != NULL) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    if (tcmdPtr->startCmd != NULL) {
		ckfree(tcmdPtr->startCmd);
	    }
	}
	if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
	    /*
	     * Postpone deletion, until exec trace returns.
	     */








|







1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
	int untraceFlags = tcmdPtr->flags;
	Tcl_InterpState state;

	if (tcmdPtr->stepTrace != NULL) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    if (tcmdPtr->startCmd != NULL) {
		Tcl_Free(tcmdPtr->startCmd);
	    }
	}
	if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
	    /*
	     * Postpone deletion, until exec trace returns.
	     */

1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
	state = Tcl_SaveInterpState(interp, TCL_OK);
	Tcl_UntraceCommand(interp, oldName, untraceFlags,
		TraceCommandProc, clientData);
	Tcl_RestoreInterpState(interp, state);
	tcmdPtr->refCount--;
    }
    if (tcmdPtr->refCount-- <= 1) {
	ckfree(tcmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckExecutionTraces --







|







1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
	state = Tcl_SaveInterpState(interp, TCL_OK);
	Tcl_UntraceCommand(interp, oldName, untraceFlags,
		TraceCommandProc, clientData);
	Tcl_RestoreInterpState(interp, state);
	tcmdPtr->refCount--;
    }
    if (tcmdPtr->refCount-- <= 1) {
	Tcl_Free(tcmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckExecutionTraces --
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
 */

int
TclCheckExecutionTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    int numChars,		/* The number of characters in 'command' which
				 * are part of the command string. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    int objc,			/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{







|







1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
 */

int
TclCheckExecutionTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    size_t numChars,		/* The number of characters in 'command' which
				 * are part of the command string. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    int objc,			/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
		tcmdPtr->refCount++;
		if (state == NULL) {
		    state = Tcl_SaveInterpState(interp, code);
		}
		traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel,
			command, (Tcl_Command) cmdPtr, objc, objv);
		if (tcmdPtr->refCount-- <= 1) {
		    ckfree(tcmdPtr);
		}
	    }
	}
	if (active.nextTracePtr) {
	    lastTracePtr = active.nextTracePtr->nextPtr;
	}
    }







|







1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
		tcmdPtr->refCount++;
		if (state == NULL) {
		    state = Tcl_SaveInterpState(interp, code);
		}
		traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel,
			command, (Tcl_Command) cmdPtr, objc, objv);
		if (tcmdPtr->refCount-- <= 1) {
		    Tcl_Free(tcmdPtr);
		}
	    }
	}
	if (active.nextTracePtr) {
	    lastTracePtr = active.nextTracePtr->nextPtr;
	}
    }
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
 */

int
TclCheckInterpTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    int numChars,		/* The number of characters in 'command' which
				 * are part of the command string. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    int objc,			/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{







|







1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
 */

int
TclCheckInterpTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    size_t numChars,		/* The number of characters in 'command' which
				 * are part of the command string. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    int objc,			/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
static void
CommandObjTraceDeleted(
    ClientData clientData)
{
    TraceCommandInfo *tcmdPtr = clientData;

    if (tcmdPtr->refCount-- <= 1) {
	ckfree(tcmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TraceExecutionProc --







|







1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
static void
CommandObjTraceDeleted(
    ClientData clientData)
{
    TraceCommandInfo *tcmdPtr = clientData;

    if (tcmdPtr->refCount-- <= 1) {
	Tcl_Free(tcmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TraceExecutionProc --
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825

	if ((flags & TCL_TRACE_LEAVE_EXEC) && (tcmdPtr->stepTrace != NULL)
		&& (level == tcmdPtr->startLevel)
		&& (strcmp(command, tcmdPtr->startCmd) == 0)) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    if (tcmdPtr->startCmd != NULL) {
		ckfree(tcmdPtr->startCmd);
	    }
	}

	/*
	 * Second, create the tcl callback, if required.
	 */








|







1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826

	if ((flags & TCL_TRACE_LEAVE_EXEC) && (tcmdPtr->stepTrace != NULL)
		&& (level == tcmdPtr->startLevel)
		&& (strcmp(command, tcmdPtr->startCmd) == 0)) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    if (tcmdPtr->startCmd != NULL) {
		Tcl_Free(tcmdPtr->startCmd);
	    }
	}

	/*
	 * Second, create the tcl callback, if required.
	 */

1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958

	if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
		&& (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
			TCL_TRACE_LEAVE_DURING_EXEC))) {
	    register unsigned len = strlen(command) + 1;

	    tcmdPtr->startLevel = level;
	    tcmdPtr->startCmd = ckalloc(len);
	    memcpy(tcmdPtr->startCmd, command, len);
	    tcmdPtr->refCount++;
	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
		   TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted);
	}
    }
    if (flags & TCL_TRACE_DESTROYED) {
	if (tcmdPtr->stepTrace != NULL) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    if (tcmdPtr->startCmd != NULL) {
		ckfree(tcmdPtr->startCmd);
	    }
	}
    }
    if (call) {
	if (tcmdPtr->refCount-- <= 1) {
	    ckfree(tcmdPtr);
	}
    }
    return traceCode;
}

/*
 *----------------------------------------------------------------------







|












|





|







1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959

	if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
		&& (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
			TCL_TRACE_LEAVE_DURING_EXEC))) {
	    register unsigned len = strlen(command) + 1;

	    tcmdPtr->startLevel = level;
	    tcmdPtr->startCmd = Tcl_Alloc(len);
	    memcpy(tcmdPtr->startCmd, command, len);
	    tcmdPtr->refCount++;
	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
		   TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted);
	}
    }
    if (flags & TCL_TRACE_DESTROYED) {
	if (tcmdPtr->stepTrace != NULL) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    if (tcmdPtr->startCmd != NULL) {
		Tcl_Free(tcmdPtr->startCmd);
	    }
	}
    }
    if (call) {
	if (tcmdPtr->refCount-- <= 1) {
	    Tcl_Free(tcmdPtr);
	}
    }
    return traceCode;
}

/*
 *----------------------------------------------------------------------
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185

	    iPtr->compileEpoch++;
	    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
	}
	iPtr->tracesForbiddingInline++;
    }

    tracePtr = ckalloc(sizeof(Trace));
    tracePtr->level = level;
    tracePtr->proc = proc;
    tracePtr->clientData = clientData;
    tracePtr->delProc = delProc;
    tracePtr->nextPtr = iPtr->tracePtr;
    tracePtr->flags = flags;
    iPtr->tracePtr = tracePtr;







|







2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186

	    iPtr->compileEpoch++;
	    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
	}
	iPtr->tracesForbiddingInline++;
    }

    tracePtr = Tcl_Alloc(sizeof(Trace));
    tracePtr->level = level;
    tracePtr->proc = proc;
    tracePtr->clientData = clientData;
    tracePtr->delProc = delProc;
    tracePtr->nextPtr = iPtr->tracePtr;
    tracePtr->flags = flags;
    iPtr->tracePtr = tracePtr;
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
    Tcl_Interp *interp,		/* Interpreter in which to create trace. */
    int level,			/* Only call proc for commands at nesting
				 * level<=argument level (1=>top level). */
    Tcl_CmdTraceProc *proc,	/* Function to call before executing each
				 * command. */
    ClientData clientData)	/* Arbitrary value word to pass to proc. */
{
    StringTraceData *data = ckalloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);
}








|







2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
    Tcl_Interp *interp,		/* Interpreter in which to create trace. */
    int level,			/* Only call proc for commands at nesting
				 * level<=argument level (1=>top level). */
    Tcl_CmdTraceProc *proc,	/* Function to call before executing each
				 * command. */
    ClientData clientData)	/* Arbitrary value word to pass to proc. */
{
    StringTraceData *data = Tcl_Alloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);
}

2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
 *----------------------------------------------------------------------
 */

static void
StringTraceDeleteProc(
    ClientData clientData)
{
    ckfree(clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteTrace --
 *







|







2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
 *----------------------------------------------------------------------
 */

static void
StringTraceDeleteProc(
    ClientData clientData)
{
    Tcl_Free(clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteTrace --
 *
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
DisposeTraceResult(
    int flags,			/* Indicates type of result to determine
				 * proper disposal method. */
    char *result)		/* The result returned from a trace function
				 * to be disposed. */
{
    if (flags & TCL_TRACE_RESULT_DYNAMIC) {
	ckfree(result);
    } else if (flags & TCL_TRACE_RESULT_OBJECT) {
	Tcl_DecrRefCount((Tcl_Obj *) result);
    }
}

/*
 *----------------------------------------------------------------------







|







2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
DisposeTraceResult(
    int flags,			/* Indicates type of result to determine
				 * proper disposal method. */
    char *result)		/* The result returned from a trace function
				 * to be disposed. */
{
    if (flags & TCL_TRACE_RESULT_DYNAMIC) {
	Tcl_Free(result);
    } else if (flags & TCL_TRACE_RESULT_OBJECT) {
	Tcl_DecrRefCount((Tcl_Obj *) result);
    }
}

/*
 *----------------------------------------------------------------------
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon varName. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    register VarTrace *tracePtr;
    int result;

    tracePtr = ckalloc(sizeof(VarTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;
    tracePtr->flags = flags;

    result = TraceVarEx(interp, part1, part2, tracePtr);

    if (result != TCL_OK) {
	ckfree(tracePtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *







|







|







3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon varName. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    register VarTrace *tracePtr;
    int result;

    tracePtr = Tcl_Alloc(sizeof(VarTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;
    tracePtr->flags = flags;

    result = TraceVarEx(interp, part1, part2, tracePtr);

    if (result != TCL_OK) {
	Tcl_Free(tracePtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
				 * traced. */
    const char *part1,		/* Name of scalar variable or array. */
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    register VarTrace *tracePtr)/* Structure containing flags, traceProc and
				 * clientData fields. Others should be left
				 * blank. Will be ckfree()d (eventually) if
				 * this function returns TCL_OK, and up to
				 * caller to free if this function returns
				 * TCL_ERROR. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;
    int flagMask, isNew;







|







3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
				 * traced. */
    const char *part1,		/* Name of scalar variable or array. */
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    register VarTrace *tracePtr)/* Structure containing flags, traceProc and
				 * clientData fields. Others should be left
				 * blank. Will be Tcl_Free()d (eventually) if
				 * this function returns TCL_OK, and up to
				 * caller to free if this function returns
				 * TCL_ERROR. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;
    int flagMask, isNew;
Changes to generic/tclUtf.c.
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221

222
223
224
225
226
227
228
229
230
231
232
233
234
235
 *
 *---------------------------------------------------------------------------
 */

char *
Tcl_UniCharToUtfDString(
    const Tcl_UniChar *uniStr,	/* Unicode string to convert to UTF-8. */
    int uniLength,		/* Length of Unicode string in Tcl_UniChars
				 * (must be >= 0). */
    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
				 * to this previously initialized DString. */
{
    const Tcl_UniChar *w, *wEnd;
    char *p, *string;
    int oldLength, len = 1;


    /*
     * UTF-8 string length in bytes will be <= Unicode string length * 4.
     */

    oldLength = Tcl_DStringLength(dsPtr);
    Tcl_DStringSetLength(dsPtr, (oldLength + uniLength + 1) * 4);
    string = Tcl_DStringValue(dsPtr) + oldLength;

    p = string;
    wEnd = uniStr + uniLength;
    for (w = uniStr; w < wEnd; ) {
	if (!len && ((*w & 0xFC00) != 0xDC00)) {
	    /* Special case for handling upper surrogates. */







|






|
>






|







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
 *
 *---------------------------------------------------------------------------
 */

char *
Tcl_UniCharToUtfDString(
    const Tcl_UniChar *uniStr,	/* Unicode string to convert to UTF-8. */
    size_t uniLength,		/* Length of Unicode string in Tcl_UniChars
				 * (must be >= 0). */
    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
				 * to this previously initialized DString. */
{
    const Tcl_UniChar *w, *wEnd;
    char *p, *string;
    size_t oldLength;
    int len = 1;

    /*
     * UTF-8 string length in bytes will be <= Unicode string length * 4.
     */

    oldLength = Tcl_DStringLength(dsPtr);
    Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 4);
    string = Tcl_DStringValue(dsPtr) + oldLength;

    p = string;
    wEnd = uniStr + uniLength;
    for (w = uniStr; w < wEnd; ) {
	if (!len && ((*w & 0xFC00) != 0xDC00)) {
	    /* Special case for handling upper surrogates. */
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442

443
444
445











446
447
448
449
450
451
452
453
454
455
456
457
 *
 *---------------------------------------------------------------------------
 */

Tcl_UniChar *
Tcl_UtfToUniCharDString(
    const char *src,		/* UTF-8 string to convert to Unicode. */
    int length,			/* Length of UTF-8 string in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
    Tcl_UniChar ch = 0, *w, *wString;
    const char *p, *end;
    int oldLength;

    if (length < 0) {
	length = strlen(src);
    }

    /*
     * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in
     * bytes.
     */

    oldLength = Tcl_DStringLength(dsPtr);
/* TODO: fix overreach! */
    Tcl_DStringSetLength(dsPtr,
	    (int) ((oldLength + length + 1) * sizeof(Tcl_UniChar)));
    wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);

    w = wString;

    end = src + length;
    for (p = src; p < end; ) {
	p += TclUtfToUniChar(p, &ch);











	*w++ = ch;
    }
    *w = '\0';
    Tcl_DStringSetLength(dsPtr,
	    (oldLength + ((char *) w - (char *) wString)));

    return wString;
}

/*
 *---------------------------------------------------------------------------
 *







|







|

|









|

|



>
|
|

>
>
>
>
>
>
>
>
>
>
>




|







411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
 *
 *---------------------------------------------------------------------------
 */

Tcl_UniChar *
Tcl_UtfToUniCharDString(
    const char *src,		/* UTF-8 string to convert to Unicode. */
    size_t length,			/* Length of UTF-8 string in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
    Tcl_UniChar ch = 0, *w, *wString;
    const char *p, *end;
    size_t oldLength;

    if (length == TCL_AUTO_LENGTH) {
	length = strlen(src);
    }

    /*
     * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in
     * bytes.
     */

    oldLength = Tcl_DStringLength(dsPtr);

    Tcl_DStringSetLength(dsPtr,
	    oldLength + (int) ((length + 1) * sizeof(Tcl_UniChar)));
    wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);

    w = wString;
    p = src;
    end = src + length - 4;
    while (p < end) {
	p += TclUtfToUniChar(p, &ch);
	*w++ = ch;
    }
    end += 4;
    while (p < end) {
	if (Tcl_UtfCharComplete(p, end-p)) {
	    p += TclUtfToUniChar(p, &ch);
	} else if ((unsigned)((UCHAR(*p)-0x80)) < (unsigned) 0x20) {
	    ch = (Tcl_UniChar) cp1252[UCHAR(*p++)-0x80];
	} else {
	    ch = UCHAR(*p++);
	}
	*w++ = ch;
    }
    *w = '\0';
    Tcl_DStringSetLength(dsPtr,
	    oldLength + ((char *) w - (char *) wString));

    return wString;
}

/*
 *---------------------------------------------------------------------------
 *
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
 *---------------------------------------------------------------------------
 */

int
Tcl_UtfCharComplete(
    const char *src,		/* String to check if first few bytes contain
				 * a complete UTF-8 character. */
    int length)			/* Length of above string in bytes. */
{
    return length >= totalBytes[(unsigned char)*src];
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_NumUtfChars --
 *
 *	Returns the number of characters (not bytes) in the UTF-8 string, not
 *	including the terminating NULL byte. This is equivalent to Plan 9
 *	utflen() and utfnlen().
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_NumUtfChars(
    register const char *src,	/* The UTF-8 string to measure. */
    int length)			/* The length of the string in bytes, or -1
				 * for strlen(string). */
{
    Tcl_UniChar ch = 0;
    register int i = 0;

    /*
     * The separate implementations are faster.
     *
     * Since this is a time-sensitive function, we also do the check for the
     * single-byte char case specially.
     */

    if (length < 0) {
	while (*src != '\0') {
	    src += TclUtfToUniChar(src, &ch);
	    i++;
	}
	if (i < 0) i = INT_MAX; /* Bug [2738427] */
    } else {
	register const char *endPtr = src + length - 4;

	while (src < endPtr) {
	    src += TclUtfToUniChar(src, &ch);
	    i++;
	}







|

|




















|


|



|








|




<







484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534

535
536
537
538
539
540
541
 *---------------------------------------------------------------------------
 */

int
Tcl_UtfCharComplete(
    const char *src,		/* String to check if first few bytes contain
				 * a complete UTF-8 character. */
    size_t length)			/* Length of above string in bytes. */
{
   return length >= totalBytes[(unsigned char)*src];
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_NumUtfChars --
 *
 *	Returns the number of characters (not bytes) in the UTF-8 string, not
 *	including the terminating NULL byte. This is equivalent to Plan 9
 *	utflen() and utfnlen().
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

size_t
Tcl_NumUtfChars(
    register const char *src,	/* The UTF-8 string to measure. */
    size_t length)			/* The length of the string in bytes, or -1
				 * for strlen(string). */
{
    Tcl_UniChar ch = 0;
    register size_t i = 0;

    /*
     * The separate implementations are faster.
     *
     * Since this is a time-sensitive function, we also do the check for the
     * single-byte char case specially.
     */

    if (length == TCL_AUTO_LENGTH) {
	while (*src != '\0') {
	    src += TclUtfToUniChar(src, &ch);
	    i++;
	}

    } else {
	register const char *endPtr = src + length - 4;

	while (src < endPtr) {
	    src += TclUtfToUniChar(src, &ch);
	    i++;
	}
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748

749
750
751
752
753
754
755
756
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_UniCharAtIndex(
    register const char *src,	/* The UTF-8 string to dereference. */
    register int index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
    int fullchar = 0;
#if TCL_UTF_MAX <= 4
	int len = 1;
#endif


    while (index-- >= 0) {
#if TCL_UTF_MAX <= 4
	src += (len = TclUtfToUniChar(src, &ch));
#else
	src += TclUtfToUniChar(src, &ch);
#endif
    }
    fullchar = ch;







|







>
|







746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_UniCharAtIndex(
    register const char *src,	/* The UTF-8 string to dereference. */
    register size_t index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
    int fullchar = 0;
#if TCL_UTF_MAX <= 4
	int len = 1;
#endif

    src += TclUtfToUniChar(src, &ch);
    while (index--) {
#if TCL_UTF_MAX <= 4
	src += (len = TclUtfToUniChar(src, &ch));
#else
	src += TclUtfToUniChar(src, &ch);
#endif
    }
    fullchar = ch;
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791

792

793

794

795

796

797
798
799
800
801
802
803

804
805
806
807
808
809
810
/*
 *---------------------------------------------------------------------------
 *
 * 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.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfAtIndex(
    register const char *src,	/* The UTF-8 string. */
    register int index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;

    int len = 1;



    while (index-- > 0) {

	len = TclUtfToUniChar(src, &ch);

	src += len;

    }
#if TCL_UTF_MAX <= 4
     if (!len) {
	/* Index points at character following High Surrogate */
	src += TclUtfToUniChar(src, &ch);
    }
#endif

    return src;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfBackslash --







|
|













|


>

>

>
|
>
|
>
|
>
|

|
|
|
|

>







780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
/*
 *---------------------------------------------------------------------------
 *
 * 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.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfAtIndex(
    register const char *src,	/* The UTF-8 string. */
    register size_t index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
#if TCL_UTF_MAX <= 4
    int len = 1;
#endif

    if (index != TCL_AUTO_LENGTH) {
	while (index--) {
#if TCL_UTF_MAX <= 4
	    src += (len = TclUtfToUniChar(src, &ch));
#else
	    src += TclUtfToUniChar(src, &ch);
#endif
	}
#if TCL_UTF_MAX <= 4
	if (!len) {
	    /* Index points at character following High Surrogate */
	    src += TclUtfToUniChar(src, &ch);
	}
#endif
    }
    return src;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfBackslash --
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
 *	that represent the Unicode character is at least as large as the
 *	source buffer from which the backslashed sequence was extracted, no
 *	buffer overruns should occur.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_UtfBackslash(
    const char *src,		/* Points to the backslash character of a
				 * backslash sequence. */
    int *readPtr,		/* Fill in with number of characters read from
				 * src, unless NULL. */
    char *dst)			/* Filled with the bytes represented by the
				 * backslash sequence. */
{
#define LINE_LENGTH 128
    int numRead;
    int result;

    result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst);
    if (numRead == LINE_LENGTH) {
	/*
	 * We ate a whole line. Pay the price of a strlen()
	 */

	result = TclParseBackslash(src, (int)strlen(src), &numRead, dst);
    }
    if (readPtr != NULL) {
	*readPtr = numRead;
    }
    return result;
}








|









|
<







|







846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863

864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
 *	that represent the Unicode character is at least as large as the
 *	source buffer from which the backslashed sequence was extracted, no
 *	buffer overruns should occur.
 *
 *---------------------------------------------------------------------------
 */

size_t
Tcl_UtfBackslash(
    const char *src,		/* Points to the backslash character of a
				 * backslash sequence. */
    int *readPtr,		/* Fill in with number of characters read from
				 * src, unless NULL. */
    char *dst)			/* Filled with the bytes represented by the
				 * backslash sequence. */
{
#define LINE_LENGTH 128
    size_t numRead, result;


    result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst);
    if (numRead == LINE_LENGTH) {
	/*
	 * We ate a whole line. Pay the price of a strlen()
	 */

	result = TclParseBackslash(src, strlen(src), &numRead, dst);
    }
    if (readPtr != NULL) {
	*readPtr = numRead;
    }
    return result;
}

1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
 *----------------------------------------------------------------------
 */

int
TclpUtfNcmp2(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    unsigned long numBytes)	/* Number of *bytes* to compare. */
{
    /*
     * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to
     * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes
     * fine in the strcmp manner.
     */








|







1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
 *----------------------------------------------------------------------
 */

int
TclpUtfNcmp2(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numBytes)	/* Number of *bytes* to compare. */
{
    /*
     * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to
     * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes
     * fine in the strcmp manner.
     */

1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
 *----------------------------------------------------------------------
 */

int
Tcl_UtfNcmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    unsigned long numChars)	/* Number of UTF chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    /*
     * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the
     * pair of bytes 0xC0,0x80) is larger than byte representation of \u0001
     * (the byte 0x01.)







|







1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
 *----------------------------------------------------------------------
 */

int
Tcl_UtfNcmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numChars)	/* Number of UTF chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    /*
     * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the
     * pair of bytes 0xC0,0x80) is larger than byte representation of \u0001
     * (the byte 0x01.)
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
 *----------------------------------------------------------------------
 */

int
Tcl_UtfNcasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    unsigned long numChars)	/* Number of UTF chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as chars, not bytes.
	 * This should be called only when both strings are of







|







1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
 *----------------------------------------------------------------------
 */

int
Tcl_UtfNcasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numChars)	/* Number of UTF chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as chars, not bytes.
	 * This should be called only when both strings are of
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharLen(
    const Tcl_UniChar *uniStr)	/* Unicode string to find length of. */
{
    int len = 0;

    while (*uniStr != '\0') {
	len++;
	uniStr++;
    }
    return len;
}







|



|







1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_UniCharLen(
    const Tcl_UniChar *uniStr)	/* Unicode string to find length of. */
{
    size_t len = 0;

    while (*uniStr != '\0') {
	len++;
	uniStr++;
    }
    return len;
}
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharNcmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    unsigned long numChars)	/* Number of unichars to compare. */
{
#ifdef WORDS_BIGENDIAN
    /*
     * We are definitely on a big-endian machine; memcmp() is safe
     */

    return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));







|







1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharNcmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    size_t numChars)	/* Number of unichars to compare. */
{
#ifdef WORDS_BIGENDIAN
    /*
     * We are definitely on a big-endian machine; memcmp() is safe
     */

    return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharNcasecmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    unsigned long numChars)	/* Number of unichars to compare. */
{
    for ( ; numChars != 0; numChars--, ucs++, uct++) {
	if (*ucs != *uct) {
	    Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);

	    if (lcs != lct) {







|







1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharNcasecmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    size_t numChars)	/* Number of unichars to compare. */
{
    for ( ; numChars != 0; numChars--, ucs++, uct++) {
	if (*ucs != *uct) {
	    Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);

	    if (lcs != lct) {
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharMatch(
    const Tcl_UniChar *string,	/* Unicode String. */
    int strLen,			/* Length of String */
    const Tcl_UniChar *pattern,	/* Pattern, which may contain special
				 * characters. */
    int ptnLen,			/* Length of Pattern */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    const Tcl_UniChar *stringEnd, *patternEnd;
    Tcl_UniChar p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;







|


|







2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharMatch(
    const Tcl_UniChar *string,	/* Unicode String. */
    size_t strLen,			/* Length of String */
    const Tcl_UniChar *pattern,	/* Pattern, which may contain special
				 * characters. */
    size_t ptnLen,			/* Length of Pattern */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    const Tcl_UniChar *stringEnd, *patternEnd;
    Tcl_UniChar p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;
Changes to generic/tclUtil.c.
11
12
13
14
15
16
17

18
19
20
21
22
23
24
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclParse.h"
#include "tclStringTrim.h"

#include <math.h>

/*
 * The absolute pathname of the executable in which this Tcl library is
 * running.
 */








>







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclParse.h"
#include "tclStringTrim.h"
#include "tommath.h"
#include <math.h>

/*
 * The absolute pathname of the executable in which this Tcl library is
 * running.
 */

96
97
98
99
100
101
102
103
104
105


106
107
108
109
110
111
112
113
114
115
116
117
118
/*
 * Prototypes for functions defined later in this file.
 */

static void		ClearHash(Tcl_HashTable *tablePtr);
static void		FreeProcessGlobalValue(ClientData clientData);
static void		FreeThreadHash(ClientData clientData);
static int		GetEndOffsetFromObj(Tcl_Obj *objPtr, int endValue,
			    int *indexPtr);
static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);


static int		SetEndOffsetFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static int		FindElement(Tcl_Interp *interp, const char *string,
			    int stringLength, const char *typeStr,
			    const char *typeCode, const char **elementPtr,
			    const char **nextPtr, int *sizePtr,
			    int *literalPtr);
/*
 * The following is the Tcl object type definition for an object that
 * represents a list index in the form, "end-offset". It is used as a
 * performance optimization in TclGetIntForIndex. The internal rep is
 * stored directly in the wideValue, so no memory management is required
 * for it. This is a caching intrep, keeping the result of a parse







|
|

>
>





|







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
/*
 * Prototypes for functions defined later in this file.
 */

static void		ClearHash(Tcl_HashTable *tablePtr);
static void		FreeProcessGlobalValue(ClientData clientData);
static void		FreeThreadHash(ClientData clientData);
static int		GetEndOffsetFromObj(Tcl_Obj *objPtr,
			    Tcl_WideInt endValue, Tcl_WideInt *indexPtr);
static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
static int		GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Tcl_WideInt endValue, Tcl_WideInt *widePtr);
static int		SetEndOffsetFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static int		FindElement(Tcl_Interp *interp, const char *string,
			    int stringLength, const char *typeStr,
			    const char *typeCode, const char **elementPtr,
			    const char **nextPtr, size_t *sizePtr,
			    int *literalPtr);
/*
 * The following is the Tcl object type definition for an object that
 * represents a list index in the form, "end-offset". It is used as a
 * performance optimization in TclGetIntForIndex. The internal rep is
 * stored directly in the wideValue, so no memory management is required
 * for it. This is a caching intrep, keeping the result of a parse
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
 *
 *----------------------------------------------------------------------
 */

int
TclMaxListLength(
    const char *bytes,
    int numBytes,
    const char **endPtr)
{
    int count = 0;

    if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
	/* Empty string case - quick exit */
	goto done;
    }

    /*
     * No list element before leading white space.
     */

    count += 1 - TclIsSpaceProc(*bytes);

    /*
     * Count white space runs as potential element separators.
     */

    while (numBytes) {
	if ((numBytes == -1) && (*bytes == '\0')) {
	    break;
	}
	if (TclIsSpaceProc(*bytes)) {
	    /*
	     * Space run started; bump count.
	     */

	    count++;
	    do {
		bytes++;
		numBytes -= (numBytes != -1);
	    } while (numBytes && TclIsSpaceProc(*bytes));
	    if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
		break;
	    }

	    /*
	     * (*bytes) is non-space; return to counting state.
	     */
	}
	bytes++;
	numBytes -= (numBytes != -1);
    }

    /*
     * No list element following trailing white space.
     */

    count -= TclIsSpaceProc(bytes[-1]);







|


|

|















|










|

|








|







384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
 *
 *----------------------------------------------------------------------
 */

int
TclMaxListLength(
    const char *bytes,
    size_t numBytes,
    const char **endPtr)
{
    size_t count = 0;

    if ((numBytes == 0) || ((numBytes == TCL_AUTO_LENGTH) && (*bytes == '\0'))) {
	/* Empty string case - quick exit */
	goto done;
    }

    /*
     * No list element before leading white space.
     */

    count += 1 - TclIsSpaceProc(*bytes);

    /*
     * Count white space runs as potential element separators.
     */

    while (numBytes) {
	if ((numBytes == TCL_AUTO_LENGTH) && (*bytes == '\0')) {
	    break;
	}
	if (TclIsSpaceProc(*bytes)) {
	    /*
	     * Space run started; bump count.
	     */

	    count++;
	    do {
		bytes++;
		numBytes -= (numBytes != TCL_AUTO_LENGTH);
	    } while (numBytes && TclIsSpaceProc(*bytes));
	    if ((numBytes == 0) || ((numBytes == TCL_AUTO_LENGTH) && (*bytes == '\0'))) {
		break;
	    }

	    /*
	     * (*bytes) is non-space; return to counting state.
	     */
	}
	bytes++;
	numBytes -= (numBytes != TCL_AUTO_LENGTH);
    }

    /*
     * No list element following trailing white space.
     */

    count -= TclIsSpaceProc(bytes[-1]);
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
				 * elements (possibly in braces). */
    int listLength,		/* Number of bytes in the list's string. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in first element of list. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * argument (next arg or end of list). */
    int *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal list element and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */







|







496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
				 * elements (possibly in braces). */
    int listLength,		/* Number of bytes in the list's string. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in first element of list. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * argument (next arg or end of list). */
    size_t *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal list element and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
    int dictLength,		/* Number of bytes in the dict's string. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in the first element (i.e., key
				 * or value) of dict. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * element (next arg or end of list). */
    int *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal key or value and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */







|







525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
    int dictLength,		/* Number of bytes in the dict's string. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in the first element (i.e., key
				 * or value) of dict. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * element (next arg or end of list). */
    size_t *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal key or value and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
    const char *typeCode,	/* The type code for thing we are parsing, for
				 * error messages. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in first element. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * argument (next arg or end of list/dict). */
    int *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal list/dict element and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
{
    const char *p = string;
    const char *elemStart;	/* Points to first byte of first element. */
    const char *limit;		/* Points just after list/dict's last byte. */
    int openBraces = 0;		/* Brace nesting level during parse. */
    int inQuotes = 0;
    int size = 0;		/* lint. */
    int numChars;
    int literal = 1;
    const char *p2;

    /*
     * Skim off leading white space and check for an opening brace or quote.
     * We treat embedded NULLs in the list/dict as bytes belonging to a list
     * element (or dictionary key or value).







|














|







557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
    const char *typeCode,	/* The type code for thing we are parsing, for
				 * error messages. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in first element. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * argument (next arg or end of list/dict). */
    size_t *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal list/dict element and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
{
    const char *p = string;
    const char *elemStart;	/* Points to first byte of first element. */
    const char *limit;		/* Points just after list/dict's last byte. */
    int openBraces = 0;		/* Brace nesting level during parse. */
    int inQuotes = 0;
    int size = 0;		/* lint. */
    size_t numChars;
    int literal = 1;
    const char *p2;

    /*
     * Skim off leading white space and check for an opening brace or quote.
     * We treat embedded NULLs in the list/dict as bytes belonging to a list
     * element (or dictionary key or value).
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclCopyAndCollapse(
    int count,			/* Number of byte to copy from src. */
    const char *src,		/* Copy from here... */
    char *dst)			/* ... to here. */
{
    int newCount = 0;

    while (count > 0) {
	char c = *src;

	if (c == '\\') {
	    int numRead;
	    int backslashCount = TclParseBackslash(src, count, &numRead, dst);

	    dst += backslashCount;
	    newCount += backslashCount;
	    src += numRead;
	    count -= numRead;
	} else {
	    *dst = c;







|

|



|





|
|







783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclCopyAndCollapse(
    size_t count,			/* Number of byte to copy from src. */
    const char *src,		/* Copy from here... */
    char *dst)			/* ... to here. */
{
    size_t newCount = 0;

    while (count > 0) {
	char c = *src;

	if (c == '\\') {
	    size_t numRead;
	    size_t backslashCount = TclParseBackslash(src, count, &numRead, dst);

	    dst += backslashCount;
	    newCount += backslashCount;
	    src += numRead;
	    count -= numRead;
	} else {
	    *dst = c;
851
852
853
854
855
856
857
858

859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
    int *argcPtr,		/* Pointer to location to fill in with the
				 * number of elements in the list. */
    const char ***argvPtr)	/* Pointer to place to store pointer to array
				 * of pointers to list elements. */
{
    const char **argv, *end, *element;
    char *p;
    int length, size, i, result, elSize;


    /*
     * Allocate enough space to work in. A (const char *) for each (possible)
     * list element plus one more for terminating NULL, plus as many bytes as
     * in the original string value, plus one more for a terminating '\0'.
     * Space used to hold element separating white space in the original
     * string gets re-purposed to hold '\0' characters in the argv array.
     */

    size = TclMaxListLength(list, -1, &end) + 1;
    length = end - list;
    argv = ckalloc((size * sizeof(char *)) + length + 1);

    for (i = 0, p = ((char *) argv) + size*sizeof(char *);
	    *list != 0;  i++) {
	const char *prevList = list;
	int literal;

	result = TclFindElement(interp, list, length, &element, &list,
		&elSize, &literal);
	length -= (list - prevList);
	if (result != TCL_OK) {
	    ckfree(argv);
	    return result;
	}
	if (*element == 0) {
	    break;
	}
	if (i >= size) {
	    ckfree(argv);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"internal error in Tcl_SplitList", -1));
		Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
			NULL);
	    }
	    return TCL_ERROR;
	}
	argv[i] = p;
	if (literal) {
	    memcpy(p, element, (size_t) elSize);
	    p += elSize;
	    *p = 0;
	    p++;
	} else {
	    p += 1 + TclCopyAndCollapse(elSize, element, p);
	}
    }







|
>











|










|






|










|







854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
    int *argcPtr,		/* Pointer to location to fill in with the
				 * number of elements in the list. */
    const char ***argvPtr)	/* Pointer to place to store pointer to array
				 * of pointers to list elements. */
{
    const char **argv, *end, *element;
    char *p;
    int length, size, i, result;
    size_t elSize;

    /*
     * Allocate enough space to work in. A (const char *) for each (possible)
     * list element plus one more for terminating NULL, plus as many bytes as
     * in the original string value, plus one more for a terminating '\0'.
     * Space used to hold element separating white space in the original
     * string gets re-purposed to hold '\0' characters in the argv array.
     */

    size = TclMaxListLength(list, -1, &end) + 1;
    length = end - list;
    argv = Tcl_Alloc((size * sizeof(char *)) + length + 1);

    for (i = 0, p = ((char *) argv) + size*sizeof(char *);
	    *list != 0;  i++) {
	const char *prevList = list;
	int literal;

	result = TclFindElement(interp, list, length, &element, &list,
		&elSize, &literal);
	length -= (list - prevList);
	if (result != TCL_OK) {
	    Tcl_Free(argv);
	    return result;
	}
	if (*element == 0) {
	    break;
	}
	if (i >= size) {
	    Tcl_Free(argv);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"internal error in Tcl_SplitList", -1));
		Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
			NULL);
	    }
	    return TCL_ERROR;
	}
	argv[i] = p;
	if (literal) {
	    memcpy(p, element, elSize);
	    p += elSize;
	    *p = 0;
	    p++;
	} else {
	    p += 1 + TclCopyAndCollapse(elSize, element, p);
	}
    }
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ScanElement(
    register const char *src,	/* String to convert to list element. */
    register int *flagPtr)	/* Where to store information to guide
				 * Tcl_ConvertCountedElement. */
{
    return Tcl_ScanCountedElement(src, -1, flagPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ScanCountedElement --
 *
 *	This function is a companion function to Tcl_ConvertCountedElement. It
 *	scans a string to see what needs to be done to it (e.g. add
 *	backslashes or enclosing braces) to make the string into a valid Tcl
 *	list element. If length is -1, then the string is scanned from src up
 *	to the first null byte.
 *
 * Results:
 *	The return value is an overestimate of the number of bytes that will
 *	be needed by Tcl_ConvertCountedElement to produce a valid list element
 *	from src. The word at *flagPtr is filled in with a value needed by
 *	Tcl_ConvertCountedElement when doing the actual conversion.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ScanCountedElement(
    const char *src,		/* String to convert to Tcl list element. */
    int length,			/* Number of bytes in src, or -1. */
    int *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    char flags = CONVERT_ANY;
    int numBytes = TclScanElement(src, length, &flags);

    *flagPtr = flags;







|

|
|
|












|














|


|







932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ScanElement(
    const char *src,	/* String to convert to list element. */
    int *flagPtr)	/* Where to store information to guide
			 * Tcl_ConvertCountedElement. */
{
    return Tcl_ScanCountedElement(src, -1, flagPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ScanCountedElement --
 *
 *	This function is a companion function to Tcl_ConvertCountedElement. It
 *	scans a string to see what needs to be done to it (e.g. add
 *	backslashes or enclosing braces) to make the string into a valid Tcl
 *	list element. If length is (size_t)-1, then the string is scanned from src up
 *	to the first null byte.
 *
 * Results:
 *	The return value is an overestimate of the number of bytes that will
 *	be needed by Tcl_ConvertCountedElement to produce a valid list element
 *	from src. The word at *flagPtr is filled in with a value needed by
 *	Tcl_ConvertCountedElement when doing the actual conversion.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ScanCountedElement(
    const char *src,		/* String to convert to Tcl list element. */
    size_t length,		/* Number of bytes in src, or (size_t)-1. */
    int *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    char flags = CONVERT_ANY;
    int numBytes = TclScanElement(src, length, &flags);

    *flagPtr = flags;
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclScanElement(
    const char *src,		/* String to convert to Tcl list element. */
    int length,			/* Number of bytes in src, or -1. */
    char *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    const char *p = src;
    int nestingLevel = 0;	/* Brace nesting count */
    int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
				 * needs protection or escape. */
    int requireEscape = 0;	/* Force use of CONVERT_ESCAPE mode.  For some
				 * reason bare or brace-quoted form fails. */
    int extra = 0;		/* Count of number of extra bytes needed for
				 * formatted element, assuming we use escape
				 * sequences in formatting. */
    int bytesNeeded;		/* Buffer length computed to complete the
				 * element formatting in the selected mode. */
#if COMPAT
    int preferEscape = 0;	/* Use preferences to track whether to use */
    int preferBrace = 0;	/* CONVERT_MASK mode. */
    int braceCount = 0;		/* Count of all braces '{' '}' seen. */
#endif /* COMPAT */

    if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) {
	/*
	 * Empty string element must be brace quoted.
	 */

	*flagPtr = CONVERT_BRACE;
	return 2;
    }







|


|




















|







1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclScanElement(
    const char *src,		/* String to convert to Tcl list element. */
    size_t length,		/* Number of bytes in src, or -1. */
    char *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    const char *p = src;
    int nestingLevel = 0;	/* Brace nesting count */
    int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
				 * needs protection or escape. */
    int requireEscape = 0;	/* Force use of CONVERT_ESCAPE mode.  For some
				 * reason bare or brace-quoted form fails. */
    int extra = 0;		/* Count of number of extra bytes needed for
				 * formatted element, assuming we use escape
				 * sequences in formatting. */
    int bytesNeeded;		/* Buffer length computed to complete the
				 * element formatting in the selected mode. */
#if COMPAT
    int preferEscape = 0;	/* Use preferences to track whether to use */
    int preferBrace = 0;	/* CONVERT_MASK mode. */
    int braceCount = 0;		/* Count of all braces '{' '}' seen. */
#endif /* COMPAT */

    if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == (size_t)-1))) {
	/*
	 * Empty string element must be brace quoted.
	 */

	*flagPtr = CONVERT_BRACE;
	return 2;
    }
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
	    extra++;		/* Escape sequences all one byte longer. */
#if COMPAT
	    preferBrace = 1;
#endif /* COMPAT */
	    break;
	case '\\':	/* TYPE_SUBS */
	    extra++;				/* Escape '\' => '\\' */
	    if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
		/*
		 * Final backslash. Cannot format with brace quoting.
		 */

		requireEscape = 1;
		break;
	    }







|







1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
	    extra++;		/* Escape sequences all one byte longer. */
#if COMPAT
	    preferBrace = 1;
#endif /* COMPAT */
	    break;
	case '\\':	/* TYPE_SUBS */
	    extra++;				/* Escape '\' => '\\' */
	    if ((length == 1) || ((length == (size_t)-1) && (p[1] == '\0'))) {
		/*
		 * Final backslash. Cannot format with brace quoting.
		 */

		requireEscape = 1;
		break;
	    }
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
	    }
	    forbidNone = 1;
#if COMPAT
	    preferBrace = 1;
#endif /* COMPAT */
	    break;
	case '\0':	/* TYPE_SUBS */
	    if (length == -1) {
		goto endOfString;
	    }
	    /* TODO: Panic on improper encoding? */
	    break;
	}
      }
	length -= (length > 0);
	p++;
    }

  endOfString:
    if (nestingLevel != 0) {
	/*
	 * Unbalanced braces!  Cannot format with brace quoting.







|






|







1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
	    }
	    forbidNone = 1;
#if COMPAT
	    preferBrace = 1;
#endif /* COMPAT */
	    break;
	case '\0':	/* TYPE_SUBS */
	    if (length == (size_t)-1) {
		goto endOfString;
	    }
	    /* TODO: Panic on improper encoding? */
	    break;
	}
      }
	length -= (length+1 > 1);
	p++;
    }

  endOfString:
    if (nestingLevel != 0) {
	/*
	 * Unbalanced braces!  Cannot format with brace quoting.
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ConvertElement(
    register const char *src,	/* Source information for list element. */
    register char *dst,		/* Place to put list-ified element. */
    register int flags)		/* Flags produced by Tcl_ScanElement. */
{
    return Tcl_ConvertCountedElement(src, -1, dst, flags);
}

/*
 *----------------------------------------------------------------------
 *







|

|
|
|







1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ConvertElement(
    const char *src,	/* Source information for list element. */
    char *dst,		/* Place to put list-ified element. */
    int flags)		/* Flags produced by Tcl_ScanElement. */
{
    return Tcl_ConvertCountedElement(src, -1, dst, flags);
}

/*
 *----------------------------------------------------------------------
 *
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ConvertCountedElement(
    register const char *src,	/* Source information for list element. */
    int length,			/* Number of bytes in src, or -1. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    int numBytes = TclConvertElement(src, length, dst, flags);
    dst[numBytes] = '\0';
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *







|


|



|







1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ConvertCountedElement(
    register const char *src,	/* Source information for list element. */
    size_t length,		/* Number of bytes in src, or -1. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    size_t numBytes = TclConvertElement(src, length, dst, flags);
    dst[numBytes] = '\0';
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclConvertElement(
    register const char *src,	/* Source information for list element. */
    int length,			/* Number of bytes in src, or -1. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    int conversion = flags & CONVERT_MASK;
    char *p = dst;

    /*
     * Let the caller demand we use escape sequences rather than braces.
     */

    if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
	conversion = CONVERT_ESCAPE;
    }

    /*
     * No matter what the caller demands, empty string must be braced!
     */

    if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) {
	src = &tclEmptyString;
	length = 0;
	conversion = CONVERT_BRACE;
    }

    /*
     * Escape leading hash as needed and requested.
     */

    if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) {
	if (conversion == CONVERT_ESCAPE) {
	    p[0] = '\\';
	    p[1] = '#';
	    p += 2;
	    src++;
	    length -= (length > 0);
	} else {
	    conversion = CONVERT_BRACE;
	}
    }

    /*
     * No escape or quoting needed.  Copy the literal string value.
     */

    if (conversion == CONVERT_NONE) {
	if (length == -1) {
	    /* TODO: INT_MAX overflow? */
	    while (*src) {
		*p++ = *src++;
	    }
	    return p - dst;
	} else {
	    memcpy(dst, src, length);
	    return length;
	}
    }

    /*
     * Formatted string is original string enclosed in braces.
     */

    if (conversion == CONVERT_BRACE) {
	*p = '{';
	p++;
	if (length == -1) {
	    /* TODO: INT_MAX overflow? */
	    while (*src) {
		*p++ = *src++;
	    }
	} else {
	    memcpy(p, src, length);
	    p += length;
	}
	*p = '}';
	p++;
	return p - dst;
    }

    /* conversion == CONVERT_ESCAPE or CONVERT_MASK */

    /*
     * Formatted string is original string converted to escape sequences.
     */

    for ( ; length; src++, length -= (length > 0)) {
	switch (*src) {
	case ']':
	case '[':
	case '$':
	case ';':
	case ' ':
	case '\\':







|


|


















|















|










|


















|










|








|







1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclConvertElement(
    register const char *src,	/* Source information for list element. */
    size_t length,		/* Number of bytes in src, or -1. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    int conversion = flags & CONVERT_MASK;
    char *p = dst;

    /*
     * Let the caller demand we use escape sequences rather than braces.
     */

    if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
	conversion = CONVERT_ESCAPE;
    }

    /*
     * No matter what the caller demands, empty string must be braced!
     */

    if ((src == NULL) || (length == 0) || (*src == '\0' && length == TCL_AUTO_LENGTH)) {
	src = &tclEmptyString;
	length = 0;
	conversion = CONVERT_BRACE;
    }

    /*
     * Escape leading hash as needed and requested.
     */

    if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) {
	if (conversion == CONVERT_ESCAPE) {
	    p[0] = '\\';
	    p[1] = '#';
	    p += 2;
	    src++;
	    length -= (length+1 > 1);
	} else {
	    conversion = CONVERT_BRACE;
	}
    }

    /*
     * No escape or quoting needed.  Copy the literal string value.
     */

    if (conversion == CONVERT_NONE) {
	if (length == (size_t)-1) {
	    /* TODO: INT_MAX overflow? */
	    while (*src) {
		*p++ = *src++;
	    }
	    return p - dst;
	} else {
	    memcpy(dst, src, length);
	    return length;
	}
    }

    /*
     * Formatted string is original string enclosed in braces.
     */

    if (conversion == CONVERT_BRACE) {
	*p = '{';
	p++;
	if (length == (size_t)-1) {
	    /* TODO: INT_MAX overflow? */
	    while (*src) {
		*p++ = *src++;
	    }
	} else {
	    memcpy(p, src, length);
	    p += length;
	}
	*p = '}';
	p++;
	return (size_t)(p - dst);
    }

    /* conversion == CONVERT_ESCAPE or CONVERT_MASK */

    /*
     * Formatted string is original string converted to escape sequences.
     */

    for ( ; length; src++, length -= (length+1 > 1)) {
	switch (*src) {
	case ']':
	case '[':
	case '$':
	case ';':
	case ' ':
	case '\\':
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
	case '\v':
	    *p = '\\';
	    p++;
	    *p = 'v';
	    p++;
	    continue;
	case '\0':
	    if (length == -1) {
		return p - dst;
	    }

	    /*
	     * If we reach this point, there's an embedded NULL in the string
	     * range being processed, which should not happen when the
	     * encoding rules for Tcl strings are properly followed.  If the
	     * day ever comes when we stop tolerating such things, this is
	     * where to put the Tcl_Panic().
	     */

	    break;
	}
	*p = *src;
	p++;
    }
    return p - dst;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Merge --
 *







|
|















|







1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
	case '\v':
	    *p = '\\';
	    p++;
	    *p = 'v';
	    p++;
	    continue;
	case '\0':
	    if (length == (size_t)-1) {
		return (size_t)(p - dst);
	    }

	    /*
	     * If we reach this point, there's an embedded NULL in the string
	     * range being processed, which should not happen when the
	     * encoding rules for Tcl strings are properly followed.  If the
	     * day ever comes when we stop tolerating such things, this is
	     * where to put the Tcl_Panic().
	     */

	    break;
	}
	*p = *src;
	p++;
    }
    return (size_t)(p - dst);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Merge --
 *
1542
1543
1544
1545
1546
1547
1548

1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
char *
Tcl_Merge(
    int argc,			/* How many strings to merge. */
    const char *const *argv)	/* Array of string values. */
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;

    int i, bytesNeeded = 0;
    char *result, *dst;

    /*
     * Handle empty list case first, so logic of the general case can be
     * simpler.
     */

    if (argc == 0) {
	result = ckalloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (argc <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = ckalloc(argc);
    }
    for (i = 0; i < argc; i++) {
	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    }
    if (bytesNeeded > INT_MAX - argc + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += argc;

    /*
     * Pass two: copy into the result area.
     */

    result = ckalloc(bytesNeeded);
    dst = result;
    for (i = 0; i < argc; i++) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	dst += TclConvertElement(argv[i], -1, dst, flagPtr[i]);
	*dst = ' ';
	dst++;
    }
    dst[-1] = 0;

    if (flagPtr != localFlags) {
	ckfree(flagPtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *







>
|








|











|




<
<
<
<
<
<







|










|







1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579






1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
char *
Tcl_Merge(
    int argc,			/* How many strings to merge. */
    const char *const *argv)	/* Array of string values. */
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    int i;
    size_t bytesNeeded = 0;
    char *result, *dst;

    /*
     * Handle empty list case first, so logic of the general case can be
     * simpler.
     */

    if (argc == 0) {
	result = Tcl_Alloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (argc <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = Tcl_Alloc(argc);
    }
    for (i = 0; i < argc; i++) {
	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]);






    }
    bytesNeeded += argc;

    /*
     * Pass two: copy into the result area.
     */

    result = Tcl_Alloc(bytesNeeded);
    dst = result;
    for (i = 0; i < argc; i++) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	dst += TclConvertElement(argv[i], -1, dst, flagPtr[i]);
	*dst = ' ';
	dst++;
    }
    dst[-1] = 0;

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
	    break;
	}
    } while (p > bytes);

    return numBytes - (p - bytes);
}

int
TclTrimRight(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    int numTrim)	/* ...and its length in bytes */
{
    int res;
    Tcl_DString bytesBuf, trimBuf;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }








|


|

|

|







1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
	    break;
	}
    } while (p > bytes);

    return numBytes - (p - bytes);
}

size_t
TclTrimRight(
    const char *bytes,	/* String to be trimmed... */
    size_t numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    size_t numTrim)	/* ...and its length in bytes */
{
    size_t res;
    Tcl_DString bytesBuf, trimBuf;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static inline int
TrimLeft(
    const char *bytes,		/* String to be trimmed... */
    int numBytes,		/* ...and its length in bytes */
    const char *trim,		/* String of trim characters... */
    int numTrim)		/* ...and its length in bytes */
{
    const char *p = bytes;
	Tcl_UniChar ch1 = 0, ch2 = 0;

    /*
     * Outer loop: iterate over string to be trimmed.
     */







|


|

|







1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static inline size_t
TrimLeft(
    const char *bytes,		/* String to be trimmed... */
    size_t numBytes,		/* ...and its length in bytes */
    const char *trim,		/* String of trim characters... */
    size_t numTrim)		/* ...and its length in bytes */
{
    const char *p = bytes;
	Tcl_UniChar ch1 = 0, ch2 = 0;

    /*
     * Outer loop: iterate over string to be trimmed.
     */
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
	p += pInc;
	numBytes -= pInc;
    } while (numBytes > 0);

    return p - bytes;
}

int
TclTrimLeft(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    int numTrim)	/* ...and its length in bytes */
{
    int res;
    Tcl_DString bytesBuf, trimBuf;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }








|


|

|

|







1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
	p += pInc;
	numBytes -= pInc;
    } while (numBytes > 0);

    return p - bytes;
}

size_t
TclTrimLeft(
    const char *bytes,	/* String to be trimmed... */
    size_t numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    size_t numTrim)	/* ...and its length in bytes */
{
    size_t res;
    Tcl_DString bytesBuf, trimBuf;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclTrim(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    int numTrim,	/* ...and its length in bytes */
    int *trimRight)		/* Offset from the end of the string. */
{
    int trimLeft;
    Tcl_DString bytesBuf, trimBuf;

    *trimRight = 0;
    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }







|


|

|
|

|







1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclTrim(
    const char *bytes,	/* String to be trimmed... */
    size_t numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    size_t numTrim,	/* ...and its length in bytes */
    size_t *trimRight)		/* Offset from the end of the string. */
{
    size_t trimLeft;
    Tcl_DString bytesBuf, trimBuf;

    *trimRight = 0;
    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920

1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
 *	Memory is allocated for the result; the caller is responsible for
 *	freeing the memory.
 *
 *----------------------------------------------------------------------
 */

/* The whitespace characters trimmed during [concat] operations */
#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1)

char *
Tcl_Concat(
    int argc,			/* Number of strings to concatenate. */
    const char *const *argv)	/* Array of strings to concatenate. */
{

    int i, needSpace = 0, bytesNeeded = 0;
    char *result, *p;

    /*
     * Dispose of the empty result corner case first to simplify later code.
     */

    if (argc == 0) {
	result = (char *) ckalloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * First allocate the result buffer at the size required.
     */

    for (i = 0;  i < argc;  i++) {
	bytesNeeded += strlen(argv[i]);
	if (bytesNeeded < 0) {
	    Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
	}
    }
    if (bytesNeeded + argc - 1 < 0) {
	/*
	 * Panic test could be tighter, but not going to bother for this
	 * legacy routine.
	 */

	Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
    }

    /*
     * All element bytes + (argc - 1) spaces + 1 terminating NULL.
     */

    result = ckalloc((unsigned) (bytesNeeded + argc));

    for (p = result, i = 0;  i < argc;  i++) {
	int triml, trimr, elemLength;
	const char *element;

	element = argv[i];
	elemLength = strlen(argv[i]);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,







|






>
|







|










<
<
<
<
<
<
<
<
<
<
<






|


|







1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939











1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
 *	Memory is allocated for the result; the caller is responsible for
 *	freeing the memory.
 *
 *----------------------------------------------------------------------
 */

/* The whitespace characters trimmed during [concat] operations */
#define CONCAT_WS_SIZE (sizeof(CONCAT_TRIM_SET "") - 1)

char *
Tcl_Concat(
    int argc,			/* Number of strings to concatenate. */
    const char *const *argv)	/* Array of strings to concatenate. */
{
    int i;
    size_t needSpace = 0, bytesNeeded = 0;
    char *result, *p;

    /*
     * Dispose of the empty result corner case first to simplify later code.
     */

    if (argc == 0) {
	result = (char *) Tcl_Alloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * First allocate the result buffer at the size required.
     */

    for (i = 0;  i < argc;  i++) {
	bytesNeeded += strlen(argv[i]);











    }

    /*
     * All element bytes + (argc - 1) spaces + 1 terminating NULL.
     */

    result = Tcl_Alloc(bytesNeeded + argc);

    for (p = result, i = 0;  i < argc;  i++) {
	size_t triml, trimr, elemLength;
	const char *element;

	element = argv[i];
	elemLength = strlen(argv[i]);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
2014
2015
2016
2017
2018
2019
2020
2021

2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038

2039
2040
2041
2042
2043
2044
2045
 */

Tcl_Obj *
Tcl_ConcatObj(
    int objc,			/* Number of objects to concatenate. */
    Tcl_Obj *const objv[])	/* Array of objects to concatenate. */
{
    int i, elemLength, needSpace = 0, bytesNeeded = 0;

    const char *element;
    Tcl_Obj *objPtr, *resPtr;

    /*
     * Check first to see if all the items are of list type or empty. If so,
     * we will concat them together as lists, and return a list object. This
     * is only valid when the lists are in canonical form.
     */

    for (i = 0;  i < objc;  i++) {
	int length;

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr)) {
	    continue;
	}
	TclGetStringFromObj(objPtr, &length);

	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {







|
>










|





|
>







2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
 */

Tcl_Obj *
Tcl_ConcatObj(
    int objc,			/* Number of objects to concatenate. */
    Tcl_Obj *const objv[])	/* Array of objects to concatenate. */
{
    int i, needSpace = 0;
    size_t bytesNeeded = 0, elemLength;
    const char *element;
    Tcl_Obj *objPtr, *resPtr;

    /*
     * Check first to see if all the items are of list type or empty. If so,
     * we will concat them together as lists, and return a list object. This
     * is only valid when the lists are in canonical form.
     */

    for (i = 0;  i < objc;  i++) {
	size_t length;

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr)) {
	    continue;
	}
	TclGetString(objPtr);
	length = objPtr->length;
	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {
2068
2069
2070
2071
2072
2073
2074
2075

2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095

2096
2097
2098
2099
2100
2101
2102
     * Something cannot be determined to be safe, so build the concatenation
     * the slow way, using the string representations.
     *
     * First try to pre-allocate the size required.
     */

    for (i = 0;  i < objc;  i++) {
	element = TclGetStringFromObj(objv[i], &elemLength);

	bytesNeeded += elemLength;
	if (bytesNeeded < 0) {
	    break;
	}
    }

    /*
     * Does not matter if this fails, will simply try later to build up the
     * string with each Append reallocating as needed with the usual string
     * append algorithm.  When that fails it will report the error.
     */

    TclNewObj(resPtr);
    (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
    Tcl_SetObjLength(resPtr, 0);

    for (i = 0;  i < objc;  i++) {
	int triml, trimr;

	element = TclGetStringFromObj(objv[i], &elemLength);


	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;
	elemLength -= triml + trimr;








|
>

<
<
<













|

|
>







2059
2060
2061
2062
2063
2064
2065
2066
2067
2068



2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
     * Something cannot be determined to be safe, so build the concatenation
     * the slow way, using the string representations.
     *
     * First try to pre-allocate the size required.
     */

    for (i = 0;  i < objc;  i++) {
	element = TclGetString(objv[i]);
	elemLength = objv[i]->length;
	bytesNeeded += elemLength;



    }

    /*
     * Does not matter if this fails, will simply try later to build up the
     * string with each Append reallocating as needed with the usual string
     * append algorithm.  When that fails it will report the error.
     */

    TclNewObj(resPtr);
    (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
    Tcl_SetObjLength(resPtr, 0);

    for (i = 0;  i < objc;  i++) {
	size_t triml, trimr;

	element = TclGetString(objv[i]);
	elemLength = objv[i]->length;

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;
	elemLength -= triml + trimr;

2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
 *
 *----------------------------------------------------------------------
 */

int
TclByteArrayMatch(
    const unsigned char *string,/* String. */
    int strLen,			/* Length of String */
    const unsigned char *pattern,
				/* Pattern, which may contain special
				 * characters. */
    int ptnLen,			/* Length of Pattern */
    int flags)
{
    const unsigned char *stringEnd, *patternEnd;
    unsigned char p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;







|



|







2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
 *
 *----------------------------------------------------------------------
 */

int
TclByteArrayMatch(
    const unsigned char *string,/* String. */
    size_t strLen,			/* Length of String */
    const unsigned char *pattern,
				/* Pattern, which may contain special
				 * characters. */
    size_t ptnLen,			/* Length of Pattern */
    int flags)
{
    const unsigned char *stringEnd, *patternEnd;
    unsigned char p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;
2583
2584
2585
2586
2587
2588
2589
2590

2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
int
TclStringMatchObj(
    Tcl_Obj *strObj,		/* string object. */
    Tcl_Obj *ptnObj,		/* pattern object. */
    int flags)			/* Only TCL_MATCH_NOCASE should be passed, or
				 * 0. */
{
    int match, length, plen;


    /*
     * Promote based on the type of incoming object.
     * XXX: Currently doesn't take advantage of exact-ness that
     * XXX: TclReToGlob tells us about
    trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
     */

    if ((strObj->typePtr == &tclStringType) || (strObj->typePtr == NULL)) {
	Tcl_UniChar *udata, *uptn;

	udata = Tcl_GetUnicodeFromObj(strObj, &length);
	uptn  = Tcl_GetUnicodeFromObj(ptnObj, &plen);
	match = TclUniCharMatch(udata, length, uptn, plen, flags);
    } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
		&& !flags) {
	unsigned char *data, *ptn;

	data = Tcl_GetByteArrayFromObj(strObj, &length);
	ptn  = Tcl_GetByteArrayFromObj(ptnObj, &plen);
	match = TclByteArrayMatch(data, length, ptn, plen, 0);
    } else {
	match = Tcl_StringCaseMatch(TclGetString(strObj),
		TclGetString(ptnObj), flags);
    }
    return match;
}







|
>











|
|





|
|







2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
int
TclStringMatchObj(
    Tcl_Obj *strObj,		/* string object. */
    Tcl_Obj *ptnObj,		/* pattern object. */
    int flags)			/* Only TCL_MATCH_NOCASE should be passed, or
				 * 0. */
{
    int match;
    size_t length, plen;

    /*
     * Promote based on the type of incoming object.
     * XXX: Currently doesn't take advantage of exact-ness that
     * XXX: TclReToGlob tells us about
    trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
     */

    if ((strObj->typePtr == &tclStringType) || (strObj->typePtr == NULL)) {
	Tcl_UniChar *udata, *uptn;

	udata = TclGetUnicodeFromObj(strObj, &length);
	uptn  = TclGetUnicodeFromObj(ptnObj, &plen);
	match = TclUniCharMatch(udata, length, uptn, plen, flags);
    } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
		&& !flags) {
	unsigned char *data, *ptn;

	data = TclGetByteArrayFromObj(strObj, &length);
	ptn  = TclGetByteArrayFromObj(ptnObj, &plen);
	match = TclByteArrayMatch(data, length, ptn, plen, 0);
    } else {
	match = Tcl_StringCaseMatch(TclGetString(strObj),
		TclGetString(ptnObj), flags);
    }
    return match;
}
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
 */

char *
Tcl_DStringAppend(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *bytes,		/* String to append. If length is -1 then this
				 * must be null-terminated. */
    int length)			/* Number of bytes from "bytes" to append. If
				 * < 0, then append all of bytes, up to null
				 * at end. */
{
    int newSize;

    if (length < 0) {
	length = strlen(bytes);
    }
    newSize = length + dsPtr->length;

    /*
     * Allocate a larger buffer for the string if the current one isn't large
     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again.
     */

    if (newSize >= dsPtr->spaceAvl) {
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = ckalloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {
		offset = bytes - dsPtr->string;
	    }

	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);

	    if (offset >= 0) {
		bytes = dsPtr->string + offset;
	    }
	}
    }

    /*
     * Copy the new string into the buffer at the end of the old one.







|
|


|

|













|

|


|







|

|







2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
 */

char *
Tcl_DStringAppend(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *bytes,		/* String to append. If length is -1 then this
				 * must be null-terminated. */
    size_t length)			/* Number of bytes from "bytes" to append. If
				 * -1, then append all of bytes, up to null
				 * at end. */
{
    size_t newSize;

    if (length == TCL_AUTO_LENGTH) {
	length = strlen(bytes);
    }
    newSize = length + dsPtr->length;

    /*
     * Allocate a larger buffer for the string if the current one isn't large
     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again.
     */

    if (newSize >= dsPtr->spaceAvl) {
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = Tcl_Alloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    size_t offset = TCL_AUTO_LENGTH;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {
		offset = bytes - dsPtr->string;
	    }

	    dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);

	    if (offset != TCL_AUTO_LENGTH) {
		bytes = dsPtr->string + offset;
	    }
	}
    }

    /*
     * Copy the new string into the buffer at the end of the old one.
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
 */

char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{
    int length;
    char *bytes = TclGetStringFromObj(objPtr, &length);

    return Tcl_DStringAppend(dsPtr, bytes, length);
}

char *
TclDStringAppendDString(
    Tcl_DString *dsPtr,
    Tcl_DString *toAppendPtr)
{







<
|

|







2721
2722
2723
2724
2725
2726
2727

2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
 */

char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{

    char *bytes = TclGetString(objPtr);

    return Tcl_DStringAppend(dsPtr, bytes, objPtr->length);
}

char *
TclDStringAppendDString(
    Tcl_DString *dsPtr,
    Tcl_DString *toAppendPtr)
{
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *element)	/* String to append. Must be
				 * null-terminated. */
{
    char *dst = dsPtr->string + dsPtr->length;
    int needSpace = TclNeedSpace(dsPtr->string, dst);
    char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
    int newSize = dsPtr->length + needSpace
	    + TclScanElement(element, -1, &flags);

    /*
     * Allocate a larger buffer for the string if the current one isn't large
     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again. SPECIAL NOTE: must use
     * memcpy, not strcpy, to copy the string to a larger buffer, since there
     * may be embedded NULLs in the string in some cases.
     */

    if (newSize >= dsPtr->spaceAvl) {
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = ckalloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (element >= dsPtr->string
		    && element <= dsPtr->string + dsPtr->length) {
		offset = element - dsPtr->string;
	    }

	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);

	    if (offset >= 0) {
		element = dsPtr->string + offset;
	    }
	}
	dst = dsPtr->string + dsPtr->length;
    }







|













|

|










|







2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *element)	/* String to append. Must be
				 * null-terminated. */
{
    char *dst = dsPtr->string + dsPtr->length;
    int needSpace = TclNeedSpace(dsPtr->string, dst);
    char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
    size_t newSize = dsPtr->length + needSpace
	    + TclScanElement(element, -1, &flags);

    /*
     * Allocate a larger buffer for the string if the current one isn't large
     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again. SPECIAL NOTE: must use
     * memcpy, not strcpy, to copy the string to a larger buffer, since there
     * may be embedded NULLs in the string in some cases.
     */

    if (newSize >= dsPtr->spaceAvl) {
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = Tcl_Alloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (element >= dsPtr->string
		    && element <= dsPtr->string + dsPtr->length) {
		offset = element - dsPtr->string;
	    }

	    dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);

	    if (offset >= 0) {
		element = dsPtr->string + offset;
	    }
	}
	dst = dsPtr->string + dsPtr->length;
    }
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
 *	either grow or shrink, depending on the value of length.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The length of dsPtr is changed to length and a null byte is stored at
 *	that position in the string. If length is larger than the space
 *	allocated for dsPtr, then a panic occurs.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DStringSetLength(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    int length)			/* New length for dynamic string. */
{
    int newsize;

    if (length < 0) {
	length = 0;
    }
    if (length >= dsPtr->spaceAvl) {
	/*
	 * There are two interesting cases here. In the first case, the user
	 * may be trying to allocate a large buffer of a specific size. It
	 * would be wasteful to overallocate that buffer, so we just allocate
	 * enough for the requested size plus the trailing null byte. In the
	 * second case, we are growing the buffer incrementally, so we need
	 * behavior similar to Tcl_DStringAppend. The requested length will
	 * usually be a small delta above the current spaceAvl, so we'll end
	 * up doubling the old size. This won't grow the buffer quite as
	 * quickly, but it should be close enough.
	 */

	newsize = dsPtr->spaceAvl * 2;
	if (length < newsize) {
	    dsPtr->spaceAvl = newsize;
	} else {
	    dsPtr->spaceAvl = length + 1;
	}
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = ckalloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
	}
    }
    dsPtr->length = length;
    dsPtr->string[length] = 0;
}

/*







|
<







|

|

<
<
<




















|

|


|







2834
2835
2836
2837
2838
2839
2840
2841

2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852



2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
 *	either grow or shrink, depending on the value of length.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The length of dsPtr is changed to length and a null byte is stored at
 *	that position in the string.

 *
 *----------------------------------------------------------------------
 */

void
Tcl_DStringSetLength(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    size_t length)			/* New length for dynamic string. */
{
    size_t newsize;




    if (length >= dsPtr->spaceAvl) {
	/*
	 * There are two interesting cases here. In the first case, the user
	 * may be trying to allocate a large buffer of a specific size. It
	 * would be wasteful to overallocate that buffer, so we just allocate
	 * enough for the requested size plus the trailing null byte. In the
	 * second case, we are growing the buffer incrementally, so we need
	 * behavior similar to Tcl_DStringAppend. The requested length will
	 * usually be a small delta above the current spaceAvl, so we'll end
	 * up doubling the old size. This won't grow the buffer quite as
	 * quickly, but it should be close enough.
	 */

	newsize = dsPtr->spaceAvl * 2;
	if (length < newsize) {
	    dsPtr->spaceAvl = newsize;
	} else {
	    dsPtr->spaceAvl = length + 1;
	}
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = Tcl_Alloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);
	}
    }
    dsPtr->length = length;
    dsPtr->string[length] = 0;
}

/*
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
 */

void
Tcl_DStringFree(
    Tcl_DString *dsPtr)		/* Structure describing dynamic string. */
{
    if (dsPtr->string != dsPtr->staticSpace) {
	ckfree(dsPtr->string);
    }
    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->staticSpace[0] = '\0';
}








|







2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
 */

void
Tcl_DStringFree(
    Tcl_DString *dsPtr)		/* Structure describing dynamic string. */
{
    if (dsPtr->string != dsPtr->staticSpace) {
	Tcl_Free(dsPtr->string);
    }
    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->staticSpace[0] = '\0';
}

2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995

void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{
    int length;
    char *bytes = TclGetStringFromObj(Tcl_GetObjResult(interp), &length);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, length);
    Tcl_ResetResult(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * TclDStringToObj --







|
|


|







2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981

void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{
    Tcl_Obj *obj = Tcl_GetObjResult(interp);
    char *bytes = TclGetString(obj);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, obj->length);
    Tcl_ResetResult(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * TclDStringToObj --
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
	    while (c != '\0') {
		*dst++ = c;
		c = *++p;
	    }
	}
	*dst++ = '\0';
    }
    ckfree(digits);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNeedSpace --
 *







|







3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
	    while (c != '\0') {
		*dst++ = c;
		c = *++p;
	    }
	}
	*dst++ = '\0';
    }
    Tcl_Free(digits);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNeedSpace --
 *
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
 * Side effects:
 *	The formatted characters are written into the storage pointer to by
 *	the "buffer" argument.
 *
 *----------------------------------------------------------------------
 */

int
TclFormatInt(
    char *buffer,		/* Points to the storage into which the
				 * formatted characters are written. */
    Tcl_WideInt n)			/* The integer to format. */
{
	Tcl_WideInt intVal;
    int i;
    int numFormatted, j;
    const char *digits = "0123456789";

    /*
     * Check first whether "n" is zero.
     */

    if (n == 0) {







|





|
<
|







3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328

3329
3330
3331
3332
3333
3334
3335
3336
 * Side effects:
 *	The formatted characters are written into the storage pointer to by
 *	the "buffer" argument.
 *
 *----------------------------------------------------------------------
 */

size_t
TclFormatInt(
    char *buffer,		/* Points to the storage into which the
				 * formatted characters are written. */
    Tcl_WideInt n)			/* The integer to format. */
{
    Tcl_WideInt intVal;

    size_t i, numFormatted, j;
    const char *digits = "0123456789";

    /*
     * Check first whether "n" is zero.
     */

    if (n == 0) {
3395
3396
3397
3398
3399
3400
3401





































































































































































































3402
3403
3404
3405
3406
3407
3408
    }
    return numFormatted;
}

/*
 *----------------------------------------------------------------------
 *





































































































































































































 * TclGetIntForIndex --
 *
 *	Provides an integer corresponding to the list index held in a Tcl
 *	object. The string value 'objPtr' is expected have the format
 *	integer([+-]integer)? or end([+-]integer)?.
 *
 * Value







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
    }
    return numFormatted;
}

/*
 *----------------------------------------------------------------------
 *
 * GetWideForIndex --
 *
 *	This function produces a wide integer value corresponding to the
 *	list index held in *objPtr. The parsing supports all values 
 *	recognized as any size of integer, and the syntaxes end[-+]$integer
 *	and $integer[-+]$integer. The argument endValue is used to give
 *	the meaning of the literal index value "end".
 *
 * Results:
 *	When parsing of *objPtr successfully recognizes an index value,
 *	TCL_OK is returned, and the wide integer value corresponding to
 *	the recognized index value is written to *widePtr. When parsing
 *	fails, TCL_ERROR is returned and error information is written to
 *	interp, if non-NULL.
 *
 * Side effects:
 *	The type of *objPtr may change.
 *
 *----------------------------------------------------------------------
 */

static int
GetWideForIndex(
    Tcl_Interp *interp,         /* Interpreter to use for error reporting. If
                                 * NULL, then no error message is left after
                                 * errors. */
    Tcl_Obj *objPtr,            /* Points to the value to be parsed */
    Tcl_WideInt endValue,       /* The value to be stored at *widePtr if
                                 * objPtr holds "end".
				 * NOTE: this value may be negative. */
    Tcl_WideInt *widePtr)       /* Location filled in with a wide integer
                                 * representing an index. */
{
    ClientData cd;
    const char *opPtr;
    int numType, length, t1 = 0, t2 = 0;
    int code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);

    if (code == TCL_OK) {
	if (numType == TCL_NUMBER_INT) {
	    /* objPtr holds an integer in the signed wide range */
	    *widePtr = (Tcl_WideInt)(*(Tcl_WideInt *)cd);
	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
	    /* objPtr holds an integer outside the signed wide range */
	    /* Truncate to the signed wide range. */
	    if (mp_isneg((mp_int *)cd)) {
		*widePtr = LLONG_MIN;
	    } else {
		*widePtr = LLONG_MAX;
	    }
	    return TCL_OK;
	}
	/* Must be a double -> not a valid index */
	goto parseError;
    }

    /* objPtr does not hold a number, check the end+/- format... */
    if (GetEndOffsetFromObj(objPtr, endValue, widePtr) == TCL_OK) {
	return TCL_OK;
    }

    /* 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.
     */

    /*
     * Quick scan to see if multi-value list is even possible.
     * This relies on TclGetString() returning a NUL-terminated string.
     */
    if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1)

	    /* If it's possible, do the full list parse. */
            && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length))
            && (length > 1)) {
        goto parseError;
    }

    /* Passed the list screen, so parse for index arithmetic expression */
    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr,
            TCL_PARSE_INTEGER_ONLY)) {
	Tcl_WideInt w1=0, w2=0;

	/* value starts with valid integer... */

        if ((*opPtr == '-') || (*opPtr == '+')) {
	    /* ... value continues with [-+] ... */

	    /* Save first integer as wide if possible */
	    TclGetNumberFromObj(NULL, objPtr, &cd, &t1);
	    if (t1 == TCL_NUMBER_INT) {
		w1 = (*(Tcl_WideInt *)cd);
	    }

	    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1,
		    -1, NULL, TCL_PARSE_INTEGER_ONLY)) {
		/* ... value concludes with second valid integer */

		/* Save second integer as wide if possible */
		TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
		if (t2 == TCL_NUMBER_INT) {
		    w2 = (*(Tcl_WideInt *)cd);
		}
	    }
        }
	/* Clear invalid intreps left by TclParseNumber */
	TclFreeIntRep(objPtr);

	if (t1 && t2) {
	    /* We have both integer values */
	    if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) {
		/* Both are wide, do wide-integer math */
		if (*opPtr == '-') {
		    if ((w2 == LLONG_MIN) && (interp != NULL)) {
			goto extreme;
		    }
		    w2 = -w2;
		}

		if ((w1 ^ w2) < 0) {
		    /* Different signs, sum cannot overflow */
		    *widePtr = w1 + w2;
		} else if (w1 >= 0) {
		    if (w1 < LLONG_MAX - w2) {
			*widePtr = w1 + w2;
		    } else {
			*widePtr = LLONG_MAX;
		    }
		} else {
		    if (w1 > LLONG_MIN - w2) {
			*widePtr = w1 + w2;
		    } else {
			*widePtr = LLONG_MIN;
		    }
		}
	    } else if (interp == NULL) {
		/*
		 * We use an interp to do bignum index calculations.
		 * If we don't get one, call all indices with bignums errors,
		 * and rely on callers to handle it.
		 */
		return TCL_ERROR;
	    } else {
		/*
		 * At least one is big, do bignum math. Little reason to
		 * value performance here. Re-use code.  Parse has verified
		 * objPtr is an expression. Compute it.
		 */

		Tcl_Obj *sum;

	    extreme:
		Tcl_ExprObj(interp, objPtr, &sum);
		TclGetNumberFromObj(NULL, sum, &cd, &numType);

		if (numType == TCL_NUMBER_INT) {
		    /* sum holds an integer in the signed wide range */
		    *widePtr = (Tcl_WideInt)(*(Tcl_WideInt *)cd);
		} else {
		    /* sum holds an integer outside the signed wide range */
		    /* Truncate to the signed wide range. */
		    if (mp_isneg((mp_int *)cd)) {
			*widePtr = LLONG_MIN;
		    } else {
			*widePtr = LLONG_MAX;
		    }
		}
		Tcl_DecrRefCount(sum);
	    }
	    return TCL_OK;
	}
    }

    /* Report a parse error. */
  parseError:
    if (interp != NULL) {
        char * bytes = TclGetString(objPtr);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "bad index \"%s\": must be integer?[+-]integer? or"
                " end?[+-]integer?", bytes));
        if (!strncmp(bytes, "end-", 4)) {
            bytes += 4;
        }
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetIntForIndex --
 *
 *	Provides an integer corresponding to the list index held in a Tcl
 *	object. The string value 'objPtr' is expected have the format
 *	integer([+-]integer)? or end([+-]integer)?.
 *
 * Value
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
    Tcl_Obj *objPtr,		/* Points to an object containing either "end"
				 * or an integer. */
    int endValue,		/* The value to be stored at "indexPtr" if
				 * "objPtr" holds "end". */
    int *indexPtr)		/* Location filled in with an integer
				 * representing an index. */
{
    size_t length;
    char *opPtr;
    const char *bytes;

    if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
	return TCL_OK;
    }

    if (GetEndOffsetFromObj(objPtr, endValue, indexPtr) == TCL_OK) {
	return TCL_OK;
    }

    bytes = TclGetString(objPtr);
    length = objPtr->length;

    /*
     * Leading whitespace is acceptable in an index.
     */

    while (length && TclIsSpaceProc(*bytes)) {
	bytes++;
	length--;
    }

    if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr,
	    TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
	int code, first, second;
	char savedOp = *opPtr;

	if ((savedOp != '+') && (savedOp != '-')) {
	    goto parseError;
	}
	if (TclIsSpaceProc(opPtr[1])) {
	    goto parseError;
	}
	*opPtr = '\0';
	code = Tcl_GetInt(interp, bytes, &first);
	*opPtr = savedOp;
	if (code == TCL_ERROR) {
	    goto parseError;
	}
	if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) {
	    goto parseError;
	}
	if (savedOp == '+') {
	    *indexPtr = first + second;
	} else {
	    *indexPtr = first - second;
	}
	return TCL_OK;
    }

    /*
     * Report a parse error.
     */

  parseError:
    if (interp != NULL) {
	bytes = TclGetString(objPtr);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad index \"%s\": must be integer?[+-]integer? or"
		" end?[+-]integer?", bytes));
	if (!strncmp(bytes, "end-", 4)) {
	    bytes += 4;
	}
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
    }

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * GetEndOffsetFromObj --
 *







<
<
<
|
<
<
|
|
<
|

|
<
<
|
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







3615
3616
3617
3618
3619
3620
3621



3622


3623
3624

3625
3626
3627


3628



3629


























3630
3631
3632
3633
3634



















3635
3636
3637
3638
3639
3640
3641
    Tcl_Obj *objPtr,		/* Points to an object containing either "end"
				 * or an integer. */
    int endValue,		/* The value to be stored at "indexPtr" if
				 * "objPtr" holds "end". */
    int *indexPtr)		/* Location filled in with an integer
				 * representing an index. */
{



    Tcl_WideInt wide;



    if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {

	return TCL_ERROR;
    }
    if (wide < INT_MIN) {


	*indexPtr = INT_MIN;



    } else if (wide > INT_MAX) {


























	*indexPtr = INT_MAX;
    } else {
	*indexPtr = (int) wide;
    }
    return TCL_OK;



















}

/*
 *----------------------------------------------------------------------
 *
 * GetEndOffsetFromObj --
 *
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538








3539
3540


3541




3542
3543

3544
3545
3546
3547
3548
3549
3550
3551
 *
 *----------------------------------------------------------------------
 */

static int
GetEndOffsetFromObj(
    Tcl_Obj *objPtr,            /* Pointer to the object to parse */
    int endValue,               /* The value to be stored at "indexPtr" if
                                 * "objPtr" holds "end". */
    int *indexPtr)              /* Location filled in with an integer
                                 * representing an index. */
{
    if (SetEndOffsetFromAny(NULL, objPtr) != TCL_OK) {
	return TCL_ERROR;
    }









    /* TODO: Handle overflow cases sensibly */


    *indexPtr = endValue + (int)objPtr->internalRep.wideValue;




    return TCL_OK;
}



/*
 *----------------------------------------------------------------------
 *
 * SetEndOffsetFromAny --
 *
 *	Look for a string of the form "end[+-]offset" and convert it to an







|

|


|
|
|
>
>
>
>
>
>
>
>
|
<
>
>
|
>
>
>
>
|
|
>
|







3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673

3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
 *
 *----------------------------------------------------------------------
 */

static int
GetEndOffsetFromObj(
    Tcl_Obj *objPtr,            /* Pointer to the object to parse */
    Tcl_WideInt endValue,       /* The value to be stored at "indexPtr" if
                                 * "objPtr" holds "end". */
    Tcl_WideInt *widePtr)       /* Location filled in with an integer
                                 * representing an index. */
{
    if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
        Tcl_WideInt offset = objPtr->internalRep.wideValue;

        if ((endValue ^ offset) < 0) {
            /* Different signs, sum cannot overflow */
            *widePtr = endValue + offset;
        } else if (endValue >= 0) {
            if (endValue < LLONG_MAX - offset) {
                *widePtr = endValue + offset;
            } else {
                *widePtr = LLONG_MAX;
            }

	} else {
            if (endValue > LLONG_MIN - offset) {
                *widePtr = endValue + offset;
            } else {
                *widePtr = LLONG_MIN;
            }
	}
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * SetEndOffsetFromAny --
 *
 *	Look for a string of the form "end[+-]offset" and convert it to an
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
static int
SetEndOffsetFromAny(
    Tcl_Interp *interp,		/* Tcl interpreter or NULL */
    Tcl_Obj *objPtr)		/* Pointer to the object to parse */
{
    Tcl_WideInt offset;			/* Offset in the "end-offset" expression */
    register const char *bytes;	/* String rep of the object */
    int length;			/* Length of the object's string rep */

    /*
     * If it's already the right type, we're fine.
     */

    if (objPtr->typePtr == &endOffsetType) {
	return TCL_OK;
    }

    /*
     * Check for a string rep of the right form.
     */

    bytes = TclGetStringFromObj(objPtr, &length);
    if ((*bytes != 'e') || (strncmp(bytes, "end",
	    (size_t)((length > 3) ? 3 : length)) != 0)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad index \"%s\": must be end?[+-]integer?", bytes));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
	}
	return TCL_ERROR;
    }







|















|







3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
static int
SetEndOffsetFromAny(
    Tcl_Interp *interp,		/* Tcl interpreter or NULL */
    Tcl_Obj *objPtr)		/* Pointer to the object to parse */
{
    Tcl_WideInt offset;			/* Offset in the "end-offset" expression */
    register const char *bytes;	/* String rep of the object */
    size_t length;			/* Length of the object's string rep */

    /*
     * If it's already the right type, we're fine.
     */

    if (objPtr->typePtr == &endOffsetType) {
	return TCL_OK;
    }

    /*
     * Check for a string rep of the right form.
     */

    bytes = TclGetStringFromObj(objPtr, &length);
    if ((*bytes != 'e') || (strncmp(bytes, "end",
	    ((length > 3) ? 3 : length)) != 0)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad index \"%s\": must be end?[+-]integer?", bytes));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
	}
	return TCL_ERROR;
    }
3706
3707
3708
3709
3710
3711
3712

3713

3714
3715
3716

3717
3718
3719
3720
3721
3722
3723


3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
TclIndexEncode(
    Tcl_Interp *interp,	/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,	/* Index value to parse */
    int before,		/* Value to return for index before beginning */
    int after,		/* Value to return for index after end */
    int *indexPtr)	/* Where to write the encoded answer, not NULL */
{

    int idx;


    if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &idx)) {
        /* We parsed a value in the range INT_MIN...INT_MAX */

    integerEncode:
        if (idx < TCL_INDEX_START) {
            /* All negative absolute indices are "before the beginning" */
            idx = before;
        } else if (idx == INT_MAX) {
            /* This index value is always "after the end" */
            idx = after;


        }
        /* usual case, the absolute index value encodes itself */
    } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &idx)) {
        /*
         * We parsed an end+offset index value.
         * idx holds the offset value in the range INT_MIN...INT_MAX.
         */
        if (idx > 0) {
            /*
             * All end+postive or end-negative expressions
             * always indicate "after the end".
             */
            idx = after;
        } else if (idx < INT_MIN - TCL_INDEX_END) {
            /* These indices always indicate "before the beginning */
            idx = before;
        } else {
            /* Encoded end-positive (or end+negative) are offset */
            idx += TCL_INDEX_END;
        }

    /* TODO: Consider flag to suppress repeated end-offset parse. */
    } else if (TCL_OK == TclGetIntForIndexM(interp, objPtr, 0, &idx)) {
        /*
         * Only reach this case when the index value is a
         * constant index arithmetic expression, and idx
         * holds the result. Treat it the same as if it were
         * parsed as an absolute integer value.
         */
        goto integerEncode;
    } else {
	return TCL_ERROR;
    }







>
|
>

|
|
>

|


|


>
>
|

|


|

|





|




|



|


|







3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
TclIndexEncode(
    Tcl_Interp *interp,	/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,	/* Index value to parse */
    int before,		/* Value to return for index before beginning */
    int after,		/* Value to return for index after end */
    int *indexPtr)	/* Where to write the encoded answer, not NULL */
{
    ClientData cd;
    Tcl_WideInt wide;
    int idx, numType, code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);

    if ((code == TCL_OK) && (numType == TCL_NUMBER_INT)) {
        /* We parsed a value in the range LLONG_MIN...LLONG_MAX */
	wide = (*(Tcl_WideInt *)cd);
    integerEncode:
        if (wide < TCL_INDEX_START) {
            /* All negative absolute indices are "before the beginning" */
            idx = before;
        } else if (wide >= INT_MAX) {
            /* This index value is always "after the end" */
            idx = after;
        } else {
	    idx = (int) wide;
	}
        /* usual case, the absolute index value encodes itself */
    } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &wide)) {
        /*
         * We parsed an end+offset index value.
         * wide holds the offset value in the range LLONG_MIN...LLONG_MAX.
         */
        if (wide > 0) {
            /*
             * All end+postive or end-negative expressions
             * always indicate "after the end".
             */
            idx = after;
        } else if (wide < INT_MIN - TCL_INDEX_END) {
            /* These indices always indicate "before the beginning */
            idx = before;
        } else {
            /* Encoded end-positive (or end+negative) are offset */
            idx = (int)wide + TCL_INDEX_END;
        }

    /* TODO: Consider flag to suppress repeated end-offset parse. */
    } else if (TCL_OK == GetWideForIndex(interp, objPtr, 0, &wide)) {
        /*
         * Only reach this case when the index value is a
         * constant index arithmetic expression, and wide
         * holds the result. Treat it the same as if it were
         * parsed as an absolute integer value.
         */
        goto integerEncode;
    } else {
	return TCL_ERROR;
    }
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
GetThreadHash(
    Tcl_ThreadDataKey *keyPtr)
{
    Tcl_HashTable **tablePtrPtr =
	    Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));

    if (NULL == *tablePtrPtr) {
	*tablePtrPtr = ckalloc(sizeof(Tcl_HashTable));
	Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr);
	Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS);
    }
    return *tablePtrPtr;
}

/*







|







3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
GetThreadHash(
    Tcl_ThreadDataKey *keyPtr)
{
    Tcl_HashTable **tablePtrPtr =
	    Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));

    if (NULL == *tablePtrPtr) {
	*tablePtrPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr);
	Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS);
    }
    return *tablePtrPtr;
}

/*
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
FreeThreadHash(
    ClientData clientData)
{
    Tcl_HashTable *tablePtr = clientData;

    ClearHash(tablePtr);
    Tcl_DeleteHashTable(tablePtr);
    ckfree(tablePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeProcessGlobalValue --
 *







|







4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
FreeThreadHash(
    ClientData clientData)
{
    Tcl_HashTable *tablePtr = clientData;

    ClearHash(tablePtr);
    Tcl_DeleteHashTable(tablePtr);
    Tcl_Free(tablePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeProcessGlobalValue --
 *
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
FreeProcessGlobalValue(
    ClientData clientData)
{
    ProcessGlobalValue *pgvPtr = clientData;

    pgvPtr->epoch++;
    pgvPtr->numBytes = 0;
    ckfree(pgvPtr->value);
    pgvPtr->value = NULL;
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
	pgvPtr->encoding = NULL;
    }
    Tcl_MutexFinalize(&pgvPtr->mutex);
}







|







4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
FreeProcessGlobalValue(
    ClientData clientData)
{
    ProcessGlobalValue *pgvPtr = clientData;

    pgvPtr->epoch++;
    pgvPtr->numBytes = 0;
    Tcl_Free(pgvPtr->value);
    pgvPtr->value = NULL;
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
	pgvPtr->encoding = NULL;
    }
    Tcl_MutexFinalize(&pgvPtr->mutex);
}
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942

    /*
     * Fill the global string value.
     */

    pgvPtr->epoch++;
    if (NULL != pgvPtr->value) {
	ckfree(pgvPtr->value);
    } else {
	Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
    }
    bytes = TclGetString(newValue);
    pgvPtr->numBytes = newValue->length;
    pgvPtr->value = ckalloc(pgvPtr->numBytes + 1);
    memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1);
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
    }
    pgvPtr->encoding = encoding;

    /*







|





|







4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087

    /*
     * Fill the global string value.
     */

    pgvPtr->epoch++;
    if (NULL != pgvPtr->value) {
	Tcl_Free(pgvPtr->value);
    } else {
	Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
    }
    bytes = TclGetString(newValue);
    pgvPtr->numBytes = newValue->length;
    pgvPtr->value = Tcl_Alloc(pgvPtr->numBytes + 1);
    memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1);
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
    }
    pgvPtr->encoding = encoding;

    /*
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
	    Tcl_MutexLock(&pgvPtr->mutex);
	    epoch = ++pgvPtr->epoch;
	    Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value,
		    pgvPtr->numBytes, &native);
	    Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native),
	    Tcl_DStringLength(&native), &newValue);
	    Tcl_DStringFree(&native);
	    ckfree(pgvPtr->value);
	    pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1);
	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
		    (size_t) Tcl_DStringLength(&newValue) + 1);
	    Tcl_DStringFree(&newValue);
	    Tcl_FreeEncoding(pgvPtr->encoding);
	    pgvPtr->encoding = current;
	    Tcl_MutexUnlock(&pgvPtr->mutex);
	} else {
	    Tcl_FreeEncoding(current);
	}







|
|

|







4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
	    Tcl_MutexLock(&pgvPtr->mutex);
	    epoch = ++pgvPtr->epoch;
	    Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value,
		    pgvPtr->numBytes, &native);
	    Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native),
	    Tcl_DStringLength(&native), &newValue);
	    Tcl_DStringFree(&native);
	    Tcl_Free(pgvPtr->value);
	    pgvPtr->value = Tcl_Alloc(Tcl_DStringLength(&newValue) + 1);
	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
		    Tcl_DStringLength(&newValue) + 1);
	    Tcl_DStringFree(&newValue);
	    Tcl_FreeEncoding(pgvPtr->encoding);
	    pgvPtr->encoding = current;
	    Tcl_MutexUnlock(&pgvPtr->mutex);
	} else {
	    Tcl_FreeEncoding(current);
	}
Changes to generic/tclVar.c.
160
161
162
163
164
165
166












167
168
169
170
171
172
173
				 * Tcl_NextHashEntry to get value to
				 * return. */
    struct ArraySearch *nextPtr;/* Next in list of all active searches for
				 * this variable, or NULL if this is the last
				 * one. */
} ArraySearch;













/*
 * Forward references to functions defined later in this file:
 */

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks);
static void		ArrayPopulateSearch(Tcl_Interp *interp,







>
>
>
>
>
>
>
>
>
>
>
>







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
				 * Tcl_NextHashEntry to get value to
				 * return. */
    struct ArraySearch *nextPtr;/* Next in list of all active searches for
				 * this variable, or NULL if this is the last
				 * one. */
} ArraySearch;

/*
 * TIP #508: [array default]
 *
 * The following structure extends the regular TclVarHashTable used by array
 * variables to store their optional default value.
 */

typedef struct ArrayVarHashTable {
    TclVarHashTable table;
    Tcl_Obj *defaultObj;
} ArrayVarHashTable;

/*
 * Forward references to functions defined later in this file:
 */

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks);
static void		ArrayPopulateSearch(Tcl_Interp *interp,
193
194
195
196
197
198
199










200
201
202
203
204
205
206
			    Tcl_Obj *myNamePtr, int myFlags, int index);
static ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
			    Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
			    Interp *iPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int flags, int index);











/*
 * Functions defined in this file that may be exported in the future for use
 * by the bytecode compiler and engine or to the public interface.
 */

MODULE_SCOPE Var *	TclLookupSimpleVar(Tcl_Interp *interp,
			    Tcl_Obj *varNamePtr, int flags, const int create,







>
>
>
>
>
>
>
>
>
>







205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
			    Tcl_Obj *myNamePtr, int myFlags, int index);
static ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
			    Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
			    Interp *iPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int flags, int index);

/*
 * TIP #508: [array default]
 */

static int		ArrayDefaultCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		DeleteArrayVar(Var *arrayPtr);
static void		SetArrayDefault(Var *arrayPtr, Tcl_Obj *defaultObj);

/*
 * Functions defined in this file that may be exported in the future for use
 * by the bytecode compiler and engine or to the public interface.
 */

MODULE_SCOPE Var *	TclLookupSimpleVar(Tcl_Interp *interp,
			    Tcl_Obj *varNamePtr, int flags, const int create,
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
    FreeLocalVarName, DupLocalVarName, NULL, NULL
};

static const Tcl_ObjType tclParsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, NULL, NULL
};


Var *
TclVarHashCreateVar(
    TclVarHashTable *tablePtr,
    const char *key,
    int *newPtr)
{







<







254
255
256
257
258
259
260

261
262
263
264
265
266
267
    FreeLocalVarName, DupLocalVarName, NULL, NULL
};

static const Tcl_ObjType tclParsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, NULL, NULL
};


Var *
TclVarHashCreateVar(
    TclVarHashTable *tablePtr,
    const char *key,
    int *newPtr)
{
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
				 * if this variable isn't an array element. */
{
    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
	    && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == (unsigned)
		    !TclIsVarDeadHash(varPtr))) {
	if (VarHashRefCount(varPtr) == 0) {
	    ckfree(varPtr);
	} else {
	    VarHashDeleteEntry(varPtr);
	}
    }
    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
	    (VarHashRefCount(arrayPtr) == (unsigned)
		    !TclIsVarDeadHash(arrayPtr))) {
	if (VarHashRefCount(arrayPtr) == 0) {
	    ckfree(arrayPtr);
	} else {
	    VarHashDeleteEntry(arrayPtr);
	}
    }
}

void







|









|







342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
				 * if this variable isn't an array element. */
{
    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
	    && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == (unsigned)
		    !TclIsVarDeadHash(varPtr))) {
	if (VarHashRefCount(varPtr) == 0) {
	    Tcl_Free(varPtr);
	} else {
	    VarHashDeleteEntry(varPtr);
	}
    }
    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
	    (VarHashRefCount(arrayPtr) == (unsigned)
		    !TclIsVarDeadHash(arrayPtr))) {
	if (VarHashRefCount(arrayPtr) == 0) {
	    Tcl_Free(arrayPtr);
	} else {
	    VarHashDeleteEntry(arrayPtr);
	}
    }
}

void
908
909
910
911
912
913
914
915


916
917

918
919
920
921
922
923
924
925
926
927
928

929
930
931
932
933
934
935
936
937
938
939
940
941
942

		*indexPtr = -1;
	    } else {
		*indexPtr = -2;
	    }
	}
    } else {			/* Local var: look in frame varFramePtr. */
	int localLen, localCt = varFramePtr->numCompiledLocals;


	Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	const char *localNameStr;


	for (i=0 ; i<localCt ; i++, objPtrPtr++) {
	    register Tcl_Obj *objPtr = *objPtrPtr;

	    if (objPtr) {
		localNameStr = TclGetStringFromObj(objPtr, &localLen);

		if ((varLen == localLen) && (varName[0] == localNameStr[0])
			&& !memcmp(varName, localNameStr, varLen)) {
		    *indexPtr = i;
		    return (Var *) &varFramePtr->compiledLocals[i];

		}
	    }
	}
	tablePtr = varFramePtr->varTablePtr;
	if (create) {
	    if (tablePtr == NULL) {
		tablePtr = ckalloc(sizeof(TclVarHashTable));
		TclInitVarHashTable(tablePtr, NULL);
		varFramePtr->varTablePtr = tablePtr;
	    }
	    varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew);
	} else {
	    varPtr = NULL;
	    if (tablePtr != NULL) {







|
>
>
|
|
>

|
|

|
|

|

|
|
>






|







929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967

		*indexPtr = -1;
	    } else {
		*indexPtr = -2;
	    }
	}
    } else {			/* Local var: look in frame varFramePtr. */
	int localCt = varFramePtr->numCompiledLocals;

	if (localCt > 0) {
	    Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	    const char *localNameStr;
	    int localLen;

	    for (i=0 ; i<localCt ; i++, objPtrPtr++) {
		register Tcl_Obj *objPtr = *objPtrPtr;

		if (objPtr) {
		    localNameStr = TclGetStringFromObj(objPtr, &localLen);

		    if ((varLen == localLen) && (varName[0] == localNameStr[0])
			&& !memcmp(varName, localNameStr, varLen)) {
			*indexPtr = i;
			return (Var *) &varFramePtr->compiledLocals[i];
		    }
		}
	    }
	}
	tablePtr = varFramePtr->varTablePtr;
	if (create) {
	    if (tablePtr == NULL) {
		tablePtr = Tcl_Alloc(sizeof(TclVarHashTable));
		TclInitVarHashTable(tablePtr, NULL);
		varFramePtr->varTablePtr = tablePtr;
	    }
	    varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew);
	} else {
	    varPtr = NULL;
	    if (tablePtr != NULL) {
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
				 * element, if it doesn't already exist. If 0,
				 * return error if it doesn't exist. */
    Var *arrayPtr,		/* Pointer to the array's Var structure. */
    int index)			/* If >=0, the index of the local array. */
{
    int isNew;
    Var *varPtr;
    TclVarHashTable *tablePtr;
    Namespace *nsPtr;

    /*
     * We're dealing with an array element. Make sure the variable is an array
     * and look up the element (create the element if desired).
     */

    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {







<
<







1032
1033
1034
1035
1036
1037
1038


1039
1040
1041
1042
1043
1044
1045
				 * element, if it doesn't already exist. If 0,
				 * return error if it doesn't exist. */
    Var *arrayPtr,		/* Pointer to the array's Var structure. */
    int index)			/* If >=0, the index of the local array. */
{
    int isNew;
    Var *varPtr;



    /*
     * We're dealing with an array element. Make sure the variable is an array
     * and look up the element (create the element if desired).
     */

    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
			danglingVar, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	    }
	    return NULL;
	}

	TclSetVarArray(arrayPtr);
	tablePtr = ckalloc(sizeof(TclVarHashTable));
	arrayPtr->value.tablePtr = tablePtr;

	if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
	    nsPtr = TclGetVarNsPtr(arrayPtr);
	} else {
	    nsPtr = NULL;
	}
	TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
    } else if (!TclIsVarArray(arrayPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
		    index);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	}







|
<
<
<
<
<
<
<
<
<







1064
1065
1066
1067
1068
1069
1070
1071









1072
1073
1074
1075
1076
1077
1078
			danglingVar, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	    }
	    return NULL;
	}

	TclInitArrayVar(arrayPtr);









    } else if (!TclIsVarArray(arrayPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
		    index);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	}
1354
1355
1356
1357
1358
1359
1360






















1361
1362
1363
1364
1365
1366
1367
    /*
     * Return the element if it's an existing scalar variable.
     */

    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
	return varPtr->value.objPtr;
    }























    if (flags & TCL_LEAVE_ERR_MSG) {
	if (TclIsVarUndefined(varPtr) && arrayPtr
		&& !TclIsVarUndefined(arrayPtr)) {
	    msg = noSuchElement;
	} else if (TclIsVarArray(varPtr)) {
	    msg = isArray;







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
    /*
     * Return the element if it's an existing scalar variable.
     */

    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
	return varPtr->value.objPtr;
    }

    /*
     * Return the array default value if any.
     */

    if (arrayPtr && TclIsVarArray(arrayPtr) && TclGetArrayDefault(arrayPtr)) {
	return TclGetArrayDefault(arrayPtr);
    }
    if (TclIsVarArrayElement(varPtr) && !arrayPtr) {
	/*
	 * UGLY! Peek inside the implementation of things. This lets us get
	 * the default of an array even when we've been [upvar]ed to just an
	 * element of the array.
	 */

	ArrayVarHashTable *avhtPtr = (ArrayVarHashTable *)
		((VarInHash *) varPtr)->entry.tablePtr;

	if (avhtPtr->defaultObj) {
	    return avhtPtr->defaultObj;
	}
    }

    if (flags & TCL_LEAVE_ERR_MSG) {
	if (TclIsVarUndefined(varPtr) && arrayPtr
		&& !TclIsVarUndefined(arrayPtr)) {
	    msg = noSuchElement;
	} else if (TclIsVarArray(varPtr)) {
	    msg = isArray;
1668
1669
1670
1671
1672
1673
1674




























































































































1675
1676
1677
1678
1679
1680
1681
    return TclPtrSetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
	    part1Ptr, part2Ptr, newValuePtr, flags, -1);
}

/*
 *----------------------------------------------------------------------
 *




























































































































 * TclPtrSetVarIdx --
 *
 *	This function is the same as Tcl_SetVar2Ex above, except that it
 *	requires pointers to the variable's Var structs in addition to the
 *	variable names.
 *
 * Results:







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
    return TclPtrSetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
	    part1Ptr, part2Ptr, newValuePtr, flags, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * ListAppendInVar, StringAppendInVar --
 *
 *	Support functions for TclPtrSetVarIdx that implement various types of
 *	appending operations.
 *
 * Results:
 *	ListAppendInVar returns a Tcl result code (from the core list append
 *	operation). StringAppendInVar has no return value.
 *
 * Side effects:
 *	The variable or element of the array is updated. This may make the
 *	variable/element exist. Reference counts of values may be updated.
 *
 *----------------------------------------------------------------------
 */

static inline int
ListAppendInVar(
    Tcl_Interp *interp,
    Var *varPtr,
    Var *arrayPtr,
    Tcl_Obj *oldValuePtr,
    Tcl_Obj *newValuePtr)
{
    if (oldValuePtr == NULL) {
	/*
	 * No previous value. Check for defaults if there's an array we can
	 * ask this of.
	 */

	if (arrayPtr) {
	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);

	    if (defValuePtr) {
		oldValuePtr = Tcl_DuplicateObj(defValuePtr);
	    }
	}

	if (oldValuePtr == NULL) {
	    /*
	     * No default. [lappend] semantics say this is like being an empty
	     * string.
	     */

	    TclNewObj(oldValuePtr);
	}
	varPtr->value.objPtr = oldValuePtr;
	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
    } else if (Tcl_IsShared(oldValuePtr)) {
	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
	TclDecrRefCount(oldValuePtr);
	oldValuePtr = varPtr->value.objPtr;
	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
    }

    return Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr);
}

static inline void
StringAppendInVar(
    Var *varPtr,
    Var *arrayPtr,
    Tcl_Obj *oldValuePtr,
    Tcl_Obj *newValuePtr)
{
    /*
     * If there was no previous value, either we use the array's default (if
     * this is an array with a default at all) or we treat this as a simple
     * set.
     */

    if (oldValuePtr == NULL) {
	if (arrayPtr) {
	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);

	    if (defValuePtr) {
		/*
		 * This is *almost* the same as the shared path below, except
		 * that the original value reference in defValuePtr is not
		 * decremented.
		 */

		Tcl_Obj *valuePtr = Tcl_DuplicateObj(defValuePtr);

		varPtr->value.objPtr = valuePtr;
		TclContinuationsCopy(valuePtr, defValuePtr);
		Tcl_IncrRefCount(valuePtr);
		Tcl_AppendObjToObj(valuePtr, newValuePtr);
		if (newValuePtr->refCount == 0) {
		    Tcl_DecrRefCount(newValuePtr);
		}
		return;
	    }
	}
	varPtr->value.objPtr = newValuePtr;
	Tcl_IncrRefCount(newValuePtr);
	return;
    }

    /*
     * We append newValuePtr's bytes but don't change its ref count. Unless
     * the reference is shared, when we have to duplicate in order to be safe
     * to modify at all.
     */

    if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);

	TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);

	TclDecrRefCount(oldValuePtr);
	oldValuePtr = varPtr->value.objPtr;
	Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
    }

    Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
    if (newValuePtr->refCount == 0) {
	Tcl_DecrRefCount(newValuePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrSetVarIdx --
 *
 *	This function is the same as Tcl_SetVar2Ex above, except that it
 *	requires pointers to the variable's Var structs in addition to the
 *	variable names.
 *
 * Results:
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831

    oldValuePtr = varPtr->value.objPtr;
    if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
	varPtr->value.objPtr = NULL;
    }
    if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */
	    if (oldValuePtr == NULL) {
		TclNewObj(oldValuePtr);
		varPtr->value.objPtr = oldValuePtr;
		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
	    } else if (Tcl_IsShared(oldValuePtr)) {
		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
		TclDecrRefCount(oldValuePtr);
		oldValuePtr = varPtr->value.objPtr;
		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
	    }
	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
		    newValuePtr);
	    if (result != TCL_OK) {
		goto earlyError;
	    }
	} else {				/* Append string. */
	    /*
	     * We append newValuePtr's bytes but don't change its ref count.
	     */

	    if (oldValuePtr == NULL) {
		varPtr->value.objPtr = newValuePtr;
		Tcl_IncrRefCount(newValuePtr);
	    } else {
		if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);

		    TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);

		    TclDecrRefCount(oldValuePtr);
		    oldValuePtr = varPtr->value.objPtr;
		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
		}
		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
		if (newValuePtr->refCount == 0) {
		    Tcl_DecrRefCount(newValuePtr);
		}
	    }
	}
    } else if (newValuePtr != oldValuePtr) {
	/*
	 * In this case we are replacing the value, so we don't need to do
	 * more than swap the objects.
	 */








<
|
<
<
<
<
<
<
<
<
<





<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<







1940
1941
1942
1943
1944
1945
1946

1947









1948
1949
1950
1951
1952

















1953




1954
1955
1956
1957
1958
1959
1960

    oldValuePtr = varPtr->value.objPtr;
    if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
	varPtr->value.objPtr = NULL;
    }
    if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */

	    result = ListAppendInVar(interp, varPtr, arrayPtr, oldValuePtr,









		    newValuePtr);
	    if (result != TCL_OK) {
		goto earlyError;
	    }
	} else {				/* Append string. */

















	    StringAppendInVar(varPtr, arrayPtr, oldValuePtr, newValuePtr);




	}
    } else if (newValuePtr != oldValuePtr) {
	/*
	 * In this case we are replacing the value, so we don't need to do
	 * more than swap the objects.
	 */

2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
	return NotArrayError(interp, arrayNameObj);
    }

    /*
     * Make a new array search, put it on the stack.
     */

    searchPtr = ckalloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish.
     */








|







3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
	return NotArrayError(interp, arrayNameObj);
    }

    /*
     * Make a new array search, put it on the stack.
     */

    searchPtr = Tcl_Alloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish.
     */

3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
	/*
	 * If the search was terminated by an array change, the
	 * VAR_SEARCH_ACTIVE flag will no longer be set.
	 */

	ArrayDoneSearch(iPtr, varPtr, searchPtr);
	Tcl_DecrRefCount(searchPtr->name);
	ckfree(searchPtr);
    }

    TclDecrRefCount(varListObj);
    TclDecrRefCount(scriptObj);
    return result;
}








|







3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
	/*
	 * If the search was terminated by an array change, the
	 * VAR_SEARCH_ACTIVE flag will no longer be set.
	 */

	ArrayDoneSearch(iPtr, varPtr, searchPtr);
	Tcl_DecrRefCount(searchPtr->name);
	Tcl_Free(searchPtr);
    }

    TclDecrRefCount(varListObj);
    TclDecrRefCount(scriptObj);
    return result;
}

3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
	return NotArrayError(interp, objv[1]);
    }

    /*
     * Make a new array search with a free name.
     */

    searchPtr = ckalloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr);
    Tcl_SetObjResult(interp, searchPtr->name);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







|







3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
	return NotArrayError(interp, objv[1]);
    }

    /*
     * Make a new array search with a free name.
     */

    searchPtr = Tcl_Alloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr);
    Tcl_SetObjResult(interp, searchPtr->name);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
	return TCL_ERROR;
    }

    ArrayDoneSearch(iPtr, varPtr, searchPtr);
    Tcl_DecrRefCount(searchPtr->name);
    ckfree(searchPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayExistsCmd --







|







3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
	return TCL_ERROR;
    }

    ArrayDoneSearch(iPtr, varPtr, searchPtr);
    Tcl_DecrRefCount(searchPtr->name);
    Tcl_Free(searchPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayExistsCmd --
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939

	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
		    needArray, -1);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	    return TCL_ERROR;
	}
    }
    TclSetVarArray(varPtr);
    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArraySizeCmd --







|
<
<







4052
4053
4054
4055
4056
4057
4058
4059


4060
4061
4062
4063
4064
4065
4066

	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
		    needArray, -1);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	    return TCL_ERROR;
	}
    }
    TclInitArrayVar(varPtr);


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArraySizeCmd --
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
    stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
    if (stats == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"error reading array statistics", -1));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
    ckfree(stats);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayUnsetCmd --







|







4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
    stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
    if (stats == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"error reading array statistics", -1));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
    Tcl_Free(stats);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayUnsetCmd --
4205
4206
4207
4208
4209
4210
4211

4212
4213
4214
4215
4216
4217
4218
	/* ARGSUSED */
Tcl_Command
TclInitArrayCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap arrayImplMap[] = {
	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},

	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
	{"for",		ArrayForObjCmd,		TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
	{"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"names",	ArrayNamesCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"set",		ArraySetCmd,		TclCompileArraySetCmd, NULL, NULL, 0},







>







4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
	/* ARGSUSED */
Tcl_Command
TclInitArrayCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap arrayImplMap[] = {
	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"default",	ArrayDefaultCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
	{"for",		ArrayForObjCmd,		TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
	{"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"names",	ArrayNamesCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"set",		ArraySetCmd,		TclCompileArraySetCmd, NULL, NULL, 0},
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061

    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
	for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
		searchPtr = nextPtr) {
	    nextPtr = searchPtr->nextPtr;
	    Tcl_DecrRefCount(searchPtr->name);
	    ckfree(searchPtr);
	}
	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
	Tcl_DeleteHashEntry(sPtr);
    }
}

/*







|







5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189

    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
	for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
		searchPtr = nextPtr) {
	    nextPtr = searchPtr->nextPtr;
	    Tcl_DecrRefCount(searchPtr->name);
	    Tcl_Free(searchPtr);
	}
	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
	Tcl_DeleteHashEntry(sPtr);
    }
}

/*
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
	 * variables, some combinations of [upvar] and [variable] may create
	 * such beasts - see [Bug 604239]. This is necessary to avoid leaking
	 * the corresponding Var struct, and is otherwise harmless.
	 */

	TclClearVarNamespaceVar(elPtr);
    }
    VarHashDeleteTable(varPtr->value.tablePtr);
    ckfree(varPtr->value.tablePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjVarErrMsg --
 *







<
|







5466
5467
5468
5469
5470
5471
5472

5473
5474
5475
5476
5477
5478
5479
5480
	 * variables, some combinations of [upvar] and [variable] may create
	 * such beasts - see [Bug 604239]. This is necessary to avoid leaking
	 * the corresponding Var struct, and is otherwise harmless.
	 */

	TclClearVarNamespaceVar(elPtr);
    }

    DeleteArrayVar(varPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjVarErrMsg --
 *
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053



6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
6065
6066
6067
6068
6069

6070
6071
6072
6073
6074
6075
6076
    Tcl_Obj *listPtr,		/* List object to append names to. */
    Tcl_Obj *patternPtr,	/* Pattern to match against. */
    int includeLinks)		/* 1 if upvars should be included, else 0. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    int i, localVarCt, added;
    Tcl_Obj **varNamePtr, *objNamePtr;
    const char *varName;
    TclVarHashTable *localVarTablePtr;
    Tcl_HashSearch search;
    Tcl_HashTable addedTable;
    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;

    localVarCt = iPtr->varFramePtr->numCompiledLocals;
    varPtr = iPtr->varFramePtr->compiledLocals;
    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
    varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
    if (includeLinks) {
	Tcl_InitObjHashTable(&addedTable);
    }




    for (i = 0; i < localVarCt; i++, varNamePtr++) {
	/*
	 * Skip nameless (temporary) variables and undefined variables.
	 */

	if (*varNamePtr && !TclIsVarUndefined(varPtr)
		&& (includeLinks || !TclIsVarLink(varPtr))) {
	    varName = TclGetString(*varNamePtr);
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
		if (includeLinks) {
		    Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
		}
	    }
	}
	varPtr++;

    }

    /*
     * Do nothing if no local variables.
     */

    if (localVarTablePtr == NULL) {







|









<




>
>
>
|
|
|
|

|

|
|
|
|
|
|
|
|
|
>







6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174
6175

6176
6177
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
6206
    Tcl_Obj *listPtr,		/* List object to append names to. */
    Tcl_Obj *patternPtr,	/* Pattern to match against. */
    int includeLinks)		/* 1 if upvars should be included, else 0. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    int i, localVarCt, added;
    Tcl_Obj *objNamePtr;
    const char *varName;
    TclVarHashTable *localVarTablePtr;
    Tcl_HashSearch search;
    Tcl_HashTable addedTable;
    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;

    localVarCt = iPtr->varFramePtr->numCompiledLocals;
    varPtr = iPtr->varFramePtr->compiledLocals;
    localVarTablePtr = iPtr->varFramePtr->varTablePtr;

    if (includeLinks) {
	Tcl_InitObjHashTable(&addedTable);
    }

    if (localVarCt > 0) {
	Tcl_Obj **varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;

	for (i = 0; i < localVarCt; i++, varNamePtr++) {
	    /*
	     * Skip nameless (temporary) variables and undefined variables.
	     */

	    if (*varNamePtr && !TclIsVarUndefined(varPtr)
		&& (includeLinks || !TclIsVarLink(varPtr))) {
		varName = TclGetString(*varNamePtr);
		if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		    Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
		    if (includeLinks) {
			Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
		    }
		}
	    }
	    varPtr++;
	}
    }

    /*
     * Do nothing if no local variables.
     */

    if (localVarTablePtr == NULL) {
6187
6188
6189
6190
6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
}

static Tcl_HashEntry *
AllocVarEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = keyPtr;
    Tcl_HashEntry *hPtr;
    Var *varPtr;

    varPtr = ckalloc(sizeof(VarInHash));
    varPtr->flags = VAR_IN_HASHTABLE;
    varPtr->value.objPtr = NULL;
    VarHashRefCount(varPtr) = 1;

    hPtr = &(((VarInHash *) varPtr)->entry);
    Tcl_SetHashValue(hPtr, varPtr);
    hPtr->key.objPtr = objPtr;







|



|







6317
6318
6319
6320
6321
6322
6323
6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
6334
6335
}

static Tcl_HashEntry *
AllocVarEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_HashEntry *hPtr;
    Var *varPtr;

    varPtr = Tcl_Alloc(sizeof(VarInHash));
    varPtr->flags = VAR_IN_HASHTABLE;
    varPtr->value.objPtr = NULL;
    VarHashRefCount(varPtr) = 1;

    hPtr = &(((VarInHash *) varPtr)->entry);
    Tcl_SetHashValue(hPtr, varPtr);
    hPtr->key.objPtr = objPtr;
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
    Tcl_HashEntry *hPtr)
{
    Var *varPtr = VarHashGetValue(hPtr);
    Tcl_Obj *objPtr = hPtr->key.objPtr;

    if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == 1)) {
	ckfree(varPtr);
    } else {
	VarHashInvalidateEntry(varPtr);
	TclSetVarUndefined(varPtr);
	VarHashRefCount(varPtr)--;
    }
    Tcl_DecrRefCount(objPtr);
}

static int
CompareVarKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = keyPtr;
    Tcl_Obj *objPtr2 = hPtr->key.objPtr;
    register const char *p1, *p2;
    register int l1, l2;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller







|










|


|







6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366
6367
6368
6369
6370
6371
    Tcl_HashEntry *hPtr)
{
    Var *varPtr = VarHashGetValue(hPtr);
    Tcl_Obj *objPtr = hPtr->key.objPtr;

    if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == 1)) {
	Tcl_Free(varPtr);
    } else {
	VarHashInvalidateEntry(varPtr);
	TclSetVarUndefined(varPtr);
	VarHashRefCount(varPtr)--;
    }
    Tcl_DecrRefCount(objPtr);
}

static int
CompareVarKeys(
    void *keyPtr,			/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr2 = hPtr->key.objPtr;
    register const char *p1, *p2;
    register int l1, l2;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller
6255
6256
6257
6258
6259
6260
6261


































































































































































































































































6262
6263
6264
6265
6266
6267
6268
6269

    /*
     * Only compare string representations of the same length.
     */

    return ((l1 == l2) && !memcmp(p1, p2, l1));
}



































































































































































































































































/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








6385
6386
6387
6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504
6505
6506
6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522
6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533
6534
6535
6536
6537
6538
6539
6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657

    /*
     * Only compare string representations of the same length.
     */

    return ((l1 == l2) && !memcmp(p1, p2, l1));
}

/*----------------------------------------------------------------------
 *
 * ArrayDefaultCmd --
 *
 *	This function implements the 'array default' Tcl command.
 *	Refer to the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ArrayDefaultCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const options[] = {
	"get", "set", "exists", "unset", NULL
    };
    enum options { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET };
    Tcl_Obj *arrayNameObj, *defaultValueObj;
    Var *varPtr, *arrayPtr;
    int isArray, option;

    /*
     * Parse arguments.
     */

    if (objc != 3 && objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?value?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option",
	    0, &option) != TCL_OK) {
	return TCL_ERROR;
    }

    arrayNameObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    switch (option) {
    case OPT_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}
	if (!varPtr || TclIsVarUndefined(varPtr) || !isArray) {
	    return NotArrayError(interp, arrayNameObj);
	}

	defaultValueObj = TclGetArrayDefault(varPtr);
	if (!defaultValueObj) {
	    /* Array default must exist. */
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "array has no default value", -1));
	    Tcl_SetErrorCode(interp, "TCL", "READ", "ARRAY", "DEFAULT", NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, defaultValueObj);
	return TCL_OK;

    case OPT_SET:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName value");
	    return TCL_ERROR;
	}

	/*
	 * Attempt to create array if needed.
	 */
	varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
		/*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "array default set",
		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	    return TCL_ERROR;
	}
	if (arrayPtr) {
	    /*
	     * Not a valid array name.
	     */

	    CleanupVar(varPtr, arrayPtr);
	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
		    needArray, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(arrayNameObj), NULL);
	    return TCL_ERROR;
	}
	if (!TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
	    /*
	     * Not an array.
	     */

	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
		    needArray, -1);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	    return TCL_ERROR;
	}

	if (!TclIsVarArray(varPtr)) {
	    TclInitArrayVar(varPtr);
	}
	defaultValueObj = objv[3];
	SetArrayDefault(varPtr, defaultValueObj);
	return TCL_OK;

    case OPT_EXISTS:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}

	/*
	 * Undefined variables (whether or not they have storage allocated) do
	 * not have defaults, and this is not an error case.
	 */

	if (!varPtr || TclIsVarUndefined(varPtr)) {
	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
	} else if (!isArray) {
	    return NotArrayError(interp, arrayNameObj);
	} else {
	    defaultValueObj = TclGetArrayDefault(varPtr);
	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!!defaultValueObj));
	}
	return TCL_OK;

    case OPT_UNSET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}

	if (varPtr && !TclIsVarUndefined(varPtr)) {
	    if (!isArray) {
		return NotArrayError(interp, arrayNameObj);
	    }
	    SetArrayDefault(varPtr, NULL);
	}
	return TCL_OK;
    }

    /* Unreached */
    return TCL_ERROR;
}

/*
 * Initialize array variable.
 */

void
TclInitArrayVar(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = Tcl_Alloc(sizeof(ArrayVarHashTable));

    /*
     * Mark the variable as an array.
     */

    TclSetVarArray(arrayPtr);

    /*
     * Regular TclVarHashTable initialization.
     */

    arrayPtr->value.tablePtr = (TclVarHashTable *) tablePtr;
    TclInitVarHashTable(arrayPtr->value.tablePtr, TclGetVarNsPtr(arrayPtr));

    /*
     * Default value initialization.
     */

    tablePtr->defaultObj = NULL;
}

/*
 * Cleanup array variable.
 */

static void
DeleteArrayVar(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
	    arrayPtr->value.tablePtr;

    /*
     * Default value cleanup.
     */

    SetArrayDefault(arrayPtr, NULL);

    /*
     * Regular TclVarHashTable cleanup.
     */

    VarHashDeleteTable(arrayPtr->value.tablePtr);
    Tcl_Free(tablePtr);
}

/*
 * Get array default value if any.
 */

Tcl_Obj *
TclGetArrayDefault(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
	    arrayPtr->value.tablePtr;

    return tablePtr->defaultObj;
}

/*
 * Set/replace/unset array default value.
 */

static void
SetArrayDefault(
    Var *arrayPtr,
    Tcl_Obj *defaultObj)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
	    arrayPtr->value.tablePtr;

    /*
     * Increment/decrement refcount twice to ensure that the object is shared,
     * so that it doesn't get modified accidentally by the folling code:
     *
     *      array default set v 1
     *      lappend v(a) 2; # returns a new object {1 2}
     *      set v(b); # returns the original default object "1"
     */

    if (tablePtr->defaultObj) {
        Tcl_DecrRefCount(tablePtr->defaultObj);
        Tcl_DecrRefCount(tablePtr->defaultObj);
    }
    tablePtr->defaultObj = defaultObj;
    if (tablePtr->defaultObj) {
        Tcl_IncrRefCount(tablePtr->defaultObj);
        Tcl_IncrRefCount(tablePtr->defaultObj);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Added generic/tclZipfs.c.






































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
/*
 * tclZipfs.c --
 *
 *	Implementation of the ZIP filesystem used in TIP 430
 *	Adapted from the implentation for AndroWish.
 *
 * Copyright (c) 2016-2017 Sean Woods <yoda@etoyoc.com>
 * Copyright (c) 2013-2015 Christian Werner <chw@ch-werner.de>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This file is distributed in two ways:
 *   generic/tclZipfs.c file in the TIP430-enabled Tcl cores.
 *   compat/tclZipfs.c file in the tclconfig (TEA) file system, for pre-tip430
 *	projects.
 */

#include "tclInt.h"
#include "tclFileSystem.h"

#ifndef _WIN32
#include <sys/mman.h>
#endif /* _WIN32*/

#ifndef MAP_FILE
#define MAP_FILE 0
#endif /* !MAP_FILE */

#ifdef HAVE_ZLIB
#include "zlib.h"
#include "crypt.h"

#ifdef CFG_RUNTIME_DLLFILE

/*
** We are compiling as part of the core.
** TIP430 style zipfs prefix
*/

#define ZIPFS_VOLUME	  "//zipfs:/"
#define ZIPFS_VOLUME_LEN  9
#define ZIPFS_APP_MOUNT	  "//zipfs:/app"
#define ZIPFS_ZIP_MOUNT	  "//zipfs:/lib/tcl"

#else /* !CFG_RUNTIME_DLLFILE */

/*
** We are compiling from the /compat folder of tclconfig
** Pre TIP430 style zipfs prefix
** //zipfs:/ doesn't work straight out of the box on either windows or Unix
** without other changes made to tip 430
*/

#define ZIPFS_VOLUME	  "zipfs:/"
#define ZIPFS_VOLUME_LEN  7
#define ZIPFS_APP_MOUNT	  "zipfs:/app"
#define ZIPFS_ZIP_MOUNT	  "zipfs:/lib/tcl"

#endif /* CFG_RUNTIME_DLLFILE */

/*
 * Various constants and offsets found in ZIP archive files
 */

#define ZIP_SIG_LEN			4

/*
 * Local header of ZIP archive member (at very beginning of each member).
 */

#define ZIP_LOCAL_HEADER_SIG		0x04034b50
#define ZIP_LOCAL_HEADER_LEN		30
#define ZIP_LOCAL_SIG_OFFS		0
#define ZIP_LOCAL_VERSION_OFFS		4
#define ZIP_LOCAL_FLAGS_OFFS		6
#define ZIP_LOCAL_COMPMETH_OFFS		8
#define ZIP_LOCAL_MTIME_OFFS		10
#define ZIP_LOCAL_MDATE_OFFS		12
#define ZIP_LOCAL_CRC32_OFFS		14
#define ZIP_LOCAL_COMPLEN_OFFS		18
#define ZIP_LOCAL_UNCOMPLEN_OFFS	22
#define ZIP_LOCAL_PATHLEN_OFFS		26
#define ZIP_LOCAL_EXTRALEN_OFFS		28

/*
 * Central header of ZIP archive member at end of ZIP file.
 */

#define ZIP_CENTRAL_HEADER_SIG		0x02014b50
#define ZIP_CENTRAL_HEADER_LEN		46
#define ZIP_CENTRAL_SIG_OFFS		0
#define ZIP_CENTRAL_VERSIONMADE_OFFS	4
#define ZIP_CENTRAL_VERSION_OFFS	6
#define ZIP_CENTRAL_FLAGS_OFFS		8
#define ZIP_CENTRAL_COMPMETH_OFFS	10
#define ZIP_CENTRAL_MTIME_OFFS		12
#define ZIP_CENTRAL_MDATE_OFFS		14
#define ZIP_CENTRAL_CRC32_OFFS		16
#define ZIP_CENTRAL_COMPLEN_OFFS	20
#define ZIP_CENTRAL_UNCOMPLEN_OFFS	24
#define ZIP_CENTRAL_PATHLEN_OFFS	28
#define ZIP_CENTRAL_EXTRALEN_OFFS	30
#define ZIP_CENTRAL_FCOMMENTLEN_OFFS	32
#define ZIP_CENTRAL_DISKFILE_OFFS	34
#define ZIP_CENTRAL_IATTR_OFFS		36
#define ZIP_CENTRAL_EATTR_OFFS		38
#define ZIP_CENTRAL_LOCALHDR_OFFS	42

/*
 * Central end signature at very end of ZIP file.
 */

#define ZIP_CENTRAL_END_SIG		0x06054b50
#define ZIP_CENTRAL_END_LEN		22
#define ZIP_CENTRAL_END_SIG_OFFS	0
#define ZIP_CENTRAL_DISKNO_OFFS		4
#define ZIP_CENTRAL_DISKDIR_OFFS	6
#define ZIP_CENTRAL_ENTS_OFFS		8
#define ZIP_CENTRAL_TOTALENTS_OFFS	10
#define ZIP_CENTRAL_DIRSIZE_OFFS	12
#define ZIP_CENTRAL_DIRSTART_OFFS	16
#define ZIP_CENTRAL_COMMENTLEN_OFFS	20

#define ZIP_MIN_VERSION			20
#define ZIP_COMPMETH_STORED		0
#define ZIP_COMPMETH_DEFLATED		8

#define ZIP_PASSWORD_END_SIG		0x5a5a4b50

#define DEFAULT_WRITE_MAX_SIZE		(2 * 1024 * 1024)

/*
 * Macros to report errors only if an interp is present.
 */

#define ZIPFS_ERROR(interp,errstr) \
    do {								\
	if (interp) {							\
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1));	\
	}								\
    } while (0)
#define ZIPFS_POSIX_ERROR(interp,errstr) \
    do {								\
	if (interp) {							\
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(			\
		    "%s: %s", errstr, Tcl_PosixError(interp)));		\
	}								\
    } while (0)

/*
 * Macros to read and write 16 and 32 bit integers from/to ZIP archives.
 */

#define ZipReadInt(p) \
    ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24))
#define ZipReadShort(p) \
    ((p)[0] | ((p)[1] << 8))

#define ZipWriteInt(p, v) \
    do {			     \
	(p)[0] = (v) & 0xff;	     \
	(p)[1] = ((v) >> 8) & 0xff;  \
	(p)[2] = ((v) >> 16) & 0xff; \
	(p)[3] = ((v) >> 24) & 0xff; \
    } while (0)
#define ZipWriteShort(p, v) \
    do {			    \
	(p)[0] = (v) & 0xff;	    \
	(p)[1] = ((v) >> 8) & 0xff; \
    } while (0)

/*
 * Windows drive letters.
 */

#ifdef _WIN32
static const char drvletters[] =
    "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
#endif /* _WIN32 */

/*
 * Mutex to protect localtime(3) when no reentrant version available.
 */

#if !defined(_WIN32) && !defined(HAVE_LOCALTIME_R) && TCL_THREADS
TCL_DECLARE_MUTEX(localtimeMutex)
#endif /* !_WIN32 && !HAVE_LOCALTIME_R && TCL_THREADS */

/*
 * In-core description of mounted ZIP archive file.
 */

typedef struct ZipFile {
    char *name;			/* Archive name */
    size_t nameLength;		/* Length of archive name */
    char isMemBuffer;		/* When true, not a file but a memory buffer */
    Tcl_Channel chan;		/* Channel handle or NULL */
    unsigned char *data;	/* Memory mapped or malloc'ed file */
    size_t length;		/* Length of memory mapped file */
    void *ptrToFree;		/* Non-NULL if malloc'ed file */
    size_t numFiles;		/* Number of files in archive */
    size_t baseOffset;		/* Archive start */
    size_t passOffset;		/* Password start */
    size_t directoryOffset;	/* Archive directory start */
    unsigned char passBuf[264];	/* Password buffer */
    size_t numOpen;		/* Number of open files on archive */
    struct ZipEntry *entries;	/* List of files in archive */
    struct ZipEntry *topEnts;	/* List of top-level dirs in archive */
    char *mountPoint;		/* Mount point name */
    size_t mountPointLen;	/* Length of mount point name */
#ifdef _WIN32
    HANDLE mountHandle;		/* Handle used for direct file access. */
#endif /* _WIN32 */
} ZipFile;

/*
 * In-core description of file contained in mounted ZIP archive.
 */

typedef struct ZipEntry {
    char *name;			/* The full pathname of the virtual file */
    ZipFile *zipFilePtr;	/* The ZIP file holding this virtual file */
    Tcl_WideInt offset;		/* Data offset into memory mapped ZIP file */
    int numBytes;		/* Uncompressed size of the virtual file */
    int numCompressedBytes;	/* Compressed size of the virtual file */
    int compressMethod;		/* Compress method */
    int isDirectory;		/* Set to 1 if directory, or -1 if root */
    int depth;			/* Number of slashes in path. */
    int crc32;			/* CRC-32 */
    int timestamp;		/* Modification time */
    int isEncrypted;		/* True if data is encrypted */
    unsigned char *data;	/* File data if written */
    struct ZipEntry *next;	/* Next file in the same archive */
    struct ZipEntry *tnext;	/* Next top-level dir in archive */
} ZipEntry;

/*
 * File channel for file contained in mounted ZIP archive.
 */

typedef struct ZipChannel {
    ZipFile *zipFilePtr;	/* The ZIP file holding this channel */
    ZipEntry *zipEntryPtr;	/* Pointer back to virtual file */
    size_t maxWrite;		/* Maximum size for write */
    size_t numBytes;		/* Number of bytes of uncompressed data */
    size_t numRead;		/* Position of next byte to be read from the
				 * channel */
    unsigned char *ubuf;	/* Pointer to the uncompressed data */
    int iscompr;		/* True if data is compressed */
    int isDirectory;		/* Set to 1 if directory, or -1 if root */
    int isEncrypted;		/* True if data is encrypted */
    int isWriting;		/* True if open for writing */
    unsigned long keys[3];	/* Key for decryption */
} ZipChannel;

/*
 * Global variables.
 *
 * Most are kept in single ZipFS struct. When build with threading support
 * this struct is protected by the ZipFSMutex (see below).
 *
 * The "fileHash" component is the process wide global table of all known ZIP
 * archive members in all mounted ZIP archives.
 *
 * The "zipHash" components is the process wide global table of all mounted
 * ZIP archive files.
 */

static struct {
    int initialized;		/* True when initialized */
    int lock;			/* RW lock, see below */
    int waiters;		/* RW lock, see below */
    int wrmax;			/* Maximum write size of a file */
    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, 0,
};

/*
 * For password rotation.
 */

static const char pwrot[16] = {
    0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0,
    0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0
};

/*
 * Table to compute CRC32.
 */

static const z_crc_t crc32tab[256] = {
    0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419,
    0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4,
    0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07,
    0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de,
    0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856,
    0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9,
    0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4,
    0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b,
    0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3,
    0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a,
    0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599,
    0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924,
    0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190,
    0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f,
    0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e,
    0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01,
    0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed,
    0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950,
    0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3,
    0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2,
    0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a,
    0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5,
    0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010,
    0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f,
    0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17,
    0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6,
    0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615,
    0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8,
    0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344,
    0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb,
    0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a,
    0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5,
    0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1,
    0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c,
    0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef,
    0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236,
    0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe,
    0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31,
    0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c,
    0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713,
    0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b,
    0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242,
    0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1,
    0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c,
    0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278,
    0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7,
    0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66,
    0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9,
    0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605,
    0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8,
    0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b,
    0x2d02ef8d,
};

static const char *zipfs_literal_tcl_library = NULL;

/* Function prototypes */

static inline int	DescribeMounted(Tcl_Interp *interp,
			    const char *mountPoint);
static inline int	ListMountPoints(Tcl_Interp *interp);
static int		ZipfsAppHookFindTclInit(const char *archive);
static int		ZipFSPathInFilesystemProc(Tcl_Obj *pathPtr,
			    ClientData *clientDataPtr);
static Tcl_Obj *	ZipFSFilesystemPathTypeProc(Tcl_Obj *pathPtr);
static Tcl_Obj *	ZipFSFilesystemSeparatorProc(Tcl_Obj *pathPtr);
static int		ZipFSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
static int		ZipFSAccessProc(Tcl_Obj *pathPtr, int mode);
static Tcl_Channel	ZipFSOpenFileChannelProc(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int mode, int permissions);
static int		ZipFSMatchInDirectoryProc(Tcl_Interp *interp,
			    Tcl_Obj *result, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
static Tcl_Obj *	ZipFSListVolumesProc(void);
static const char *const *ZipFSFileAttrStringsProc(Tcl_Obj *pathPtr,
			    Tcl_Obj **objPtrRef);
static int		ZipFSFileAttrsGetProc(Tcl_Interp *interp, int index,
			    Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
static int		ZipFSFileAttrsSetProc(Tcl_Interp *interp, int index,
			    Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
static int		ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
static void		ZipfsSetup(void);
static int		ZipChannelClose(ClientData instanceData,
			    Tcl_Interp *interp);
static int		ZipChannelGetFile(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		ZipChannelRead(ClientData instanceData, char *buf,
			    int toRead, int *errloc);
static int		ZipChannelSeek(ClientData instanceData, long offset,
			    int mode, int *errloc);
static void		ZipChannelWatchChannel(ClientData instanceData,
			    int mask);
static int		ZipChannelWrite(ClientData instanceData,
			    const char *buf, int toWrite, int *errloc);

/*
 * Define the ZIP filesystem dispatch table.
 */

MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem;

const Tcl_Filesystem zipfsFilesystem = {
    "zipfs",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_2,
    ZipFSPathInFilesystemProc,
    NULL, /* dupInternalRepProc */
    NULL, /* freeInternalRepProc */
    NULL, /* internalToNormalizedProc */
    NULL, /* createInternalRepProc */
    NULL, /* normalizePathProc */
    ZipFSFilesystemPathTypeProc,
    ZipFSFilesystemSeparatorProc,
    ZipFSStatProc,
    ZipFSAccessProc,
    ZipFSOpenFileChannelProc,
    ZipFSMatchInDirectoryProc,
    NULL, /* utimeProc */
    NULL, /* linkProc */
    ZipFSListVolumesProc,
    ZipFSFileAttrStringsProc,
    ZipFSFileAttrsGetProc,
    ZipFSFileAttrsSetProc,
    NULL, /* createDirectoryProc */
    NULL, /* removeDirectoryProc */
    NULL, /* deleteFileProc */
    NULL, /* copyFileProc */
    NULL, /* renameFileProc */
    NULL, /* copyDirectoryProc */
    NULL, /* lstatProc */
    (Tcl_FSLoadFileProc *) ZipFSLoadFile,
    NULL, /* getCwdProc */
    NULL, /* chdirProc */
};

/*
 * The channel type/driver definition used for ZIP archive members.
 */

static Tcl_ChannelType ZipChannelType = {
    "zip",		    /* Type name. */
    TCL_CHANNEL_VERSION_5,
    ZipChannelClose,	    /* Close channel, clean instance data */
    ZipChannelRead,	    /* Handle read request */
    ZipChannelWrite,	    /* Handle write request */
    ZipChannelSeek,	    /* Move location of access point, NULL'able */
    NULL,		    /* Set options, NULL'able */
    NULL,		    /* Get options, NULL'able */
    ZipChannelWatchChannel, /* Initialize notifier */
    ZipChannelGetFile,	    /* Get OS handle from the channel */
    NULL,		    /* 2nd version of close channel, NULL'able */
    NULL,		    /* Set blocking mode for raw channel, NULL'able */
    NULL,		    /* Function to flush channel, NULL'able */
    NULL,		    /* Function to handle event, NULL'able */
    NULL,		    /* Wide seek function, NULL'able */
    NULL,		    /* Thread action function, NULL'able */
    NULL,		    /* Truncate function, NULL'able */
};

/*
 * Miscellaneous constants.
 */

#define ERROR_LENGTH	((size_t) -1)

/*
 *-------------------------------------------------------------------------
 *
 * ReadLock, WriteLock, Unlock --
 *
 *	POSIX like rwlock functions to support multiple readers and single
 *	writer on internal structs.
 *
 *	Limitations:
 *	 - a read lock cannot be promoted to a write lock
 *	 - a write lock may not be nested
 *
 *-------------------------------------------------------------------------
 */

TCL_DECLARE_MUTEX(ZipFSMutex)

#if TCL_THREADS

static Tcl_Condition ZipFSCond;

static void
ReadLock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    while (ZipFS.lock < 0) {
	ZipFS.waiters++;
	Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
	ZipFS.waiters--;
    }
    ZipFS.lock++;
    Tcl_MutexUnlock(&ZipFSMutex);
}

static void
WriteLock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    while (ZipFS.lock != 0) {
	ZipFS.waiters++;
	Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
	ZipFS.waiters--;
    }
    ZipFS.lock = -1;
    Tcl_MutexUnlock(&ZipFSMutex);
}

static void
Unlock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    if (ZipFS.lock > 0) {
	--ZipFS.lock;
    } else if (ZipFS.lock < 0) {
	ZipFS.lock = 0;
    }
    if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) {
	Tcl_ConditionNotify(&ZipFSCond);
    }
    Tcl_MutexUnlock(&ZipFSMutex);
}

#else /* !TCL_THREADS */
#define ReadLock()	do {} while (0)
#define WriteLock()	do {} while (0)
#define Unlock()	do {} while (0)
#endif /* TCL_THREADS */

/*
 *-------------------------------------------------------------------------
 *
 * DosTimeDate, ToDosTime, ToDosDate --
 *
 *	Functions to perform conversions between DOS time stamps and POSIX
 *	time_t.
 *
 *-------------------------------------------------------------------------
 */

static time_t
DosTimeDate(
    int dosDate,
    int dosTime)
{
    struct tm tm;
    time_t ret;

    memset(&tm, 0, sizeof(struct tm));
    tm.tm_year = ((dosDate & 0xfe00) >> 9) + 80;
    tm.tm_mon = ((dosDate & 0x1e0) >> 5) - 1;
    tm.tm_mday = dosDate & 0x1f;
    tm.tm_hour = (dosTime & 0xf800) >> 11;
    tm.tm_min = (dosTime & 0x7e) >> 5;
    tm.tm_sec = (dosTime & 0x1f) << 1;
    ret = mktime(&tm);
    if (ret == (time_t) -1) {
	/* fallback to 1980-01-01T00:00:00+00:00 (DOS epoch) */
	ret = (time_t) 315532800;
    }
    return ret;
}

static int
ToDosTime(
    time_t when)
{
    struct tm *tmp, tm;

#if !TCL_THREADS || defined(_WIN32)
    /* Not threaded, or on Win32 which uses thread local storage */
    tmp = localtime(&when);
    tm = *tmp;
#elif defined(HAVE_LOCALTIME_R)
    /* Threaded, have reentrant API */
    tmp = &tm;
    localtime_r(&when, tmp);
#else /* TCL_THREADS && !_WIN32 && !HAVE_LOCALTIME_R */
    /* Only using a mutex is safe. */
    Tcl_MutexLock(&localtimeMutex);
    tmp = localtime(&when);
    tm = *tmp;
    Tcl_MutexUnlock(&localtimeMutex);
#endif
    return (tm.tm_hour << 11) | (tm.tm_min << 5) | (tm.tm_sec >> 1);
}

static int
ToDosDate(
    time_t when)
{
    struct tm *tmp, tm;

#if !TCL_THREADS || defined(_WIN32)
    /* Not threaded, or on Win32 which uses thread local storage */
    tmp = localtime(&when);
    tm = *tmp;
#elif /* TCL_THREADS && !_WIN32 && */ defined(HAVE_LOCALTIME_R)
    /* Threaded, have reentrant API */
    tmp = &tm;
    localtime_r(&when, tmp);
#else /* TCL_THREADS && !_WIN32 && !HAVE_LOCALTIME_R */
    /* Only using a mutex is safe. */
    Tcl_MutexLock(&localtimeMutex);
    tmp = localtime(&when);
    tm = *tmp;
    Tcl_MutexUnlock(&localtimeMutex);
#endif
    return ((tm.tm_year - 80) << 9) | ((tm.tm_mon + 1) << 5) | tm.tm_mday;
}

/*
 *-------------------------------------------------------------------------
 *
 * CountSlashes --
 *
 *	This function counts the number of slashes in a pathname string.
 *
 * Results:
 *	Number of slashes found in string.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
CountSlashes(
    const char *string)
{
    int count = 0;
    const char *p = string;

    while (*p != '\0') {
	if (*p == '/') {
	    count++;
	}
	p++;
    }
    return count;
}

/*
 *-------------------------------------------------------------------------
 *
 * CanonicalPath --
 *
 *	This function computes the canonical path from a directory and file
 *	name components into the specified Tcl_DString.
 *
 * Results:
 *	Returns the pointer to the canonical path contained in the specified
 *	Tcl_DString.
 *
 * Side effects:
 *	Modifies the specified Tcl_DString.
 *
 *-------------------------------------------------------------------------
 */

static char *
CanonicalPath(
    const char *root,
    const char *tail,
    Tcl_DString *dsPtr,
    int inZipfs)
{
    char *path;
    int i, j, c, isUNC = 0, isVfs = 0, n = 0;
    int haveZipfsPath = 1;

#ifdef _WIN32
    if (tail[0] != '\0' && strchr(drvletters, tail[0]) && tail[1] == ':') {
	tail += 2;
	haveZipfsPath = 0;
    }
    /* UNC style path */
    if (tail[0] == '\\') {
	root = "";
	++tail;
	haveZipfsPath = 0;
    }
    if (tail[0] == '\\') {
	root = "/";
	++tail;
	haveZipfsPath = 0;
    }
#endif /* _WIN32 */

    if (haveZipfsPath) {
	/* UNC style path */
	if (root && strncmp(root, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) == 0) {
	    isVfs = 1;
	} else if (tail &&
		strncmp(tail, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) == 0) {
	    isVfs = 2;
	}
	if (isVfs != 1 && (root[0] == '/') && (root[1] == '/')) {
	    isUNC = 1;
	}
    }

    if (isVfs != 2) {
	if (tail[0] == '/') {
	    if (isVfs != 1) {
		root = "";
	    }
	    ++tail;
	    isUNC = 0;
	}
	if (tail[0] == '/') {
	    if (isVfs != 1) {
		root = "/";
	    }
	    ++tail;
	    isUNC = 1;
	}
    }
    i = strlen(root);
    j = strlen(tail);

    switch (isVfs) {
    case 1:
	if (i > ZIPFS_VOLUME_LEN) {
	    Tcl_DStringSetLength(dsPtr, i + j + 1);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    path[i++] = '/';
	    memcpy(path + i, tail, j);
	} else {
	    Tcl_DStringSetLength(dsPtr, i + j);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    memcpy(path + i, tail, j);
	}
	break;
    case 2:
	Tcl_DStringSetLength(dsPtr, j);
	path = Tcl_DStringValue(dsPtr);
	memcpy(path, tail, j);
	break;
    default:
	if (inZipfs) {
	    Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN);
	    memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j);
	} else {
	    Tcl_DStringSetLength(dsPtr, i + j + 1);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    path[i++] = '/';
	    memcpy(path + i, tail, j);
	}
	break;
    }

#ifdef _WIN32
    for (i = 0; path[i] != '\0'; i++) {
	if (path[i] == '\\') {
	    path[i] = '/';
	}
    }
#endif /* _WIN32 */

    if (inZipfs) {
	n = ZIPFS_VOLUME_LEN;
    } else {
	n = 0;
    }

    for (i = j = n; (c = path[i]) != '\0'; i++) {
	if (c == '/') {
	    int c2 = path[i + 1];

	    if (c2 == '\0' || c2 == '/') {
		continue;
	    }
	    if (c2 == '.') {
		int c3 = path[i + 2];

		if ((c3 == '/') || (c3 == '\0')) {
		    i++;
		    continue;
		}
		if ((c3 == '.')
			&& ((path[i + 3] == '/') || (path[i + 3] == '\0'))) {
		    i += 2;
		    while ((j > 0) && (path[j - 1] != '/')) {
			j--;
		    }
		    if (j > isUNC) {
			--j;
			while ((j > 1 + isUNC) && (path[j - 2] == '/')) {
			    j--;
			}
		    }
		    continue;
		}
	    }
	}
	path[j++] = c;
    }
    if (j == 0) {
	path[j++] = '/';
    }
    path[j] = 0;
    Tcl_DStringSetLength(dsPtr, j);
    return Tcl_DStringValue(dsPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLookup --
 *
 *	This function returns the ZIP entry struct corresponding to the ZIP
 *	archive member of the given file name. Caller must hold the right
 *	lock.
 *
 * Results:
 *	Returns the pointer to ZIP entry struct or NULL if the the given file
 *	name could not be found in the global list of ZIP archive members.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static ZipEntry *
ZipFSLookup(
    char *filename)
{
    Tcl_HashEntry *hPtr;
    ZipEntry *z = NULL;

    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename);
    if (hPtr) {
	z = Tcl_GetHashValue(hPtr);
    }
    return z;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLookupMount --
 *
 *	This function returns an indication if the given file name corresponds
 *	to a mounted ZIP archive file.
 *
 * Results:
 *	Returns true, if the given file name is a mounted ZIP archive file.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#ifdef NEVER_USED
static int
ZipFSLookupMount(
    char *filename)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	   hPtr = Tcl_NextHashEntry(&search)) {
	ZipFile *zf = Tcl_GetHashValue(hPtr);

	if (strcmp(zf->mountPoint, filename) == 0) {
	    return 1;
	}
    }
    return 0;
}
#endif /* NEVER_USED */

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSCloseArchive --
 *
 *	This function closes a mounted ZIP archive file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A memory mapped ZIP archive is unmapped, allocated memory is released.
 *	The ZipFile pointer is *NOT* deallocated by this function.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipFSCloseArchive(
    Tcl_Interp *interp,		/* Current interpreter. */
    ZipFile *zf)
{
    if (zf->nameLength) {
	ckfree(zf->name);
    }
    if (zf->isMemBuffer) {
	/* Pointer to memory */
	if (zf->ptrToFree) {
	    ckfree(zf->ptrToFree);
	    zf->ptrToFree = NULL;
	}
	zf->data = NULL;
	return;
    }

#ifdef _WIN32
    if (zf->data && !zf->ptrToFree) {
	UnmapViewOfFile(zf->data);
	zf->data = NULL;
    }
    if (zf->mountHandle != INVALID_HANDLE_VALUE) {
	CloseHandle(zf->mountHandle);
    }
#else /* !_WIN32 */
    if ((zf->data != MAP_FAILED) && !zf->ptrToFree) {
	munmap(zf->data, zf->length);
	zf->data = MAP_FAILED;
    }
#endif /* _WIN32 */

    if (zf->ptrToFree) {
	ckfree(zf->ptrToFree);
	zf->ptrToFree = NULL;
    }
    if (zf->chan) {
	Tcl_Close(interp, zf->chan);
	zf->chan = NULL;
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFindTOC --
 *
 *	This function takes a memory mapped zip file and indexes the contents.
 *	When "needZip" is zero an embedded ZIP archive in an executable file
 *	is accepted.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL.
 *
 * Side effects:
 *	The given ZipFile struct is filled with information about the ZIP
 *	archive file.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSFindTOC(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    int needZip,
    ZipFile *zf)
{
    size_t i;
    unsigned char *p, *q;

    p = zf->data + zf->length - ZIP_CENTRAL_END_LEN;
    while (p >= zf->data) {
	if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) {
	    if (ZipReadInt(p) == ZIP_CENTRAL_END_SIG) {
		break;
	    }
	    p -= ZIP_SIG_LEN;
	} else {
	    --p;
	}
    }
    if (p < zf->data) {
	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "wrong end signature");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "END_SIG", NULL);
	}
	goto error;
    }
    zf->numFiles = ZipReadShort(p + ZIP_CENTRAL_ENTS_OFFS);
    if (zf->numFiles == 0) {
	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "empty archive");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
	}
	goto error;
    }
    q = zf->data + ZipReadInt(p + ZIP_CENTRAL_DIRSTART_OFFS);
    p -= ZipReadInt(p + ZIP_CENTRAL_DIRSIZE_OFFS);
    if ((p < zf->data) || (p > zf->data + zf->length)
	    || (q < zf->data) || (q > zf->data + zf->length)) {
	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "archive directory not found");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_DIR", NULL);
	}
	goto error;
    }
    zf->baseOffset = zf->passOffset = p - q;
    zf->directoryOffset = p - zf->data;
    q = p;
    for (i = 0; i < zf->numFiles; i++) {
	int pathlen, comlen, extra;

	if (q + ZIP_CENTRAL_HEADER_LEN > zf->data + zf->length) {
	    ZIPFS_ERROR(interp, "wrong header length");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_LEN", NULL);
	    }
	    goto error;
	}
	if (ZipReadInt(q) != ZIP_CENTRAL_HEADER_SIG) {
	    ZIPFS_ERROR(interp, "wrong header signature");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_SIG", NULL);
	    }
	    goto error;
	}
	pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
	q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
    }
    q = zf->data + zf->baseOffset;
    if ((zf->baseOffset >= 6) && (ZipReadInt(q - 4) == ZIP_PASSWORD_END_SIG)) {
	i = q[-5];
	if (q - 5 - i > zf->data) {
	    zf->passBuf[0] = i;
	    memcpy(zf->passBuf + 1, q - 5 - i, i);
	    zf->passOffset -= i ? (5 + i) : 0;
	}
    }
    return TCL_OK;

  error:
    ZipFSCloseArchive(interp, zf);
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSOpenArchive --
 *
 *	This function opens a ZIP archive file for reading. An attempt is made
 *	to memory map that file. Otherwise it is read into an allocated memory
 *	buffer. The ZIP archive header is verified and must be valid for the
 *	function to succeed. When "needZip" is zero an embedded ZIP archive in
 *	an executable file is accepted.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL.
 *
 * Side effects:
 *	ZIP archive is memory mapped or read into allocated memory, the given
 *	ZipFile struct is filled with information about the ZIP archive file.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSOpenArchive(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *zipname,	/* Path to ZIP file to open. */
    int needZip,
    ZipFile *zf)
{
    size_t i;
    ClientData handle;

    zf->nameLength = 0;
    zf->isMemBuffer = 0;
#ifdef _WIN32
    zf->data = NULL;
    zf->mountHandle = INVALID_HANDLE_VALUE;
#else /* !_WIN32 */
    zf->data = MAP_FAILED;
#endif /* _WIN32 */
    zf->length = 0;
    zf->numFiles = 0;
    zf->baseOffset = zf->passOffset = 0;
    zf->ptrToFree = NULL;
    zf->passBuf[0] = 0;
    zf->chan = Tcl_OpenFileChannel(interp, zipname, "rb", 0);
    if (!zf->chan) {
	return TCL_ERROR;
    }
    if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) {
	zf->length = Tcl_Seek(zf->chan, 0, SEEK_END);
	if (zf->length == ERROR_LENGTH) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	if ((zf->length - ZIP_CENTRAL_END_LEN)
		> (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
	    ZIPFS_ERROR(interp, "illegal file size");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
	    }
	    goto error;
	}
	if (Tcl_Seek(zf->chan, 0, SEEK_SET) == -1) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	zf->ptrToFree = zf->data = attemptckalloc(zf->length);
	if (!zf->ptrToFree) {
	    ZIPFS_ERROR(interp, "out of memory");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    goto error;
	}
	i = Tcl_Read(zf->chan, (char *) zf->data, zf->length);
	if (i != zf->length) {
	    ZIPFS_POSIX_ERROR(interp, "file read error");
	    goto error;
	}
	Tcl_Close(interp, zf->chan);
	zf->chan = NULL;
    } else {
#ifdef _WIN32
	int readSuccessful;
#   ifdef _WIN64
	i = GetFileSizeEx((HANDLE) handle, (PLARGE_INTEGER) &zf->length);
	readSuccessful = (i != 0);
#   else /* !_WIN64 */
	zf->length = GetFileSize((HANDLE) handle, 0);
	readSuccessful = (zf->length != (size_t) INVALID_FILE_SIZE);
#   endif /* _WIN64 */
	if (!readSuccessful || (zf->length < ZIP_CENTRAL_END_LEN)) {
	    ZIPFS_POSIX_ERROR(interp, "invalid file size");
	    goto error;
	}
	zf->mountHandle = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY,
		0, zf->length, 0);
	if (zf->mountHandle == INVALID_HANDLE_VALUE) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
	zf->data = MapViewOfFile(zf->mountHandle, FILE_MAP_READ, 0, 0,
		zf->length);
	if (!zf->data) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
#else /* !_WIN32 */
	zf->length = lseek(PTR2INT(handle), 0, SEEK_END);
	if (zf->length == ERROR_LENGTH || zf->length < ZIP_CENTRAL_END_LEN) {
	    ZIPFS_POSIX_ERROR(interp, "invalid file size");
	    goto error;
	}
	lseek(PTR2INT(handle), 0, SEEK_SET);
	zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ,
		MAP_FILE | MAP_PRIVATE, PTR2INT(handle), 0);
	if (zf->data == MAP_FAILED) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
#endif /* _WIN32 */
    }
    return ZipFSFindTOC(interp, needZip, zf);

  error:
    ZipFSCloseArchive(interp, zf);
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSRootNode --
 *
 *	This function generates the root node for a ZIPFS filesystem.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL.
 *
 * Side effects:
 *	...
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSCatalogFilesystem(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    ZipFile *zf0,
    const char *mountPoint,	/* Mount point path. */
    const char *passwd,		/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
    const char *zipname)	/* Path to ZIP file to build a catalog of. */
{
    int pwlen, isNew;
    size_t i;
    ZipFile *zf;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_DString ds, dsm, fpBuf;
    unsigned char *q;

    /*
     * Basic verification of the password for sanity.
     */

    pwlen = 0;
    if (passwd) {
	pwlen = strlen(passwd);
	if ((pwlen > 255) || strchr(passwd, 0xff)) {
	    if (interp) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("illegal password", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    }
	    return TCL_ERROR;
	}
    }

    WriteLock();

    /*
     * Mount point sometimes is a relative or otherwise denormalized path.
     * But an absolute name is needed as mount point here.
     */

    Tcl_DStringInit(&ds);
    Tcl_DStringInit(&dsm);
    if (strcmp(mountPoint, "/") == 0) {
	mountPoint = "";
    } else {
	mountPoint = CanonicalPath("", mountPoint, &dsm, 1);
    }
    hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mountPoint, &isNew);
    if (!isNew) {
	if (interp) {
	    zf = Tcl_GetHashValue(hPtr);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s is already mounted on %s", zf->name, mountPoint));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "MOUNTED", NULL);
	}
	Unlock();
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	Unlock();
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    Unlock();

    *zf = *zf0;
    zf->mountPoint = Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
    zf->mountPointLen = strlen(zf->mountPoint);
    zf->nameLength = strlen(zipname);
    zf->name = ckalloc(zf->nameLength + 1);
    memcpy(zf->name, zipname, zf->nameLength + 1);
    zf->entries = NULL;
    zf->topEnts = NULL;
    zf->numOpen = 0;
    Tcl_SetHashValue(hPtr, zf);
    if ((zf->passBuf[0] == 0) && pwlen) {
	int k = 0;

	zf->passBuf[k++] = pwlen;
	for (i = pwlen; i-- > 0 ;) {
	    zf->passBuf[k++] = (passwd[i] & 0x0f)
		    | pwrot[(passwd[i] >> 4) & 0x0f];
	}
	zf->passBuf[k] = '\0';
    }
    if (mountPoint[0] != '\0') {
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mountPoint, &isNew);
	if (isNew) {
	    z = ckalloc(sizeof(ZipEntry));
	    Tcl_SetHashValue(hPtr, z);

	    z->tnext = NULL;
	    z->depth = CountSlashes(mountPoint);
	    z->zipFilePtr = zf;
	    z->isDirectory = (zf->baseOffset == 0) ? 1 : -1; /* root marker */
	    z->isEncrypted = 0;
	    z->offset = zf->baseOffset;
	    z->crc32 = 0;
	    z->timestamp = 0;
	    z->numBytes = z->numCompressedBytes = 0;
	    z->compressMethod = ZIP_COMPMETH_STORED;
	    z->data = NULL;
	    z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->next = zf->entries;
	    zf->entries = z;
	}
    }
    q = zf->data + zf->directoryOffset;
    Tcl_DStringInit(&fpBuf);
    for (i = 0; i < zf->numFiles; i++) {
	int extra, isdir = 0, dosTime, dosDate, nbcompr;
	size_t offs, pathlen, comlen;
	unsigned char *lq, *gq = NULL;
	char *fullpath, *path;

	pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
	Tcl_DStringSetLength(&ds, 0);
	Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen);
	path = Tcl_DStringValue(&ds);
	if ((pathlen > 0) && (path[pathlen - 1] == '/')) {
	    Tcl_DStringSetLength(&ds, pathlen - 1);
	    path = Tcl_DStringValue(&ds);
	    isdir = 1;
	}
	if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) {
	    goto nextent;
	}
	lq = zf->data + zf->baseOffset
		+ ZipReadInt(q + ZIP_CENTRAL_LOCALHDR_OFFS);
	if ((lq < zf->data) || (lq > zf->data + zf->length)) {
	    goto nextent;
	}
	nbcompr = ZipReadInt(lq + ZIP_LOCAL_COMPLEN_OFFS);
	if (!isdir && (nbcompr == 0)
		&& (ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0)
		&& (ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) {
	    gq = q;
	    nbcompr = ZipReadInt(gq + ZIP_CENTRAL_COMPLEN_OFFS);
	}
	offs = (lq - zf->data)
		+ ZIP_LOCAL_HEADER_LEN
		+ ZipReadShort(lq + ZIP_LOCAL_PATHLEN_OFFS)
		+ ZipReadShort(lq + ZIP_LOCAL_EXTRALEN_OFFS);
	if (offs + nbcompr > zf->length) {
	    goto nextent;
	}
	if (!isdir && (mountPoint[0] == '\0') && !CountSlashes(path)) {
#ifdef ANDROID
	    /*
	     * When mounting the ZIP archive on the root directory try to
	     * remap top level regular files of the archive to
	     * /assets/.root/... since this directory should not be in a valid
	     * APK due to the leading dot in the file name component. This
	     * trick should make the files AndroidManifest.xml,
	     * resources.arsc, and classes.dex visible to Tcl.
	     */
	    Tcl_DString ds2;

	    Tcl_DStringInit(&ds2);
	    Tcl_DStringAppend(&ds2, "assets/.root/", -1);
	    Tcl_DStringAppend(&ds2, path, -1);
	    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2));
	    if (hPtr) {
		/* should not happen but skip it anyway */
		Tcl_DStringFree(&ds2);
		goto nextent;
	    }
	    Tcl_DStringSetLength(&ds, 0);
	    Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2),
		    Tcl_DStringLength(&ds2));
	    path = Tcl_DStringValue(&ds);
	    Tcl_DStringFree(&ds2);
#else /* !ANDROID */
	    /*
	     * Regular files skipped when mounting on root.
	     */
	    goto nextent;
#endif /* ANDROID */
	}
	Tcl_DStringSetLength(&fpBuf, 0);
	fullpath = CanonicalPath(mountPoint, path, &fpBuf, 1);
	z = ckalloc(sizeof(ZipEntry));
	z->name = NULL;
	z->tnext = NULL;
	z->depth = CountSlashes(fullpath);
	z->zipFilePtr = zf;
	z->isDirectory = isdir;
	z->isEncrypted = (ZipReadShort(lq + ZIP_LOCAL_FLAGS_OFFS) & 1)
		&& (nbcompr > 12);
	z->offset = offs;
	if (gq) {
	    z->crc32 = ZipReadInt(gq + ZIP_CENTRAL_CRC32_OFFS);
	    dosDate = ZipReadShort(gq + ZIP_CENTRAL_MDATE_OFFS);
	    dosTime = ZipReadShort(gq + ZIP_CENTRAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->numBytes = ZipReadInt(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(gq + ZIP_CENTRAL_COMPMETH_OFFS);
	} else {
	    z->crc32 = ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS);
	    dosDate = ZipReadShort(lq + ZIP_LOCAL_MDATE_OFFS);
	    dosTime = ZipReadShort(lq + ZIP_LOCAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->numBytes = ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(lq + ZIP_LOCAL_COMPMETH_OFFS);
	}
	z->numCompressedBytes = nbcompr;
	z->data = NULL;
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew);
	if (!isNew) {
	    /* should not happen but skip it anyway */
	    ckfree(z);
	} else {
	    Tcl_SetHashValue(hPtr, z);
	    z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->next = zf->entries;
	    zf->entries = z;
	    if (isdir && (mountPoint[0] == '\0') && (z->depth == 1)) {
		z->tnext = zf->topEnts;
		zf->topEnts = z;
	    }
	    if (!z->isDirectory && (z->depth > 1)) {
		char *dir, *end;
		ZipEntry *zd;

		Tcl_DStringSetLength(&ds, strlen(z->name) + 8);
		Tcl_DStringSetLength(&ds, 0);
		Tcl_DStringAppend(&ds, z->name, -1);
		dir = Tcl_DStringValue(&ds);
		for (end = strrchr(dir, '/'); end && (end != dir);
			end = strrchr(dir, '/')) {
		    Tcl_DStringSetLength(&ds, end - dir);
		    hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew);
		    if (!isNew) {
			break;
		    }
		    zd = ckalloc(sizeof(ZipEntry));
		    zd->name = NULL;
		    zd->tnext = NULL;
		    zd->depth = CountSlashes(dir);
		    zd->zipFilePtr = zf;
		    zd->isDirectory = 1;
		    zd->isEncrypted = 0;
		    zd->offset = z->offset;
		    zd->crc32 = 0;
		    zd->timestamp = z->timestamp;
		    zd->numBytes = zd->numCompressedBytes = 0;
		    zd->compressMethod = ZIP_COMPMETH_STORED;
		    zd->data = NULL;
		    Tcl_SetHashValue(hPtr, zd);
		    zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
		    zd->next = zf->entries;
		    zf->entries = zd;
		    if ((mountPoint[0] == '\0') && (zd->depth == 1)) {
			zd->tnext = zf->topEnts;
			zf->topEnts = zd;
		    }
		}
	    }
	}
    nextent:
	q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
    }
    Tcl_DStringFree(&fpBuf);
    Tcl_DStringFree(&ds);
    Tcl_FSMountsChanged(NULL);
    Unlock();
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipfsSetup --
 *
 *	Common initialisation code. ZipFS.initialized must *not* be set prior
 *	to the call.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipfsSetup(void)
{
#if TCL_THREADS
    static const Tcl_Time t = { 0, 0 };

    /*
     * Inflate condition variable.
     */

    Tcl_MutexLock(&ZipFSMutex);
    Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t);
    Tcl_MutexUnlock(&ZipFSMutex);
#endif /* TCL_THREADS */

    Tcl_FSRegister(NULL, &zipfsFilesystem);
    Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS);
    Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
    ZipFS.idCount = 1;
    ZipFS.wrmax = DEFAULT_WRITE_MAX_SIZE;
    ZipFS.initialized = 1;
}

/*
 *-------------------------------------------------------------------------
 *
 * ListMountPoints --
 *
 *	This procedure lists the mount points and what's mounted there, or
 *	reports whether there are any mounts (if there's no interpreter). The
 *	read lock must be held by the caller.
 *
 * Results:
 *	A standard Tcl result. TCL_OK (or TCL_BREAK if no mounts and no
 *	interpreter).
 *
 * Side effects:
 *	Interpreter result may be updated.
 *
 *-------------------------------------------------------------------------
 */

static inline int
ListMountPoints(
    Tcl_Interp *interp)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    ZipFile *zf;

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	if (!interp) {
	    return TCL_OK;
	}
	zf = Tcl_GetHashValue(hPtr);
	Tcl_AppendElement(interp, zf->mountPoint);
	Tcl_AppendElement(interp, zf->name);
    }
    return (interp ? TCL_OK : TCL_BREAK);
}

/*
 *-------------------------------------------------------------------------
 *
 * DescribeMounted --
 *
 *	This procedure describes what is mounted at the given the mount point.
 *	The interpreter result is not updated if there is nothing mounted at
 *	the given point. The read lock must be held by the caller.
 *
 * Results:
 *	A standard Tcl result. TCL_OK (or TCL_BREAK if nothing mounted there
 *	and no interpreter).
 *
 * Side effects:
 *	Interpreter result may be updated.
 *
 *-------------------------------------------------------------------------
 */

static inline int
DescribeMounted(
    Tcl_Interp *interp,
    const char *mountPoint)
{
    Tcl_HashEntry *hPtr;
    ZipFile *zf;

    if (interp) {
	hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
	if (hPtr) {
	    zf = Tcl_GetHashValue(hPtr);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, -1));
	    return TCL_OK;
	}
    }
    return (interp ? TCL_OK : TCL_BREAK);
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Mount --
 *
 *	This procedure is invoked to mount a given ZIP archive file on a given
 *	mountpoint with optional ZIP password.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is read, analyzed and mounted, resources are
 *	allocated.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Mount(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint,	/* Mount point path. */
    const char *zipname,	/* Path to ZIP file to mount. */
    const char *passwd)		/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
{
    ZipFile *zf;

    ReadLock();
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }

    /*
     * No mount point, so list all mount points and what is mounted there.
     */

    if (!mountPoint) {
	int ret = ListMountPoints(interp);
	Unlock();
	return ret;
    }

    /*
     * Mount point but no file, so describe what is mounted at that mount
     * point.
     */

    if (!zipname) {
	DescribeMounted(interp, mountPoint);
	Unlock();
	return TCL_OK;
    }
    Unlock();

    /*
     * Have both a mount point and a file (name) to mount there.
     */

    if (passwd) {
	if ((strlen(passwd) > 255) || strchr(passwd, 0xff)) {
	    if (interp) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("illegal password", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    }
	    return TCL_ERROR;
	}
    }
    zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	return TCL_ERROR;
    }
    if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) {
	return TCL_ERROR;
    }
    return ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname);
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_MountBuffer --
 *
 *	This procedure is invoked to mount a given ZIP archive file on a given
 *	mountpoint with optional ZIP password.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is read, analyzed and mounted, resources are
 *	allocated.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_MountBuffer(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint,	/* Mount point path. */
    unsigned char *data,
    size_t datalen,
    int copy)
{
    ZipFile *zf;

    ReadLock();
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }

    /*
     * No mount point, so list all mount points and what is mounted there.
     */

    if (!mountPoint) {
	int ret = ListMountPoints(interp);
	Unlock();
	return ret;
    }

    /*
     * Mount point but no data, so describe what is mounted at that mount
     * point.
     */

    if (!data) {
	DescribeMounted(interp, mountPoint);
	Unlock();
	return TCL_OK;
    }
    Unlock();

    /*
     * Have both a mount point and data to mount there.
     */

    zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	return TCL_ERROR;
    }
    zf->isMemBuffer = 1;
    zf->length = datalen;
    if (copy) {
	zf->data = attemptckalloc(datalen);
	if (!zf->data) {
	    if (interp) {
		Tcl_AppendResult(interp, "out of memory", (char *) NULL);
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    return TCL_ERROR;
	}
	memcpy(zf->data, data, datalen);
	zf->ptrToFree = zf->data;
    } else {
	zf->data = data;
	zf->ptrToFree = NULL;
    }
    if (ZipFSFindTOC(interp, 0, zf) != TCL_OK) {
	return TCL_ERROR;
    }
    return ZipFSCatalogFilesystem(interp, zf, mountPoint, NULL,
	    "Memory Buffer");
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Unmount --
 *
 *	This procedure is invoked to unmount a given ZIP archive.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A mounted ZIP archive file is unmounted, resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Unmount(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint)	/* Mount point path. */
{
    ZipFile *zf;
    ZipEntry *z, *znext;
    Tcl_HashEntry *hPtr;
    Tcl_DString dsm;
    int ret = TCL_OK, unmounted = 0;

    WriteLock();
    if (!ZipFS.initialized) {
	goto done;
    }

    /*
     * Mount point sometimes is a relative or otherwise denormalized path.
     * But an absolute name is needed as mount point here.
     */

    Tcl_DStringInit(&dsm);
    mountPoint = CanonicalPath("", mountPoint, &dsm, 1);

    hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
    /* don't report no-such-mount as an error */
    if (!hPtr) {
	goto done;
    }

    zf = Tcl_GetHashValue(hPtr);
    if (zf->numOpen > 0) {
	ZIPFS_ERROR(interp, "filesystem is busy");
	ret = TCL_ERROR;
	goto done;
    }
    Tcl_DeleteHashEntry(hPtr);
    for (z = zf->entries; z; z = znext) {
	znext = z->next;
	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name);
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
	if (z->data) {
	    ckfree(z->data);
	}
	ckfree(z);
    }
    ZipFSCloseArchive(interp, zf);
    ckfree(zf);
    unmounted = 1;
  done:
    Unlock();
    if (unmounted) {
	Tcl_FSMountsChanged(NULL);
    }
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMountObjCmd --
 *
 *	This procedure is invoked to process the [zipfs mount] command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is mounted, resources are allocated.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMountObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		 "?mountpoint? ?zipfile? ?password?");
	return TCL_ERROR;
    }

    return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL,
	    (objc > 2) ? Tcl_GetString(objv[2]) : NULL,
	    (objc > 3) ? Tcl_GetString(objv[3]) : NULL);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMountBufferObjCmd --
 *
 *	This procedure is invoked to process the [zipfs mount_data] command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is mounted, resources are allocated.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMountBufferObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *mountPoint;	/* Mount point path. */
    unsigned char *data;
    int length;

    if (objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?");
	return TCL_ERROR;
    }
    if (objc < 2) {
	int ret;

	ReadLock();
	ret = ListMountPoints(interp);
	Unlock();
	return ret;
    }

    mountPoint = Tcl_GetString(objv[1]);
    if (objc < 3) {
	ReadLock();
	DescribeMounted(interp, mountPoint);
	Unlock();
	return TCL_OK;
    }

    data = Tcl_GetByteArrayFromObj(objv[2], &length);
    return TclZipfs_MountBuffer(interp, mountPoint, data, length, 1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSRootObjCmd --
 *
 *	This procedure is invoked to process the [zipfs root] command. It
 *	returns the root that all zipfs file systems are mounted under.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSRootObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_SetObjResult(interp, Tcl_NewStringObj(ZIPFS_VOLUME, -1));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSUnmountObjCmd --
 *
 *	This procedure is invoked to process the [zipfs unmount] command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A mounted ZIP archive file is unmounted, resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSUnmountObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "zipfile");
	return TCL_ERROR;
    }
    return TclZipfs_Unmount(interp, Tcl_GetString(objv[1]));
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkKeyObjCmd --
 *
 *	This procedure is invoked to process the [zipfs mkkey] command.  It
 *	produces a rotated password to be embedded into an image file.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkKeyObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int len, i = 0;
    char *pw, passBuf[264];

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "password");
	return TCL_ERROR;
    }
    pw = Tcl_GetString(objv[1]);
    len = strlen(pw);
    if (len == 0) {
	return TCL_OK;
    }
    if ((len > 255) || strchr(pw, 0xff)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1));
	return TCL_ERROR;
    }
    while (len > 0) {
	int ch = pw[len - 1];

	passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	i++;
	len--;
    }
    passBuf[i] = i;
    ++i;
    passBuf[i++] = (char) ZIP_PASSWORD_END_SIG;
    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
    passBuf[i] = '\0';
    Tcl_AppendResult(interp, passBuf, (char *) NULL);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipAddFile --
 *
 *	This procedure is used by ZipFSMkZipOrImgCmd() to add a single file to
 *	the output ZIP archive file being written. A ZipEntry struct about the
 *	input file is added to the given fileHash table for later creation of
 *	the central ZIP directory.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Input file is read and (compressed and) written to the output ZIP
 *	archive file.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipAddFile(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *path,
    const char *name,
    Tcl_Channel out,
    const char *passwd,		/* Password for encoding the file, or NULL if
				 * the file is to be unprotected. */
    char *buf,
    int bufsize,
    Tcl_HashTable *fileHash)
{
    Tcl_Channel in;
    Tcl_HashEntry *hPtr;
    ZipEntry *z;
    z_stream stream;
    const char *zpath;
    int crc, flush, zpathlen;
    size_t nbyte, nbytecompr, len, olen, align = 0;
    Tcl_WideInt pos[3];
    int mtime = 0, isNew, compMeth;
    unsigned long keys[3], keys0[3];
    char obuf[4096];

    /*
     * Trim leading '/' characters. If this results in an empty string, we've
     * nothing to do.
     */

    zpath = name;
    while (zpath && zpath[0] == '/') {
	zpath++;
    }
    if (!zpath || (zpath[0] == '\0')) {
	return TCL_OK;
    }

    zpathlen = strlen(zpath);
    if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"path too long for \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "PATH_LEN", NULL);
	return TCL_ERROR;
    }
    in = Tcl_OpenFileChannel(interp, path, "rb", 0);
    if (!in) {
#ifdef _WIN32
	/* hopefully a directory */
	if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) {
	    Tcl_Close(interp, in);
	    return TCL_OK;
	}
#endif /* _WIN32 */
	Tcl_Close(interp, in);
	return TCL_ERROR;
    } else {
	Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1);
	Tcl_StatBuf statBuf;

	Tcl_IncrRefCount(pathObj);
	if (Tcl_FSStat(pathObj, &statBuf) != -1) {
	    mtime = statBuf.st_mtime;
	}
	Tcl_DecrRefCount(pathObj);
    }
    Tcl_ResetResult(interp);
    crc = 0;
    nbyte = nbytecompr = 0;
    while (1) {
	len = Tcl_Read(in, buf, bufsize);
	if (len == ERROR_LENGTH) {
	    if (nbyte == 0 && errno == EISDIR) {
		Tcl_Close(interp, in);
		return TCL_OK;
	    }
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s",
		    path, Tcl_PosixError(interp)));
	    Tcl_Close(interp, in);
	    return TCL_ERROR;
	}
	if (len == 0) {
	    break;
	}
	crc = crc32(crc, (unsigned char *) buf, len);
	nbyte += len;
    }
    if (Tcl_Seek(in, 0, SEEK_SET) == -1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s",
		path, Tcl_PosixError(interp)));
	Tcl_Close(interp, in);
	return TCL_ERROR;
    }
    pos[0] = Tcl_Tell(out);
    memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
    memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen);
    len = zpathlen + ZIP_LOCAL_HEADER_LEN;
    if (Tcl_Write(out, buf, len) != len) {
    wrerr:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error on %s: %s", path, Tcl_PosixError(interp)));
	Tcl_Close(interp, in);
	return TCL_ERROR;
    }
    if ((len + pos[0]) & 3) {
	unsigned char abuf[8];

	/*
	 * Align payload to next 4-byte boundary using a dummy extra entry
	 * similar to the zipalign tool from Android's SDK.
	 */

	align = 4 + ((len + pos[0]) & 3);
	ZipWriteShort(abuf, 0xffff);
	ZipWriteShort(abuf + 2, align - 4);
	ZipWriteInt(abuf + 4, 0x03020100);
	if (Tcl_Write(out, (const char *) abuf, align) != align) {
	    goto wrerr;
	}
    }
    if (passwd) {
	int i, ch, tmp;
	unsigned char kvbuf[24];
	Tcl_Obj *ret;

	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < 12 - 2; i++) {
	    double r;

	    if (Tcl_EvalEx(interp, "::tcl::mathfunc::rand", -1, 0) != TCL_OK) {
		Tcl_Obj *eiPtr = Tcl_ObjPrintf(
			"\n    (evaluating PRNG step %d for password encoding)",
			i);

		Tcl_AppendObjToErrorInfo(interp, eiPtr);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    ret = Tcl_GetObjResult(interp);
	    if (Tcl_GetDoubleFromObj(interp, ret, &r) != TCL_OK) {
		Tcl_Obj *eiPtr = Tcl_ObjPrintf(
			"\n    (evaluating PRNG step %d for password encoding)",
			i);

		Tcl_AppendObjToErrorInfo(interp, eiPtr);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    ch = (int) (r * 256);
	    kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp);
	}
	Tcl_ResetResult(interp);
	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < 12 - 2; i++) {
	    kvbuf[i] = (unsigned char)
		    zencode(keys, crc32tab, kvbuf[i + 12], tmp);
	}
	kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp);
	kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp);
	len = Tcl_Write(out, (char *) kvbuf, 12);
	memset(kvbuf, 0, 24);
	if (len != 12) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "write error on %s: %s", path, Tcl_PosixError(interp)));
	    Tcl_Close(interp, in);
	    return TCL_ERROR;
	}
	memcpy(keys0, keys, sizeof(keys0));
	nbytecompr += 12;
    }
    Tcl_Flush(out);
    pos[2] = Tcl_Tell(out);
    compMeth = ZIP_COMPMETH_DEFLATED;
    memset(&stream, 0, sizeof(z_stream));
    stream.zalloc = Z_NULL;
    stream.zfree = Z_NULL;
    stream.opaque = Z_NULL;
    if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8,
	    Z_DEFAULT_STRATEGY) != Z_OK) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"compression init error on \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE_INIT", NULL);
	Tcl_Close(interp, in);
	return TCL_ERROR;
    }
    do {
	len = Tcl_Read(in, buf, bufsize);
	if (len == ERROR_LENGTH) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "read error on %s: %s", path, Tcl_PosixError(interp)));
	    deflateEnd(&stream);
	    Tcl_Close(interp, in);
	    return TCL_ERROR;
	}
	stream.avail_in = len;
	stream.next_in = (unsigned char *) buf;
	flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH;
	do {
	    stream.avail_out = sizeof(obuf);
	    stream.next_out = (unsigned char *) obuf;
	    len = deflate(&stream, flush);
	    if (len == (size_t) Z_STREAM_ERROR) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"deflate error on %s", path));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE", NULL);
		deflateEnd(&stream);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    olen = sizeof(obuf) - stream.avail_out;
	    if (passwd) {
		size_t i;
		int tmp;

		for (i = 0; i < olen; i++) {
		    obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp);
		}
	    }
	    if (olen && (Tcl_Write(out, obuf, olen) != olen)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		deflateEnd(&stream);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    nbytecompr += olen;
	} while (stream.avail_out == 0);
    } while (flush != Z_FINISH);
    deflateEnd(&stream);
    Tcl_Flush(out);
    pos[1] = Tcl_Tell(out);
    if (nbyte - nbytecompr <= 0) {
	/*
	 * Compressed file larger than input, write it again uncompressed.
	 */
	if (Tcl_Seek(in, 0, SEEK_SET) != 0) {
	    goto seekErr;
	}
	if (Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) {
	seekErr:
	    Tcl_Close(interp, in);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "seek error: %s", Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	nbytecompr = (passwd ? 12 : 0);
	while (1) {
	    len = Tcl_Read(in, buf, bufsize);
	    if (len == ERROR_LENGTH) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"read error on \"%s\": %s",
			path, Tcl_PosixError(interp)));
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    } else if (len == 0) {
		break;
	    }
	    if (passwd) {
		size_t i;
		int tmp;

		for (i = 0; i < len; i++) {
		    buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp);
		}
	    }
	    if (Tcl_Write(out, buf, len) != len) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    nbytecompr += len;
	}
	compMeth = ZIP_COMPMETH_STORED;
	Tcl_Flush(out);
	pos[1] = Tcl_Tell(out);
	Tcl_TruncateChannel(out, pos[1]);
    }
    Tcl_Close(interp, in);

    hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"non-unique path name \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DUPLICATE_PATH", NULL);
	return TCL_ERROR;
    }

    z = ckalloc(sizeof(ZipEntry));
    Tcl_SetHashValue(hPtr, z);
    z->name = NULL;
    z->tnext = NULL;
    z->depth = 0;
    z->zipFilePtr = NULL;
    z->isDirectory = 0;
    z->isEncrypted = (passwd ? 1 : 0);
    z->offset = pos[0];
    z->crc32 = crc;
    z->timestamp = mtime;
    z->numBytes = nbyte;
    z->numCompressedBytes = nbytecompr;
    z->compressMethod = compMeth;
    z->data = NULL;
    z->name = Tcl_GetHashKey(fileHash, hPtr);
    z->next = NULL;

    /*
     * Write final local header information.
     */
    ZipWriteInt(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG);
    ZipWriteShort(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION);
    ZipWriteShort(buf + ZIP_LOCAL_FLAGS_OFFS, z->isEncrypted);
    ZipWriteShort(buf + ZIP_LOCAL_COMPMETH_OFFS, z->compressMethod);
    ZipWriteShort(buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp));
    ZipWriteShort(buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp));
    ZipWriteInt(buf + ZIP_LOCAL_CRC32_OFFS, z->crc32);
    ZipWriteInt(buf + ZIP_LOCAL_COMPLEN_OFFS, z->numCompressedBytes);
    ZipWriteInt(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->numBytes);
    ZipWriteShort(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen);
    ZipWriteShort(buf + ZIP_LOCAL_EXTRALEN_OFFS, align);
    if (Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) {
	Tcl_DeleteHashEntry(hPtr);
	ckfree(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"seek error: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) {
	Tcl_DeleteHashEntry(hPtr);
	ckfree(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_Flush(out);
    if (Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) {
	Tcl_DeleteHashEntry(hPtr);
	ckfree(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"seek error: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipOrImgObjCmd --
 *
 *	This procedure is creates a new ZIP archive file or image file given
 *	output filename, input directory of files to be archived, optional
 *	password, and optional image to be prepended to the output ZIP archive
 *	file.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A new ZIP archive file or image file is written.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkZipOrImgObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int isImg,
    int isList,
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel out;
    int pwlen = 0, count, ret = TCL_ERROR, lobjc;
    size_t len, slen = 0, i = 0;
    Tcl_WideInt pos[3];
    Tcl_Obj **lobjv, *list = NULL;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable fileHash;
    char *strip = NULL, *pw = NULL, passBuf[264], buf[4096];

    /*
     * Caller has verified that the number of arguments is correct.
     */

    passBuf[0] = 0;
    if (objc > (isList ? 3 : 4)) {
	pw = Tcl_GetString(objv[isList ? 3 : 4]);
	pwlen = strlen(pw);
	if ((pwlen > 255) || strchr(pw, 0xff)) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("illegal password", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    return TCL_ERROR;
	}
    }
    if (isList) {
	list = objv[2];
	Tcl_IncrRefCount(list);
    } else {
	Tcl_Obj *cmd[3];

	cmd[1] = Tcl_NewStringObj("::tcl::zipfs::find", -1);
	cmd[2] = objv[2];
	cmd[0] = Tcl_NewListObj(2, cmd + 1);
	Tcl_IncrRefCount(cmd[0]);
	if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) {
	    Tcl_DecrRefCount(cmd[0]);
	    return TCL_ERROR;
	}
	Tcl_DecrRefCount(cmd[0]);
	list = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(list);
    }
    if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (isList && (lobjc % 2)) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("need even number of elements", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "LIST_LENGTH", NULL);
	return TCL_ERROR;
    }
    if (lobjc == 0) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
	return TCL_ERROR;
    }
    out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "wb", 0755);
    if (out == NULL) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (pwlen <= 0) {
	pw = NULL;
	pwlen = 0;
    }
    if (isImg) {
	ZipFile *zf, zf0;
	int isMounted = 0;
	const char *imgName;

	if (isList) {
	    imgName = (objc > 4) ? Tcl_GetString(objv[4]) :
		    Tcl_GetNameOfExecutable();
	} else {
	    imgName = (objc > 5) ? Tcl_GetString(objv[5]) :
		    Tcl_GetNameOfExecutable();
	}
	if (pwlen) {
	    i = 0;
	    for (len = pwlen; len-- > 0;) {
		int ch = pw[len];

		passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
		i++;
	    }
	    passBuf[i] = i;
	    ++i;
	    passBuf[i++] = (char) ZIP_PASSWORD_END_SIG;
	    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
	    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
	    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
	    passBuf[i] = '\0';
	}

	/*
	 * Check for mounted image.
	 */

	WriteLock();
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
		hPtr = Tcl_NextHashEntry(&search)) {
	    zf = Tcl_GetHashValue(hPtr);
	    if (strcmp(zf->name, imgName) == 0) {
		isMounted = 1;
		zf->numOpen++;
		break;
	    }
	}
	Unlock();
	if (!isMounted) {
	    zf = &zf0;
	}
	if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) {
	    if (Tcl_Write(out, (char *) zf->data,
		    zf->passOffset) != zf->passOffset) {
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		Tcl_Close(interp, out);
		if (zf == &zf0) {
		    ZipFSCloseArchive(interp, zf);
		} else {
		    WriteLock();
		    zf->numOpen--;
		    Unlock();
		}
		return TCL_ERROR;
	    }
	    if (zf == &zf0) {
		ZipFSCloseArchive(interp, zf);
	    } else {
		WriteLock();
		zf->numOpen--;
		Unlock();
	    }
	} else {
	    size_t k;
	    int m, n;
	    Tcl_Channel in;
	    const char *errMsg = "seek error";

	    /*
	     * Fall back to read it as plain file which hopefully is a static
	     * tclsh or wish binary with proper zipfs infrastructure built in.
	     */

	    Tcl_ResetResult(interp);
	    in = Tcl_OpenFileChannel(interp, imgName, "rb", 0644);
	    if (!in) {
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_Close(interp, out);
		return TCL_ERROR;
	    }
	    i = Tcl_Seek(in, 0, SEEK_END);
	    if (i == ERROR_LENGTH) {
	    cperr:
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"%s: %s", errMsg, Tcl_PosixError(interp)));
		Tcl_Close(interp, out);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    Tcl_Seek(in, 0, SEEK_SET);
	    for (k = 0; k < i; k += m) {
		m = i - k;
		if (m > (int) sizeof(buf)) {
		    m = (int) sizeof(buf);
		}
		n = Tcl_Read(in, buf, m);
		if (n == -1) {
		    errMsg = "read error";
		    goto cperr;
		} else if (n == 0) {
		    break;
		}
		m = Tcl_Write(out, buf, n);
		if (m != n) {
		    errMsg = "write error";
		    goto cperr;
		}
	    }
	    Tcl_Close(interp, in);
	}
	len = strlen(passBuf);
	if (len > 0) {
	    i = Tcl_Write(out, passBuf, len);
	    if (i != len) {
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		Tcl_Close(interp, out);
		return TCL_ERROR;
	    }
	}
	memset(passBuf, 0, sizeof(passBuf));
	Tcl_Flush(out);
    }
    Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
    pos[0] = Tcl_Tell(out);
    if (!isList && (objc > 3)) {
	strip = Tcl_GetString(objv[3]);
	slen = strlen(strip);
    }
    for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = Tcl_GetString(lobjv[i]);
	if (isList) {
	    name = Tcl_GetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
		name += slen;
	    }
	}
	while (name[0] == '/') {
	    ++name;
	}
	if (name[0] == '\0') {
	    continue;
	}
	if (ZipAddFile(interp, path, name, out, pw, buf, sizeof(buf),
		&fileHash) != TCL_OK) {
	    goto done;
	}
    }
    pos[1] = Tcl_Tell(out);
    count = 0;
    for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = Tcl_GetString(lobjv[i]);
	if (isList) {
	    name = Tcl_GetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
		name += slen;
	    }
	}
	while (name[0] == '/') {
	    ++name;
	}
	if (name[0] == '\0') {
	    continue;
	}
	hPtr = Tcl_FindHashEntry(&fileHash, name);
	if (!hPtr) {
	    continue;
	}
	z = Tcl_GetHashValue(hPtr);
	len = strlen(z->name);
	ZipWriteInt(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isEncrypted);
	ZipWriteShort(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->compressMethod);
	ZipWriteShort(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp));
	ZipWriteShort(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp));
	ZipWriteInt(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32);
	ZipWriteInt(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->numCompressedBytes);
	ZipWriteInt(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->numBytes);
	ZipWriteShort(buf + ZIP_CENTRAL_PATHLEN_OFFS, len);
	ZipWriteShort(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_IATTR_OFFS, 0);
	ZipWriteInt(buf + ZIP_CENTRAL_EATTR_OFFS, 0);
	ZipWriteInt(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]);
	if ((Tcl_Write(out, buf,
		    ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN)
		|| (Tcl_Write(out, z->name, len) != len)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "write error: %s", Tcl_PosixError(interp)));
	    goto done;
	}
	count++;
    }
    Tcl_Flush(out);
    pos[2] = Tcl_Tell(out);
    ZipWriteInt(buf + ZIP_CENTRAL_END_SIG_OFFS, ZIP_CENTRAL_END_SIG);
    ZipWriteShort(buf + ZIP_CENTRAL_DISKNO_OFFS, 0);
    ZipWriteShort(buf + ZIP_CENTRAL_DISKDIR_OFFS, 0);
    ZipWriteShort(buf + ZIP_CENTRAL_ENTS_OFFS, count);
    ZipWriteShort(buf + ZIP_CENTRAL_TOTALENTS_OFFS, count);
    ZipWriteInt(buf + ZIP_CENTRAL_DIRSIZE_OFFS, pos[2] - pos[1]);
    ZipWriteInt(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]);
    ZipWriteShort(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0);
    if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error: %s", Tcl_PosixError(interp)));
	goto done;
    }
    Tcl_Flush(out);
    ret = TCL_OK;

  done:
    if (ret == TCL_OK) {
	ret = Tcl_Close(interp, out);
    } else {
	Tcl_Close(interp, out);
    }
    Tcl_DecrRefCount(list);
    for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	z = Tcl_GetHashValue(hPtr);
	ckfree(z);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&fileHash);
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipObjCmd, ZipFSLMkZipObjCmd --
 *
 *	These procedures are invoked to process the [zipfs mkzip] and [zipfs
 *	lmkzip] commands.  See description of ZipFSMkZipOrImgCmd().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkZipObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile indir ?strip? ?password?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 0, 0, objc, objv);
}

static int
ZipFSLMkZipObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 0, 1, objc, objv);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkImgObjCmd, ZipFSLMkImgObjCmd --
 *
 *	These procedures are invoked to process the [zipfs mkimg] and [zipfs
 *	lmkimg] commands.  See description of ZipFSMkZipOrImgCmd().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkImgObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 6) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"outfile indir ?strip? ?password? ?infile?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 1, 0, objc, objv);
}

static int
ZipFSLMkImgObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password infile?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 1, 1, objc, objv);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSCanonicalObjCmd --
 *
 *	This procedure is invoked to process the [zipfs canonical] command.
 *	It returns the canonical name for a file within zipfs
 *
 * Results:
 *	Always TCL_OK provided the right number of arguments are supplied.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSCanonicalObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *mntpoint = NULL;
    char *filename = NULL;
    char *result;
    Tcl_DString dPath;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? filename ?inZipfs?");
	return TCL_ERROR;
    }
    Tcl_DStringInit(&dPath);
    if (objc == 2) {
	filename = Tcl_GetString(objv[1]);
	result = CanonicalPath("", filename, &dPath, 1);
    } else if (objc == 3) {
	mntpoint = Tcl_GetString(objv[1]);
	filename = Tcl_GetString(objv[2]);
	result = CanonicalPath(mntpoint, filename, &dPath, 1);
    } else {
	int zipfs = 0;

	if (Tcl_GetBooleanFromObj(interp, objv[3], &zipfs)) {
	    return TCL_ERROR;
	}
	mntpoint = Tcl_GetString(objv[1]);
	filename = Tcl_GetString(objv[2]);
	result = CanonicalPath(mntpoint, filename, &dPath, zipfs);
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSExistsObjCmd --
 *
 *	This procedure is invoked to process the [zipfs exists] command.  It
 *	tests for the existence of a file in the ZIP filesystem and places a
 *	boolean into the interp's result.
 *
 * Results:
 *	Always TCL_OK provided the right number of arguments are supplied.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSExistsObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *filename;
    int exists;
    Tcl_DString ds;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }

    /*
     * Prepend ZIPFS_VOLUME to filename, eliding the final /
     */

    filename = Tcl_GetString(objv[1]);
    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN - 1);
    Tcl_DStringAppend(&ds, filename, -1);
    filename = Tcl_DStringValue(&ds);

    ReadLock();
    exists = ZipFSLookup(filename) != NULL;
    Unlock();

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSInfoObjCmd --
 *
 *	This procedure is invoked to process the [zipfs info] command.	 On
 *	success, it returns a Tcl list made up of name of ZIP archive file,
 *	size uncompressed, size compressed, and archive offset of a file in
 *	the ZIP filesystem.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSInfoObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *filename;
    ZipEntry *z;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }
    filename = Tcl_GetString(objv[1]);
    ReadLock();
    z = ZipFSLookup(filename);
    if (z) {
	Tcl_Obj *result = Tcl_GetObjResult(interp);

	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewStringObj(z->zipFilePtr->name, -1));
	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewWideIntObj(z->numBytes));
	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewWideIntObj(z->numCompressedBytes));
	Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(z->offset));
    }
    Unlock();
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSListObjCmd --
 *
 *	This procedure is invoked to process the [zipfs list] command.	 On
 *	success, it returns a Tcl list of files of the ZIP filesystem which
 *	match a search pattern (glob or regexp).
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSListObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *pattern = NULL;
    Tcl_RegExp regexp = NULL;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *result = Tcl_GetObjResult(interp);

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	int n;
	char *what = Tcl_GetStringFromObj(objv[1], &n);

	if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) {
	    pattern = Tcl_GetString(objv[2]);
	} else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) {
	    regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2]));
	    if (!regexp) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unknown option \"%s\"", what));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_OPT", NULL);
	    return TCL_ERROR;
	}
    } else if (objc == 2) {
	pattern = Tcl_GetString(objv[1]);
    }
    ReadLock();
    if (pattern) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);

	    if (Tcl_StringMatch(z->name, pattern)) {
		Tcl_ListObjAppendElement(interp, result,
			Tcl_NewStringObj(z->name, -1));
	    }
	}
    } else if (regexp) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);

	    if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) {
		Tcl_ListObjAppendElement(interp, result,
			Tcl_NewStringObj(z->name, -1));
	    }
	}
    } else {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);

	    Tcl_ListObjAppendElement(interp, result,
		    Tcl_NewStringObj(z->name, -1));
	}
    }
    Unlock();
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_TclLibrary --
 *
 *	This procedure gets (and possibly finds) the root that Tcl's library
 *	files are mounted under.
 *
 * Results:
 *	A Tcl object holding the location (with zero refcount), or NULL if no
 *	Tcl library can be found.
 *
 * Side effects:
 *	May initialise the cache of where such library files are to be found.
 *	This cache is never cleared.
 *
 *-------------------------------------------------------------------------
 */

#ifdef _WIN32
#define LIBRARY_SIZE	    64

static inline int
WCharToUtf(
    const WCHAR *wSrc,
    char *dst)
{
    char *start = dst;

    while (*wSrc != '\0') {
	dst += Tcl_UniCharToUtf(*wSrc, dst);
	wSrc++;
    }
    *dst = '\0';
    return (int) (dst - start);
}
#endif /* _WIN32 */

Tcl_Obj *
TclZipfs_TclLibrary(void)
{
    Tcl_Obj *vfsInitScript;
    int found;
#ifdef _WIN32
    HMODULE hModule;
    WCHAR wName[MAX_PATH + LIBRARY_SIZE];
    char dllName[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
#endif /* _WIN32 */

    /*
     * Use the cached value if that has been set; we don't want to repeat the
     * searching and mounting.
     */

    if (zipfs_literal_tcl_library) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }

    /*
     * Look for the library file system within the executable.
     */

    vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",
	    -1);
    Tcl_IncrRefCount(vfsInitScript);
    found = Tcl_FSAccess(vfsInitScript, F_OK);
    Tcl_DecrRefCount(vfsInitScript);
    if (found == TCL_OK) {
	zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }

    /*
     * Look for the library file system within the DLL/shared library.  Note
     * that we must mount the zip file and dll before releasing to search.
     */

#if defined(_WIN32)
    hModule = TclWinGetTclInstance();
    if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
	GetModuleFileNameA(hModule, dllName, MAX_PATH);
    } else {
	WCharToUtf(wName, dllName);
    }

    if (ZipfsAppHookFindTclInit(dllName) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#elif /* !_WIN32 && */ defined(CFG_RUNTIME_DLLFILE)
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#endif /* _WIN32 || CFG_RUNTIME_DLLFILE */

    /*
     * If we're configured to know about a ZIP archive we should use, do that.
     */

#ifdef CFG_RUNTIME_ZIPFILE
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_SCRDIR "/" CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
    if (ZipfsAppHookFindTclInit(CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#endif /* CFG_RUNTIME_ZIPFILE */

    /*
     * If anything set the cache (but subsequently failed) go with that
     * anyway.
     */

    if (zipfs_literal_tcl_library) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
    return NULL;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSTclLibraryObjCmd --
 *
 *	This procedure is invoked to process the
 *	[::tcl::zipfs::tcl_library_init] command, usually called during the
 *	execution of Tcl's interpreter startup. It returns the root that Tcl's
 *	library files are mounted under.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May initialise the cache of where such library files are to be found.
 *	This cache is never cleared.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSTclLibraryObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (!Tcl_IsSafe(interp)) {
	Tcl_Obj *pResult = TclZipfs_TclLibrary();

	if (!pResult) {
	    pResult = Tcl_NewObj();
	}
	Tcl_SetObjResult(interp, pResult);
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelClose --
 *
 *	This function is called to close a channel.
 *
 * Results:
 *	Always TCL_OK.
 *
 * Side effects:
 *	Resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelClose(
    ClientData instanceData,
    Tcl_Interp *interp)		/* Current interpreter. */
{
    ZipChannel *info = instanceData;

    if (info->iscompr && info->ubuf) {
	ckfree(info->ubuf);
	info->ubuf = NULL;
    }
    if (info->isEncrypted) {
	info->isEncrypted = 0;
	memset(info->keys, 0, sizeof(info->keys));
    }
    if (info->isWriting) {
	ZipEntry *z = info->zipEntryPtr;
	unsigned char *newdata = attemptckrealloc(info->ubuf, info->numRead);

	if (newdata) {
	    if (z->data) {
		ckfree(z->data);
	    }
	    z->data = newdata;
	    z->numBytes = z->numCompressedBytes = info->numBytes;
	    z->compressMethod = ZIP_COMPMETH_STORED;
	    z->timestamp = time(NULL);
	    z->isDirectory = 0;
	    z->isEncrypted = 0;
	    z->offset = 0;
	    z->crc32 = 0;
	} else {
	    ckfree(info->ubuf);
	}
    }
    WriteLock();
    info->zipFilePtr->numOpen--;
    Unlock();
    ckfree(info);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelRead --
 *
 *	This function is called to read data from channel.
 *
 * Results:
 *	Number of bytes read or -1 on error with error number set.
 *
 * Side effects:
 *	Data is read and file pointer is advanced.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelRead(
    ClientData instanceData,
    char *buf,
    int toRead,
    int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    unsigned long nextpos;

    if (info->isDirectory < 0) {
	/*
	 * Special case: when executable combined with ZIP archive file read
	 * data in front of ZIP, i.e. the executable itself.
	 */

	nextpos = info->numRead + toRead;
	if (nextpos > info->zipFilePtr->baseOffset) {
	    toRead = info->zipFilePtr->baseOffset - info->numRead;
	    nextpos = info->zipFilePtr->baseOffset;
	}
	if (toRead == 0) {
	    return 0;
	}
	memcpy(buf, info->zipFilePtr->data, toRead);
	info->numRead = nextpos;
	*errloc = 0;
	return toRead;
    }
    if (info->isDirectory) {
	*errloc = EISDIR;
	return -1;
    }
    nextpos = info->numRead + toRead;
    if (nextpos > info->numBytes) {
	toRead = info->numBytes - info->numRead;
	nextpos = info->numBytes;
    }
    if (toRead == 0) {
	return 0;
    }
    if (info->isEncrypted) {
	int i;

	for (i = 0; i < toRead; i++) {
	    int ch = info->ubuf[i + info->numRead];

	    buf[i] = zdecode(info->keys, crc32tab, ch);
	}
    } else {
	memcpy(buf, info->ubuf + info->numRead, toRead);
    }
    info->numRead = nextpos;
    *errloc = 0;
    return toRead;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelWrite --
 *
 *	This function is called to write data into channel.
 *
 * Results:
 *	Number of bytes written or -1 on error with error number set.
 *
 * Side effects:
 *	Data is written and file pointer is advanced.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelWrite(
    ClientData instanceData,
    const char *buf,
    int toWrite,
    int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    unsigned long nextpos;

    if (!info->isWriting) {
	*errloc = EINVAL;
	return -1;
    }
    nextpos = info->numRead + toWrite;
    if (nextpos > info->maxWrite) {
	toWrite = info->maxWrite - info->numRead;
	nextpos = info->maxWrite;
    }
    if (toWrite == 0) {
	return 0;
    }
    memcpy(info->ubuf + info->numRead, buf, toWrite);
    info->numRead = nextpos;
    if (info->numRead > info->numBytes) {
	info->numBytes = info->numRead;
    }
    *errloc = 0;
    return toWrite;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelSeek --
 *
 *	This function is called to position file pointer of channel.
 *
 * Results:
 *	New file position or -1 on error with error number set.
 *
 * Side effects:
 *	File pointer is repositioned according to offset and mode.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelSeek(
    ClientData instanceData,
    long offset,
    int mode,
    int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    unsigned long end;

    if (!info->isWriting && (info->isDirectory < 0)) {
	/*
	 * Special case: when executable combined with ZIP archive file, seek
	 * within front of ZIP, i.e. the executable itself.
	 */
	end = info->zipFilePtr->baseOffset;
    } else if (info->isDirectory) {
	*errloc = EINVAL;
	return -1;
    } else {
	end = info->numBytes;
    }
    switch (mode) {
    case SEEK_CUR:
	offset += info->numRead;
	break;
    case SEEK_END:
	offset += end;
	break;
    case SEEK_SET:
	break;
    default:
	*errloc = EINVAL;
	return -1;
    }
    if (offset < 0) {
	*errloc = EINVAL;
	return -1;
    }
    if (info->isWriting) {
	if ((unsigned long) offset > info->maxWrite) {
	    *errloc = EINVAL;
	    return -1;
	}
	if ((unsigned long) offset > info->numBytes) {
	    info->numBytes = offset;
	}
    } else if ((unsigned long) offset > end) {
	*errloc = EINVAL;
	return -1;
    }
    info->numRead = (unsigned long) offset;
    return info->numRead;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelWatchChannel --
 *
 *	This function is called for event notifications on channel. Does
 *	nothing.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipChannelWatchChannel(
    ClientData instanceData,
    int mask)
{
    return;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelGetFile --
 *
 *	This function is called to retrieve OS handle for channel.
 *
 * Results:
 *	Always TCL_ERROR since there's never an OS handle for a file within a
 *	ZIP archive.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelGetFile(
    ClientData instanceData,
    int direction,
    ClientData *handlePtr)
{
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelOpen --
 *
 *	This function opens a Tcl_Channel on a file from a mounted ZIP archive
 *	according to given open mode.
 *
 * Results:
 *	Tcl_Channel on success, or NULL on error.
 *
 * Side effects:
 *	Memory is allocated, the file from the ZIP archive is uncompressed.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Channel
ZipChannelOpen(
    Tcl_Interp *interp,		/* Current interpreter. */
    char *filename,
    int mode,
    int permissions)
{
    ZipEntry *z;
    ZipChannel *info;
    int i, ch, trunc, wr, flags = 0;
    char cname[128];

    if ((mode & O_APPEND)
	    || ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) {
	if (interp) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("unsupported open mode", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_MODE", NULL);
	}
	return NULL;
    }
    WriteLock();
    z = ZipFSLookup(filename);
    if (!z) {
	Tcl_SetErrno(ENOENT);
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "file not found \"%s\": %s", filename,
		    Tcl_PosixError(interp)));
	}
	goto error;
    }
    trunc = (mode & O_TRUNC) != 0;
    wr = (mode & (O_WRONLY | O_RDWR)) != 0;
    if ((z->compressMethod != ZIP_COMPMETH_STORED)
	    && (z->compressMethod != ZIP_COMPMETH_DEFLATED)) {
	ZIPFS_ERROR(interp, "unsupported compression method");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "COMP_METHOD", NULL);
	}
	goto error;
    }
    if (wr && z->isDirectory) {
	ZIPFS_ERROR(interp, "unsupported file type");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_TYPE", NULL);
	}
	goto error;
    }
    if (!trunc) {
	flags |= TCL_READABLE;
	if (z->isEncrypted && (z->zipFilePtr->passBuf[0] == 0)) {
	    ZIPFS_ERROR(interp, "decryption failed");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DECRYPT", NULL);
	    }
	    goto error;
	} else if (wr && !z->data && (z->numBytes > ZipFS.wrmax)) {
	    ZIPFS_ERROR(interp, "file too large");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
	    }
	    goto error;
	}
    } else {
	flags = TCL_WRITABLE;
    }
    info = attemptckalloc(sizeof(ZipChannel));
    if (!info) {
	ZIPFS_ERROR(interp, "out of memory");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	goto error;
    }
    info->zipFilePtr = z->zipFilePtr;
    info->zipEntryPtr = z;
    info->numRead = 0;
    if (wr) {
	flags |= TCL_WRITABLE;
	info->isWriting = 1;
	info->isDirectory = 0;
	info->maxWrite = ZipFS.wrmax;
	info->iscompr = 0;
	info->isEncrypted = 0;
	info->ubuf = attemptckalloc(info->maxWrite);
	if (!info->ubuf) {
	merror0:
	    if (info->ubuf) {
		ckfree(info->ubuf);
	    }
	    ckfree(info);
	    ZIPFS_ERROR(interp, "out of memory");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    goto error;
	}
	memset(info->ubuf, 0, info->maxWrite);
	if (trunc) {
	    info->numBytes = 0;
	} else if (z->data) {
	    unsigned int j = z->numBytes;

	    if (j > info->maxWrite) {
		j = info->maxWrite;
	    }
	    memcpy(info->ubuf, z->data, j);
	    info->numBytes = j;
	} else {
	    unsigned char *zbuf = z->zipFilePtr->data + z->offset;

	    if (z->isEncrypted) {
		int len = z->zipFilePtr->passBuf[0];
		char passBuf[260];

		for (i = 0; i < len; i++) {
		    ch = z->zipFilePtr->passBuf[len - i];
		    passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
		}
		passBuf[i] = '\0';
		init_keys(passBuf, info->keys, crc32tab);
		memset(passBuf, 0, sizeof(passBuf));
		for (i = 0; i < 12; i++) {
		    ch = info->ubuf[i];
		    zdecode(info->keys, crc32tab, ch);
		}
		zbuf += i;
	    }
	    if (z->compressMethod == ZIP_COMPMETH_DEFLATED) {
		z_stream stream;
		int err;
		unsigned char *cbuf = NULL;

		memset(&stream, 0, sizeof(z_stream));
		stream.zalloc = Z_NULL;
		stream.zfree = Z_NULL;
		stream.opaque = Z_NULL;
		stream.avail_in = z->numCompressedBytes;
		if (z->isEncrypted) {
		    unsigned int j;

		    stream.avail_in -= 12;
		    cbuf = attemptckalloc(stream.avail_in);
		    if (!cbuf) {
			goto merror0;
		    }
		    for (j = 0; j < stream.avail_in; j++) {
			ch = info->ubuf[j];
			cbuf[j] = zdecode(info->keys, crc32tab, ch);
		    }
		    stream.next_in = cbuf;
		} else {
		    stream.next_in = zbuf;
		}
		stream.next_out = info->ubuf;
		stream.avail_out = info->maxWrite;
		if (inflateInit2(&stream, -15) != Z_OK) {
		    goto cerror0;
		}
		err = inflate(&stream, Z_SYNC_FLUSH);
		inflateEnd(&stream);
		if ((err == Z_STREAM_END)
			|| ((err == Z_OK) && (stream.avail_in == 0))) {
		    if (cbuf) {
			memset(info->keys, 0, sizeof(info->keys));
			ckfree(cbuf);
		    }
		    goto wrapchan;
		}
	    cerror0:
		if (cbuf) {
		    memset(info->keys, 0, sizeof(info->keys));
		    ckfree(cbuf);
		}
		if (info->ubuf) {
		    ckfree(info->ubuf);
		}
		ckfree(info);
		ZIPFS_ERROR(interp, "decompression error");
		if (interp) {
		    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL);
		}
		goto error;
	    } else if (z->isEncrypted) {
		for (i = 0; i < z->numBytes - 12; i++) {
		    ch = zbuf[i];
		    info->ubuf[i] = zdecode(info->keys, crc32tab, ch);
		}
	    } else {
		memcpy(info->ubuf, zbuf, z->numBytes);
	    }
	    memset(info->keys, 0, sizeof(info->keys));
	    goto wrapchan;
	}
    } else if (z->data) {
	flags |= TCL_READABLE;
	info->isWriting = 0;
	info->iscompr = 0;
	info->isDirectory = 0;
	info->isEncrypted = 0;
	info->numBytes = z->numBytes;
	info->maxWrite = 0;
	info->ubuf = z->data;
    } else {
	flags |= TCL_READABLE;
	info->isWriting = 0;
	info->iscompr = (z->compressMethod == ZIP_COMPMETH_DEFLATED);
	info->ubuf = z->zipFilePtr->data + z->offset;
	info->isDirectory = z->isDirectory;
	info->isEncrypted = z->isEncrypted;
	info->numBytes = z->numBytes;
	info->maxWrite = 0;
	if (info->isEncrypted) {
	    int len = z->zipFilePtr->passBuf[0];
	    char passBuf[260];

	    for (i = 0; i < len; i++) {
		ch = z->zipFilePtr->passBuf[len - i];
		passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	    }
	    passBuf[i] = '\0';
	    init_keys(passBuf, info->keys, crc32tab);
	    memset(passBuf, 0, sizeof(passBuf));
	    for (i = 0; i < 12; i++) {
		ch = info->ubuf[i];
		zdecode(info->keys, crc32tab, ch);
	    }
	    info->ubuf += i;
	}
	if (info->iscompr) {
	    z_stream stream;
	    int err;
	    unsigned char *ubuf = NULL;
	    unsigned int j;

	    memset(&stream, 0, sizeof(z_stream));
	    stream.zalloc = Z_NULL;
	    stream.zfree = Z_NULL;
	    stream.opaque = Z_NULL;
	    stream.avail_in = z->numCompressedBytes;
	    if (info->isEncrypted) {
		stream.avail_in -= 12;
		ubuf = attemptckalloc(stream.avail_in);
		if (!ubuf) {
		    info->ubuf = NULL;
		    goto merror;
		}
		for (j = 0; j < stream.avail_in; j++) {
		    ch = info->ubuf[j];
		    ubuf[j] = zdecode(info->keys, crc32tab, ch);
		}
		stream.next_in = ubuf;
	    } else {
		stream.next_in = info->ubuf;
	    }
	    stream.next_out = info->ubuf = attemptckalloc(info->numBytes);
	    if (!info->ubuf) {
	    merror:
		if (ubuf) {
		    info->isEncrypted = 0;
		    memset(info->keys, 0, sizeof(info->keys));
		    ckfree(ubuf);
		}
		ckfree(info);
		if (interp) {
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj("out of memory", -1));
		    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
		}
		goto error;
	    }
	    stream.avail_out = info->numBytes;
	    if (inflateInit2(&stream, -15) != Z_OK) {
		goto cerror;
	    }
	    err = inflate(&stream, Z_SYNC_FLUSH);
	    inflateEnd(&stream);
	    if ((err == Z_STREAM_END)
		    || ((err == Z_OK) && (stream.avail_in == 0))) {
		if (ubuf) {
		    info->isEncrypted = 0;
		    memset(info->keys, 0, sizeof(info->keys));
		    ckfree(ubuf);
		}
		goto wrapchan;
	    }
	cerror:
	    if (ubuf) {
		info->isEncrypted = 0;
		memset(info->keys, 0, sizeof(info->keys));
		ckfree(ubuf);
	    }
	    if (info->ubuf) {
		ckfree(info->ubuf);
	    }
	    ckfree(info);
	    ZIPFS_ERROR(interp, "decompression error");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL);
	    }
	    goto error;
	}
    }

  wrapchan:
    sprintf(cname, "zipfs_%" TCL_LL_MODIFIER "x_%d", z->offset,
	    ZipFS.idCount++);
    z->zipFilePtr->numOpen++;
    Unlock();
    return Tcl_CreateChannel(&ZipChannelType, cname, info, flags);

  error:
    Unlock();
    return NULL;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipEntryStat --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of stat.
 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipEntryStat(
    char *path,
    Tcl_StatBuf *buf)
{
    ZipEntry *z;
    int ret = -1;

    ReadLock();
    z = ZipFSLookup(path);
    if (z) {
	memset(buf, 0, sizeof(Tcl_StatBuf));
	if (z->isDirectory) {
	    buf->st_mode = S_IFDIR | 0555;
	} else {
	    buf->st_mode = S_IFREG | 0555;
	}
	buf->st_size = z->numBytes;
	buf->st_mtime = z->timestamp;
	buf->st_ctime = z->timestamp;
	buf->st_atime = z->timestamp;
	ret = 0;
    }
    Unlock();
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipEntryAccess --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of access.
 *
 * Results:
 *	See access documentation.
 *
 * Side effects:
 *	See access documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipEntryAccess(
    char *path,
    int mode)
{
    ZipEntry *z;

    if (mode & 3) {
	return -1;
    }
    ReadLock();
    z = ZipFSLookup(path);
    Unlock();
    return (z ? 0 : -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSOpenFileChannelProc --
 *
 * Results:
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Channel
ZipFSOpenFileChannelProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *pathPtr,
    int mode,
    int permissions)
{
    int len;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return NULL;
    }
    return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), mode,
	    permissions);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSStatProc --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of stat.
 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSStatProc(
    Tcl_Obj *pathPtr,
    Tcl_StatBuf *buf)
{
    int len;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSAccessProc --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of access.
 *
 * Results:
 *	See access documentation.
 *
 * Side effects:
 *	See access documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSAccessProc(
    Tcl_Obj *pathPtr,
    int mode)
{
    int len;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFilesystemSeparatorProc --
 *
 *	This function returns the separator to be used for a given path. The
 *	object returned should have a refCount of zero
 *
 * Results:
 *	A Tcl object, with a refCount of zero. If the caller needs to retain a
 *	reference to the object, it should call Tcl_IncrRefCount, and should
 *	otherwise free the object.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSFilesystemSeparatorProc(
    Tcl_Obj *pathPtr)
{
    return Tcl_NewStringObj("/", -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMatchInDirectoryProc --
 *
 *	This routine is used by the globbing code to search a directory for
 *	all files which match a given pattern.
 *
 * Results:
 *	The return value is a standard Tcl result indicating whether an error
 *	occurred in globbing. Errors are left in interp, good results are
 *	lappend'ed to resultPtr (which must be a valid object).
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMatchInDirectoryProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *result,
    Tcl_Obj *pathPtr,
    const char *pattern,
    Tcl_GlobTypeData *types)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    int scnt, l, dirOnly = -1, prefixLen, strip = 0;
    size_t len;
    char *pat, *prefix, *path;
    Tcl_DString dsPref;

    if (!normPathPtr) {
	return -1;
    }
    if (types) {
	dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR;
    }

    /*
     * The prefix that gets prepended to results.
     */

    prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen);

    /*
     * The (normalized) path we're searching.
     */

    path = Tcl_GetString(normPathPtr);
    len = normPathPtr->length;

    Tcl_DStringInit(&dsPref);
    Tcl_DStringAppend(&dsPref, prefix, prefixLen);

    if (strcmp(prefix, path) == 0) {
	prefix = NULL;
    } else {
	strip = len + 1;
    }
    if (prefix) {
	Tcl_DStringAppend(&dsPref, "/", 1);
	prefixLen++;
	prefix = Tcl_DStringValue(&dsPref);
    }
    ReadLock();
    if (types && (types->type == TCL_GLOB_TYPE_MOUNT)) {
	l = CountSlashes(path);
	if (path[len - 1] == '/') {
	    len--;
	} else {
	    l++;
	}
	if (!pattern || (pattern[0] == '\0')) {
	    pattern = "*";
	}
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
		hPtr = Tcl_NextHashEntry(&search)) {
	    ZipFile *zf = Tcl_GetHashValue(hPtr);

	    if (zf->mountPointLen == 0) {
		ZipEntry *z;

		for (z = zf->topEnts; z; z = z->tnext) {
		    size_t lenz = strlen(z->name);

		    if ((lenz > len + 1) && (strncmp(z->name, path, len) == 0)
			    && (z->name[len] == '/')
			    && (CountSlashes(z->name) == l)
			    && Tcl_StringCaseMatch(z->name + len + 1, pattern,
				    0)) {
			if (prefix) {
			    Tcl_DStringAppend(&dsPref, z->name, lenz);
			    Tcl_ListObjAppendElement(NULL, result,
				    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
					    Tcl_DStringLength(&dsPref)));
			    Tcl_DStringSetLength(&dsPref, prefixLen);
			} else {
			    Tcl_ListObjAppendElement(NULL, result,
				    Tcl_NewStringObj(z->name, lenz));
			}
		    }
		}
	    } else if ((zf->mountPointLen > len + 1)
		    && (strncmp(zf->mountPoint, path, len) == 0)
		    && (zf->mountPoint[len] == '/')
		    && (CountSlashes(zf->mountPoint) == l)
		    && Tcl_StringCaseMatch(zf->mountPoint + len + 1,
			    pattern, 0)) {
		if (prefix) {
		    Tcl_DStringAppend(&dsPref, zf->mountPoint,
			    zf->mountPointLen);
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				    Tcl_DStringLength(&dsPref)));
		    Tcl_DStringSetLength(&dsPref, prefixLen);
		} else {
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(zf->mountPoint,
				    zf->mountPointLen));
		}
	    }
	}
	goto end;
    }

    if (!pattern || (pattern[0] == '\0')) {
	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
	if (hPtr) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);

	    if ((dirOnly < 0) || (!dirOnly && !z->isDirectory)
		    || (dirOnly && z->isDirectory)) {
		if (prefix) {
		    Tcl_DStringAppend(&dsPref, z->name, -1);
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				    Tcl_DStringLength(&dsPref)));
		    Tcl_DStringSetLength(&dsPref, prefixLen);
		} else {
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(z->name, -1));
		}
	    }
	}
	goto end;
    }

    l = strlen(pattern);
    pat = ckalloc(len + l + 2);
    memcpy(pat, path, len);
    while ((len > 1) && (pat[len - 1] == '/')) {
	--len;
    }
    if ((len > 1) || (pat[0] != '/')) {
	pat[len] = '/';
	++len;
    }
    memcpy(pat + len, pattern, l + 1);
    scnt = CountSlashes(pat);
    for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
	    hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	ZipEntry *z = Tcl_GetHashValue(hPtr);

	if ((dirOnly >= 0) && ((dirOnly && !z->isDirectory)
		|| (!dirOnly && z->isDirectory))) {
	    continue;
	}
	if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) {
	    if (prefix) {
		Tcl_DStringAppend(&dsPref, z->name + strip, -1);
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				Tcl_DStringLength(&dsPref)));
		Tcl_DStringSetLength(&dsPref, prefixLen);
	    } else {
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(z->name + strip, -1));
	    }
	}
    }
    ckfree(pat);

  end:
    Unlock();
    Tcl_DStringFree(&dsPref);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSPathInFilesystemProc --
 *
 *	This function determines if the given path object is in the ZIP
 *	filesystem.
 *
 * Results:
 *	TCL_OK when the path object is in the ZIP filesystem, -1 otherwise.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSPathInFilesystemProc(
    Tcl_Obj *pathPtr,
    ClientData *clientDataPtr)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    int ret = -1;
    size_t len;
    char *path;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }

    path = Tcl_GetString(pathPtr);
    if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) {
	return -1;
    }

    len = pathPtr->length;

    ReadLock();
    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
    if (hPtr) {
	ret = TCL_OK;
	goto endloop;
    }

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ZipFile *zf = Tcl_GetHashValue(hPtr);

	if (zf->mountPointLen == 0) {
	    ZipEntry *z;

	    for (z = zf->topEnts; z != NULL; z = z->tnext) {
		size_t lenz = strlen(z->name);

		if ((len >= lenz) && (strncmp(path, z->name, lenz) == 0)) {
		    ret = TCL_OK;
		    goto endloop;
		}
	    }
	} else if ((len >= zf->mountPointLen) &&
		(strncmp(path, zf->mountPoint, zf->mountPointLen) == 0)) {
	    ret = TCL_OK;
	    break;
	}
    }

  endloop:
    Unlock();
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSListVolumesProc --
 *
 *	Lists the currently mounted ZIP filesystem volumes.
 *
 * Results:
 *	The list of volumes.
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSListVolumesProc(void)
{
    return Tcl_NewStringObj(ZIPFS_VOLUME, -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFileAttrStringsProc --
 *
 *	This function implements the ZIP filesystem dependent 'file
 *	attributes' subcommand, for listing the set of possible attribute
 *	strings.
 *
 * Results:
 *	An array of strings
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static const char *const *
ZipFSFileAttrStringsProc(
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    static const char *const attrs[] = {
	"-uncompsize",
	"-compsize",
	"-offset",
	"-mount",
	"-archive",
	"-permissions",
	NULL,
    };
    return attrs;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFileAttrsGetProc --
 *
 *	This function implements the ZIP filesystem specific 'file attributes'
 *	subcommand, for 'get' operations.
 *
 * Results:
 *	Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
 *	was returned) is likely to have a refCount of zero. Either way we must
 *	either store it somewhere (e.g. the Tcl result), or Incr/Decr its
 *	refCount to ensure it is properly freed.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSFileAttrsGetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    int index,
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    int len, ret = TCL_OK;
    char *path;
    ZipEntry *z;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = Tcl_GetStringFromObj(pathPtr, &len);
    ReadLock();
    z = ZipFSLookup(path);
    if (!z) {
	Tcl_SetErrno(ENOENT);
	ZIPFS_POSIX_ERROR(interp, "file not found");
	ret = TCL_ERROR;
	goto done;
    }
    switch (index) {
    case 0:
	*objPtrRef = Tcl_NewWideIntObj(z->numBytes);
	break;
    case 1:
	*objPtrRef = Tcl_NewWideIntObj(z->numCompressedBytes);
	break;
    case 2:
	*objPtrRef = Tcl_NewWideIntObj(z->offset);
	break;
    case 3:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->mountPoint,
		z->zipFilePtr->mountPointLen);
	break;
    case 4:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->name, -1);
	break;
    case 5:
	*objPtrRef = Tcl_NewStringObj("0555", -1);
	break;
    default:
	ZIPFS_ERROR(interp, "unknown attribute");
	ret = TCL_ERROR;
    }

  done:
    Unlock();
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFileAttrsSetProc --
 *
 *	This function implements the ZIP filesystem specific 'file attributes'
 *	subcommand, for 'set' operations.
 *
 * Results:
 *	Standard Tcl return code.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSFileAttrsSetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    int index,
    Tcl_Obj *pathPtr,
    Tcl_Obj *objPtr)
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "UNSUPPORTED_OP", NULL);
    }
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFilesystemPathTypeProc --
 *
 * Results:
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSFilesystemPathTypeProc(
    Tcl_Obj *pathPtr)
{
    return Tcl_NewStringObj("zip", -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLoadFile --
 *
 *	This functions deals with loading native object code. If the given
 *	path object refers to a file within the ZIP filesystem, an approriate
 *	error code is returned to delegate loading to the caller (by copying
 *	the file to temp store and loading from there). As fallback when the
 *	file refers to the ZIP file system but is not present, it is looked up
 *	relative to the executable and loaded from there when available.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with error message left.
 *
 * Side effects:
 *	Loads native code into the process address space.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSLoadFile(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *path,
    Tcl_LoadHandle *loadHandle,
    Tcl_FSUnloadFileProc **unloadProcPtr,
    int flags)
{
    Tcl_FSLoadFileProc2 *loadFileProc;
#ifdef ANDROID
    /*
     * Force loadFileProc to native implementation since the package manager
     * already extracted the shared libraries from the APK at install time.
     */

    loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
    if (loadFileProc) {
	return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
    }
    Tcl_SetErrno(ENOENT);
    ZIPFS_ERROR(interp, Tcl_PosixError(interp));
    return TCL_ERROR;
#else /* !ANDROID */
    Tcl_Obj *altPath = NULL;
    int ret = TCL_ERROR;
    Tcl_Obj *objs[2] = { NULL, NULL };

    if (Tcl_FSAccess(path, R_OK) == 0) {
	/*
	 * EXDEV should trigger loading by copying to temp store.
	 */

	Tcl_SetErrno(EXDEV);
	ZIPFS_ERROR(interp, Tcl_PosixError(interp));
	return ret;
    }

    objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME);
    if (objs[1] && (ZipFSAccessProc(objs[1], R_OK) == 0)) {
	const char *execName = Tcl_GetNameOfExecutable();

	/*
	 * Shared object is not in ZIP but its path prefix is, thus try to
	 * load from directory where the executable came from.
	 */

	TclDecrRefCount(objs[1]);
	objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL);

	/*
	 * Get directory name of executable manually to deal with cases where
	 * [file dirname [info nameofexecutable]] is equal to [info
	 * nameofexecutable] due to VFS effects.
	 */

	if (execName) {
	    const char *p = strrchr(execName, '/');

	    if (p > execName + 1) {
		--p;
		objs[0] = Tcl_NewStringObj(execName, p - execName);
	    }
	}
	if (!objs[0]) {
	    objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),
		    TCL_PATH_DIRNAME);
	}
	if (objs[0]) {
	    altPath = TclJoinPath(2, objs);
	    if (altPath) {
		Tcl_IncrRefCount(altPath);
		if (Tcl_FSAccess(altPath, R_OK) == 0) {
		    path = altPath;
		}
	    }
	}
    }
    if (objs[0]) {
	Tcl_DecrRefCount(objs[0]);
    }
    if (objs[1]) {
	Tcl_DecrRefCount(objs[1]);
    }

    loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
    if (loadFileProc) {
	ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
    } else {
	Tcl_SetErrno(ENOENT);
	ZIPFS_ERROR(interp, Tcl_PosixError(interp));
    }
    if (altPath) {
	Tcl_DecrRefCount(altPath);
    }
    return ret;
#endif /* ANDROID */
}

#endif /* HAVE_ZLIB */

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Init --
 *
 *	Perform per interpreter initialization of this module.
 *
 * Results:
 *	The return value is a standard Tcl result.
 *
 * Side effects:
 *	Initializes this module if not already initialized, and adds module
 *	related commands to the given interpreter.
 *
 *-------------------------------------------------------------------------
 */

MODULE_SCOPE int
TclZipfs_Init(
    Tcl_Interp *interp)		/* Current interpreter. */
{
#ifdef HAVE_ZLIB
    static const EnsembleImplMap initMap[] = {
	{"mkimg",	ZipFSMkImgObjCmd,	NULL, NULL, NULL, 1},
	{"mkzip",	ZipFSMkZipObjCmd,	NULL, NULL, NULL, 1},
	{"lmkimg",	ZipFSLMkImgObjCmd,	NULL, NULL, NULL, 1},
	{"lmkzip",	ZipFSLMkZipObjCmd,	NULL, NULL, NULL, 1},
	/* The 4 entries above are not available in safe interpreters */
	{"mount",	ZipFSMountObjCmd,	NULL, NULL, NULL, 1},
	{"mount_data",	ZipFSMountBufferObjCmd,	NULL, NULL, NULL, 1},
	{"unmount",	ZipFSUnmountObjCmd,	NULL, NULL, NULL, 1},
	{"mkkey",	ZipFSMkKeyObjCmd,	NULL, NULL, NULL, 1},
	{"exists",	ZipFSExistsObjCmd,	NULL, NULL, NULL, 0},
	{"info",	ZipFSInfoObjCmd,	NULL, NULL, NULL, 0},
	{"list",	ZipFSListObjCmd,	NULL, NULL, NULL, 0},
	{"canonical",	ZipFSCanonicalObjCmd,	NULL, NULL, NULL, 0},
	{"root",	ZipFSRootObjCmd,	NULL, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    static const char findproc[] =
	"namespace eval ::tcl::zipfs {}\n"
	"proc ::tcl::zipfs::Find dir {\n"
	"    set result {}\n"
	"    if {[catch {glob -directory $dir -nocomplain * .*} list]} {\n"
	"        return $result\n"
	"    }\n"
	"    foreach file $list {\n"
	"        if {[file tail $file] in {. ..}} {\n"
	"            continue\n"
	"        }\n"
	"        lappend result $file {*}[Find $file]\n"
	"    }\n"
	"    return $result\n"
	"}\n"
	"proc ::tcl::zipfs::find {directoryName} {\n"
	"    return [lsort [Find $directoryName]]\n"
	"}\n";

    /*
     * One-time initialization.
     */

    WriteLock();
    /* Tcl_StaticPackage(interp, "zipfs", TclZipfs_Init, TclZipfs_Init); */
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }
    Unlock();

    if (interp) {
	Tcl_Command ensemble;
	Tcl_Obj *mapObj;

	Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL);
	Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
		TCL_LINK_INT);
	ensemble = TclMakeEnsemble(interp, "zipfs",
		Tcl_IsSafe(interp) ? (initMap + 4) : initMap);

	/*
	 * Add the [zipfs find] subcommand.
	 */

	Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
	Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
		Tcl_NewStringObj("::tcl::zipfs::find", -1));
	Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
		ZipFSTclLibraryObjCmd, NULL, NULL);
	Tcl_PkgProvide(interp, "zipfs", "2.0");
    }
    return TCL_OK;
#else /* !HAVE_ZLIB */
    ZIPFS_ERROR(interp, "no zlib available");
    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    return TCL_ERROR;
#endif /* HAVE_ZLIB */
}

static int
ZipfsAppHookFindTclInit(
    const char *archive)
{
    Tcl_Obj *vfsInitScript;
    int found;

    if (zipfs_literal_tcl_library) {
	return TCL_ERROR;
    }
    if (TclZipfs_Mount(NULL, ZIPFS_ZIP_MOUNT, archive, NULL)) {
	/* Either the file doesn't exist or it is not a zip archive */
	return TCL_ERROR;
    }

    TclNewLiteralStringObj(vfsInitScript, ZIPFS_ZIP_MOUNT "/init.tcl");
    Tcl_IncrRefCount(vfsInitScript);
    found = Tcl_FSAccess(vfsInitScript, F_OK);
    Tcl_DecrRefCount(vfsInitScript);
    if (found == 0) {
	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT;
	return TCL_OK;
    }

    TclNewLiteralStringObj(vfsInitScript,
	    ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl");
    Tcl_IncrRefCount(vfsInitScript);
    found = Tcl_FSAccess(vfsInitScript, F_OK);
    Tcl_DecrRefCount(vfsInitScript);
    if (found == 0) {
	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library";
	return TCL_OK;
    }

    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_AppHook --
 *
 *	Performs the argument munging for the shell
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_AppHook(
    int *argcPtr,		/* Pointer to argc */
#ifdef _WIN32
    TCHAR
#else /* !_WIN32 */
    char
#endif /* _WIN32 */
    ***argvPtr)			/* Pointer to argv */
{
    char *archive;

    Tcl_FindExecutable((*argvPtr)[0]);
    archive = (char *) Tcl_GetNameOfExecutable();
    TclZipfs_Init(NULL);

    /*
     * Look for init.tcl in one of the locations mounted later in this
     * function.
     */

    if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
	int found;
	Tcl_Obj *vfsInitScript;

	TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
	Tcl_IncrRefCount(vfsInitScript);
	if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
	    /*
	     * Startup script should be set before calling Tcl_AppInit
	     */

	    Tcl_SetStartupScript(vfsInitScript, NULL);
	} else {
	    Tcl_DecrRefCount(vfsInitScript);
	}

	/*
	 * Set Tcl Encodings
	 */

	if (!zipfs_literal_tcl_library) {
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    found = Tcl_FSAccess(vfsInitScript, F_OK);
	    Tcl_DecrRefCount(vfsInitScript);
	    if (found == TCL_OK) {
		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
		return TCL_OK;
	    }
	}
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
    } else if (*argcPtr > 1) {
	/*
	 * If the first argument is "install", run the supplied installer
	 * script.
	 */

#ifdef _WIN32
	Tcl_DString ds;

	archive = Tcl_WinTCharToUtf((*argvPtr)[1], -1, &ds);
#else /* !_WIN32 */
	archive = (*argvPtr)[1];
#endif /* _WIN32 */
	if (strcmp(archive, "install") == 0) {
	    Tcl_Obj *vfsInitScript;

	    /*
	     * Run this now to ensure the file is present by the time Tcl_Main
	     * wants it.
	     */

	    TclZipfs_TclLibrary();
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
		Tcl_SetStartupScript(vfsInitScript, NULL);
	    }
	    return TCL_OK;
	} else if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
	    int found;
	    Tcl_Obj *vfsInitScript;

	    TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
		/*
		 * Startup script should be set before calling Tcl_AppInit
		 */

		Tcl_SetStartupScript(vfsInitScript, NULL);
	    } else {
		Tcl_DecrRefCount(vfsInitScript);
	    }
	    /* Set Tcl Encodings */
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    found = Tcl_FSAccess(vfsInitScript, F_OK);
	    Tcl_DecrRefCount(vfsInitScript);
	    if (found == TCL_OK) {
		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
		return TCL_OK;
	    }
	}
#ifdef _WIN32
	Tcl_DStringFree(&ds);
#endif /* _WIN32 */
#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
    }
    return TCL_OK;
}

#ifndef HAVE_ZLIB

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Mount, TclZipfs_MountBuffer, TclZipfs_Unmount --
 *
 *	Dummy version when no ZLIB support available.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Mount(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *mountPoint,	/* Mount point path. */
    const char *zipname,	/* Path to ZIP file to mount. */
    const char *passwd)		/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
{
    ZIPFS_ERROR(interp, "no zlib available");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    return TCL_ERROR;
}

int
TclZipfs_MountBuffer(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint,	/* Mount point path. */
    unsigned char *data,
    size_t datalen,
    int copy)
{
    ZIPFS_ERROR(interp, "no zlib available");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    return TCL_ERROR;
}

int
TclZipfs_Unmount(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *mountPoint)	/* Mount point path. */
{
    ZIPFS_ERROR(interp, "no zlib available");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    return TCL_ERROR;
}
#endif /* !HAVE_ZLIB */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclZlib.c.
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
typedef struct {
    Tcl_Interp *interp;
    z_stream stream;		/* The interface to the zlib library. */
    int streamEnd;		/* If we've got to end-of-stream. */
    Tcl_Obj *inData, *outData;	/* Input / output buffers (lists) */
    Tcl_Obj *currentInput;	/* Pointer to what is currently being
				 * inflated. */
    int outPos;
    int mode;			/* Either TCL_ZLIB_STREAM_DEFLATE or
				 * TCL_ZLIB_STREAM_INFLATE. */
    int format;			/* Flags from the TCL_ZLIB_FORMAT_* */
    int level;			/* Default 5, 0-9 */
    int flush;			/* Stores the flush param for deferred the
				 * decompression. */
    int wbits;			/* The encoded compression mode, so we can







|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
typedef struct {
    Tcl_Interp *interp;
    z_stream stream;		/* The interface to the zlib library. */
    int streamEnd;		/* If we've got to end-of-stream. */
    Tcl_Obj *inData, *outData;	/* Input / output buffers (lists) */
    Tcl_Obj *currentInput;	/* Pointer to what is currently being
				 * inflated. */
    size_t outPos;
    int mode;			/* Either TCL_ZLIB_STREAM_DEFLATE or
				 * TCL_ZLIB_STREAM_INFLATE. */
    int format;			/* Flags from the TCL_ZLIB_FORMAT_* */
    int level;			/* Default 5, 0-9 */
    int flush;			/* Stores the flush param for deferred the
				 * decompression. */
    int wbits;			/* The encoded compression mode, so we can
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
    int readAheadLimit;		/* The maximum number of bytes to read from
				 * the underlying stream in one go. */
    z_stream inStream;		/* Structure used by zlib for decompression of
				 * input. */
    z_stream outStream;		/* Structure used by zlib for compression of
				 * output. */
    char *inBuffer, *outBuffer;	/* Working buffers. */
    int inAllocated, outAllocated;
				/* Sizes of working buffers. */
    GzipHeader inHeader;	/* Header read from input stream, when
				 * decompressing a gzip stream. */
    GzipHeader outHeader;	/* Header to write to an output stream, when
				 * compressing a gzip stream. */
    Tcl_TimerToken timer;	/* Timer used for keeping events fresh. */
    Tcl_DString decompressed;	/* Buffer for decompression results. */







|







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
    int readAheadLimit;		/* The maximum number of bytes to read from
				 * the underlying stream in one go. */
    z_stream inStream;		/* Structure used by zlib for decompression of
				 * input. */
    z_stream outStream;		/* Structure used by zlib for compression of
				 * output. */
    char *inBuffer, *outBuffer;	/* Working buffers. */
    size_t inAllocated, outAllocated;
				/* Sizes of working buffers. */
    GzipHeader inHeader;	/* Header read from input stream, when
				 * decompressing a gzip stream. */
    GzipHeader outHeader;	/* Header to write to an output stream, when
				 * compressing a gzip stream. */
    Tcl_TimerToken timer;	/* Timer used for keeping events fresh. */
    Tcl_DString decompressed;	/* Buffer for decompression results. */
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
static Tcl_ObjCmdProc		ZlibStreamHeaderCmd;
static Tcl_ObjCmdProc		ZlibStreamPutCmd;

static void		ConvertError(Tcl_Interp *interp, int code,
			    uLong adler);
static Tcl_Obj *	ConvertErrorToList(int code, uLong adler);
static inline int	Deflate(z_streamp strm, void *bufferPtr,
			    int bufferSize, int flush, int *writtenPtr);
static void		ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
static int		GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
			    GzipHeader *headerPtr, int *extraSizePtr);
static int		ZlibPushSubcmd(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static inline int	ResultCopy(ZlibChannelData *cd, char *buf,
			    int toRead);







|







174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
static Tcl_ObjCmdProc		ZlibStreamHeaderCmd;
static Tcl_ObjCmdProc		ZlibStreamPutCmd;

static void		ConvertError(Tcl_Interp *interp, int code,
			    uLong adler);
static Tcl_Obj *	ConvertErrorToList(int code, uLong adler);
static inline int	Deflate(z_streamp strm, void *bufferPtr,
			    size_t bufferSize, int flush, size_t *writtenPtr);
static void		ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
static int		GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
			    GzipHeader *headerPtr, int *extraSizePtr);
static int		ZlibPushSubcmd(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static inline int	ResultCopy(ZlibChannelData *cd, char *buf,
			    int toRead);
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
    if (latin1enc == NULL) {
	Tcl_Panic("no latin-1 encoding");
    }

    if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	valueStr = TclGetStringFromObj(value, &len);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL,
		headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
		NULL);
	headerPtr->nativeCommentBuf[len] = '\0';
	headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
    }

    if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL &&
	    Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) {
	goto error;
    }

    if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	valueStr = TclGetStringFromObj(value, &len);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL,
		headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);
	headerPtr->nativeFilenameBuf[len] = '\0';
	headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
    }







|
|



















|
|







436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
    if (latin1enc == NULL) {
	Tcl_Panic("no latin-1 encoding");
    }

    if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	valueStr = TclGetString(value);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, value->length, 0, NULL,
		headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
		NULL);
	headerPtr->nativeCommentBuf[len] = '\0';
	headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
    }

    if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL &&
	    Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) {
	goto error;
    }

    if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	valueStr = TclGetString(value);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, value->length, 0, NULL,
		headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);
	headerPtr->nativeFilenameBuf[len] = '\0';
	headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
    }
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645

static int
SetInflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	int length;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);

	return inflateSetDictionary(strm, bytes, (unsigned) length);
    }
    return Z_OK;
}

static int
SetDeflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	int length;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);

	return deflateSetDictionary(strm, bytes, (unsigned) length);
    }
    return Z_OK;
}

static inline int
Deflate(
    z_streamp strm,
    void *bufferPtr,
    int bufferSize,
    int flush,
    int *writtenPtr)
{
    int e;

    strm->next_out = (Bytef *) bufferPtr;
    strm->avail_out = (unsigned) bufferSize;
    e = deflate(strm, flush);
    if (writtenPtr != NULL) {
	*writtenPtr = bufferSize - strm->avail_out;
    }
    return e;
}

static inline void
AppendByteArray(
    Tcl_Obj *listObj,
    void *buffer,
    int size)
{
    if (size > 0) {
	Tcl_Obj *baObj = Tcl_NewByteArrayObj((unsigned char *) buffer, size);

	Tcl_ListObjAppendElement(NULL, listObj, baObj);
    }
}







|
|

|










|
|

|








|

|



|
|











|







586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645

static int
SetInflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	size_t length;
	unsigned char *bytes = TclGetByteArrayFromObj(compDictObj, &length);

	return inflateSetDictionary(strm, bytes, length);
    }
    return Z_OK;
}

static int
SetDeflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	size_t length;
	unsigned char *bytes = TclGetByteArrayFromObj(compDictObj, &length);

	return deflateSetDictionary(strm, bytes, length);
    }
    return Z_OK;
}

static inline int
Deflate(
    z_streamp strm,
    void *bufferPtr,
    size_t bufferSize,
    int flush,
    size_t *writtenPtr)
{
    int e;

    strm->next_out = bufferPtr;
    strm->avail_out = bufferSize;
    e = deflate(strm, flush);
    if (writtenPtr != NULL) {
	*writtenPtr = bufferSize - strm->avail_out;
    }
    return e;
}

static inline void
AppendByteArray(
    Tcl_Obj *listObj,
    void *buffer,
    size_t size)
{
    if (size > 0) {
	Tcl_Obj *baObj = Tcl_NewByteArrayObj((unsigned char *) buffer, size);

	Tcl_ListObjAppendElement(NULL, listObj, baObj);
    }
}
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
	switch (format) {
	case TCL_ZLIB_FORMAT_RAW:
	    wbits = WBITS_RAW;
	    break;
	case TCL_ZLIB_FORMAT_GZIP:
	    wbits = WBITS_GZIP;
	    if (dictObj) {
		gzHeaderPtr = ckalloc(sizeof(GzipHeader));
		memset(gzHeaderPtr, 0, sizeof(GzipHeader));
		if (GenerateHeader(interp, dictObj, gzHeaderPtr,
			NULL) != TCL_OK) {
		    ckfree(gzHeaderPtr);
		    return TCL_ERROR;
		}
	    }
	    break;
	case TCL_ZLIB_FORMAT_ZLIB:
	    wbits = WBITS_ZLIB;
	    break;







|



|







693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
	switch (format) {
	case TCL_ZLIB_FORMAT_RAW:
	    wbits = WBITS_RAW;
	    break;
	case TCL_ZLIB_FORMAT_GZIP:
	    wbits = WBITS_GZIP;
	    if (dictObj) {
		gzHeaderPtr = Tcl_Alloc(sizeof(GzipHeader));
		memset(gzHeaderPtr, 0, sizeof(GzipHeader));
		if (GenerateHeader(interp, dictObj, gzHeaderPtr,
			NULL) != TCL_OK) {
		    Tcl_Free(gzHeaderPtr);
		    return TCL_ERROR;
		}
	    }
	    break;
	case TCL_ZLIB_FORMAT_ZLIB:
	    wbits = WBITS_ZLIB;
	    break;
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741

	switch (format) {
	case TCL_ZLIB_FORMAT_RAW:
	    wbits = WBITS_RAW;
	    break;
	case TCL_ZLIB_FORMAT_GZIP:
	    wbits = WBITS_GZIP;
	    gzHeaderPtr = ckalloc(sizeof(GzipHeader));
	    memset(gzHeaderPtr, 0, sizeof(GzipHeader));
	    gzHeaderPtr->header.name = (Bytef *)
		    gzHeaderPtr->nativeFilenameBuf;
	    gzHeaderPtr->header.name_max = MAXPATHLEN - 1;
	    gzHeaderPtr->header.comment = (Bytef *)
		    gzHeaderPtr->nativeCommentBuf;
	    gzHeaderPtr->header.name_max = MAX_COMMENT_LEN - 1;







|







727
728
729
730
731
732
733
734
735
736
737
738
739
740
741

	switch (format) {
	case TCL_ZLIB_FORMAT_RAW:
	    wbits = WBITS_RAW;
	    break;
	case TCL_ZLIB_FORMAT_GZIP:
	    wbits = WBITS_GZIP;
	    gzHeaderPtr = Tcl_Alloc(sizeof(GzipHeader));
	    memset(gzHeaderPtr, 0, sizeof(GzipHeader));
	    gzHeaderPtr->header.name = (Bytef *)
		    gzHeaderPtr->nativeFilenameBuf;
	    gzHeaderPtr->header.name_max = MAXPATHLEN - 1;
	    gzHeaderPtr->header.comment = (Bytef *)
		    gzHeaderPtr->nativeCommentBuf;
	    gzHeaderPtr->header.name_max = MAX_COMMENT_LEN - 1;
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
	}
	break;
    default:
	Tcl_Panic("bad mode, must be TCL_ZLIB_STREAM_DEFLATE or"
		" TCL_ZLIB_STREAM_INFLATE");
    }

    zshPtr = ckalloc(sizeof(ZlibStreamHandle));
    zshPtr->interp = interp;
    zshPtr->mode = mode;
    zshPtr->format = format;
    zshPtr->level = level;
    zshPtr->wbits = wbits;
    zshPtr->currentInput = NULL;
    zshPtr->streamEnd = 0;







|







753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
	}
	break;
    default:
	Tcl_Panic("bad mode, must be TCL_ZLIB_STREAM_DEFLATE or"
		" TCL_ZLIB_STREAM_INFLATE");
    }

    zshPtr = Tcl_Alloc(sizeof(ZlibStreamHandle));
    zshPtr->interp = interp;
    zshPtr->mode = mode;
    zshPtr->format = format;
    zshPtr->level = level;
    zshPtr->wbits = wbits;
    zshPtr->currentInput = NULL;
    zshPtr->streamEnd = 0;
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
    return TCL_OK;

  error:
    if (zshPtr->compDictObj) {
	Tcl_DecrRefCount(zshPtr->compDictObj);
    }
    if (zshPtr->gzHeaderPtr) {
	ckfree(zshPtr->gzHeaderPtr);
    }
    ckfree(zshPtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibStreamCmdDelete --







|

|







853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
    return TCL_OK;

  error:
    if (zshPtr->compDictObj) {
	Tcl_DecrRefCount(zshPtr->compDictObj);
    }
    if (zshPtr->gzHeaderPtr) {
	Tcl_Free(zshPtr->gzHeaderPtr);
    }
    Tcl_Free(zshPtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibStreamCmdDelete --
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
    if (zshPtr->currentInput) {
	Tcl_DecrRefCount(zshPtr->currentInput);
    }
    if (zshPtr->compDictObj) {
	Tcl_DecrRefCount(zshPtr->compDictObj);
    }
    if (zshPtr->gzHeaderPtr) {
	ckfree(zshPtr->gzHeaderPtr);
    }

    ckfree(zshPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamReset --
 *







|


|







966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
    if (zshPtr->currentInput) {
	Tcl_DecrRefCount(zshPtr->currentInput);
    }
    if (zshPtr->compDictObj) {
	Tcl_DecrRefCount(zshPtr->compDictObj);
    }
    if (zshPtr->gzHeaderPtr) {
	Tcl_Free(zshPtr->gzHeaderPtr);
    }

    Tcl_Free(zshPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamReset --
 *
1184
1185
1186
1187
1188
1189
1190

1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
    Tcl_Obj *data,		/* Data to compress/decompress */
    int flush)			/* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH,
				 * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    char *dataTmp = NULL;

    int e, size, outSize, toStore;

    if (zshPtr->streamEnd) {
	if (zshPtr->interp) {
	    Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
		    "already past compressed stream end", -1));
	    Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL);
	}
	return TCL_ERROR;
    }

    if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
	zshPtr->stream.next_in = Tcl_GetByteArrayFromObj(data, &size);
	zshPtr->stream.avail_in = size;

	/*
	 * Must not do a zero-length compress unless finalizing. [Bug 25842c161]
	 */

	if (size == 0 && flush != Z_FINISH) {







>
|











|







1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
    Tcl_Obj *data,		/* Data to compress/decompress */
    int flush)			/* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH,
				 * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    char *dataTmp = NULL;
    int e;
    size_t size, outSize, toStore;

    if (zshPtr->streamEnd) {
	if (zshPtr->interp) {
	    Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
		    "already past compressed stream end", -1));
	    Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL);
	}
	return TCL_ERROR;
    }

    if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
	zshPtr->stream.next_in = TclGetByteArrayFromObj(data, &size);
	zshPtr->stream.avail_in = size;

	/*
	 * Must not do a zero-length compress unless finalizing. [Bug 25842c161]
	 */

	if (size == 0 && flush != Z_FINISH) {
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
	 * size.
	 */

	outSize = deflateBound(&zshPtr->stream, size) + 100;
	if (outSize > BUFFER_SIZE_LIMIT) {
	    outSize = BUFFER_SIZE_LIMIT;
	}
	dataTmp = ckalloc(outSize);

	while (1) {
	    e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore);

	    /*
	     * Test if we've filled the buffer up and have to ask deflate() to
	     * give us some more. Note that the condition for needing to
	     * repeat a buffer transfer when the result is Z_OK is whether
	     * there is no more space in the buffer we provided; the zlib
	     * library does not necessarily return a different code in that
	     * case. [Bug b26e38a3e4] [Tk Bug 10f2e7872b]
	     */

	    if ((e != Z_BUF_ERROR) && (e != Z_OK || toStore < outSize)) {
		if ((e == Z_OK) || (flush == Z_FINISH && e == Z_STREAM_END)) {
		    break;
		}
		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
		return TCL_ERROR;
	    }

	    /*
	     * Output buffer too small to hold the data being generated or we
	     * are doing the end-of-stream flush (which can spit out masses of
	     * data). This means we need to put a new buffer into place after
	     * saving the old generated data to the outData list.
	     */

	    AppendByteArray(zshPtr->outData, dataTmp, outSize);

	    if (outSize < BUFFER_SIZE_LIMIT) {
		outSize = BUFFER_SIZE_LIMIT;
		/* There may be *lots* of data left to output... */
		dataTmp = ckrealloc(dataTmp, outSize);
	    }
	}

	/*
	 * And append the final data block to the outData list.
	 */

	AppendByteArray(zshPtr->outData, dataTmp, toStore);
	ckfree(dataTmp);
    } else {
	/*
	 * This is easy. Just append to the inData list.
	 */

	Tcl_ListObjAppendElement(NULL, zshPtr->inData, data);








|













|



















|








|







1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
	 * size.
	 */

	outSize = deflateBound(&zshPtr->stream, size) + 100;
	if (outSize > BUFFER_SIZE_LIMIT) {
	    outSize = BUFFER_SIZE_LIMIT;
	}
	dataTmp = Tcl_Alloc(outSize);

	while (1) {
	    e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore);

	    /*
	     * Test if we've filled the buffer up and have to ask deflate() to
	     * give us some more. Note that the condition for needing to
	     * repeat a buffer transfer when the result is Z_OK is whether
	     * there is no more space in the buffer we provided; the zlib
	     * library does not necessarily return a different code in that
	     * case. [Bug b26e38a3e4] [Tk Bug 10f2e7872b]
	     */

	    if ((e != Z_BUF_ERROR) && (e != Z_OK || (size_t)(unsigned)toStore < outSize)) {
		if ((e == Z_OK) || (flush == Z_FINISH && e == Z_STREAM_END)) {
		    break;
		}
		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
		return TCL_ERROR;
	    }

	    /*
	     * Output buffer too small to hold the data being generated or we
	     * are doing the end-of-stream flush (which can spit out masses of
	     * data). This means we need to put a new buffer into place after
	     * saving the old generated data to the outData list.
	     */

	    AppendByteArray(zshPtr->outData, dataTmp, outSize);

	    if (outSize < BUFFER_SIZE_LIMIT) {
		outSize = BUFFER_SIZE_LIMIT;
		/* There may be *lots* of data left to output... */
		dataTmp = Tcl_Realloc(dataTmp, outSize);
	    }
	}

	/*
	 * And append the final data block to the outData list.
	 */

	AppendByteArray(zshPtr->outData, dataTmp, toStore);
	Tcl_Free(dataTmp);
    } else {
	/*
	 * This is easy. Just append to the inData list.
	 */

	Tcl_ListObjAppendElement(NULL, zshPtr->inData, data);

1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314

1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
 *----------------------------------------------------------------------
 */

int
Tcl_ZlibStreamGet(
    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
    Tcl_Obj *data,		/* A place to append the data. */
    int count)			/* Number of bytes to grab as a maximum, you
				 * may get less! */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    int e, i, listLen, itemLen, dataPos = 0;

    Tcl_Obj *itemObj;
    unsigned char *dataPtr, *itemPtr;
    int existing;

    /*
     * Getting beyond the of stream, just return empty string.
     */

    if (zshPtr->streamEnd) {
	return TCL_OK;
    }

    (void) Tcl_GetByteArrayFromObj(data, &existing);

    if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) {
	if (count == -1) {
	    /*
	     * The only safe thing to do is restict to 65k. We might cause a
	     * panic for out of memory if we just kept growing the buffer.
	     */

	    count = MAX_BUFFER_SIZE;
	}







|



|
>


|









|


|







1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
 *----------------------------------------------------------------------
 */

int
Tcl_ZlibStreamGet(
    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
    Tcl_Obj *data,		/* A place to append the data. */
    size_t count)			/* Number of bytes to grab as a maximum, you
				 * may get less! */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    int e, i, listLen;
    size_t itemLen, dataPos = 0;
    Tcl_Obj *itemObj;
    unsigned char *dataPtr, *itemPtr;
    size_t existing;

    /*
     * Getting beyond the of stream, just return empty string.
     */

    if (zshPtr->streamEnd) {
	return TCL_OK;
    }

    (void) TclGetByteArrayFromObj(data, &existing);

    if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) {
	if (count == TCL_AUTO_LENGTH) {
	    /*
	     * The only safe thing to do is restict to 65k. We might cause a
	     * panic for out of memory if we just kept growing the buffer.
	     */

	    count = MAX_BUFFER_SIZE;
	}
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
		 * under our feet. [Bug 3081008]
		 */

		Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj);
		if (Tcl_IsShared(itemObj)) {
		    itemObj = Tcl_DuplicateObj(itemObj);
		}
		itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
		Tcl_IncrRefCount(itemObj);
		zshPtr->currentInput = itemObj;
		zshPtr->stream.next_in = itemPtr;
		zshPtr->stream.avail_in = itemLen;

		/*
		 * And remove it from the list







|







1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
		 * under our feet. [Bug 3081008]
		 */

		Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj);
		if (Tcl_IsShared(itemObj)) {
		    itemObj = Tcl_DuplicateObj(itemObj);
		}
		itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen);
		Tcl_IncrRefCount(itemObj);
		zshPtr->currentInput = itemObj;
		zshPtr->stream.next_in = itemPtr;
		zshPtr->stream.avail_in = itemLen;

		/*
		 * And remove it from the list
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
	     * representation to not vanish under our feet. [Bug 3081008]
	     */

	    Tcl_ListObjIndex(zshPtr->interp, zshPtr->inData, 0, &itemObj);
	    if (Tcl_IsShared(itemObj)) {
		itemObj = Tcl_DuplicateObj(itemObj);
	    }
	    itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
	    Tcl_IncrRefCount(itemObj);
	    zshPtr->currentInput = itemObj;
	    zshPtr->stream.next_in = itemPtr;
	    zshPtr->stream.avail_in = itemLen;

	    /*
	     * Remove it from the list.







|







1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
	     * representation to not vanish under our feet. [Bug 3081008]
	     */

	    Tcl_ListObjIndex(zshPtr->interp, zshPtr->inData, 0, &itemObj);
	    if (Tcl_IsShared(itemObj)) {
		itemObj = Tcl_DuplicateObj(itemObj);
	    }
	    itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen);
	    Tcl_IncrRefCount(itemObj);
	    zshPtr->currentInput = itemObj;
	    zshPtr->stream.next_in = itemPtr;
	    zshPtr->stream.avail_in = itemLen;

	    /*
	     * Remove it from the list.
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
		Tcl_DecrRefCount(zshPtr->currentInput);
		zshPtr->currentInput = 0;
	    }
	    inflateEnd(&zshPtr->stream);
	}
    } else {
	Tcl_ListObjLength(NULL, zshPtr->outData, &listLen);
	if (count == -1) {
	    count = 0;
	    for (i=0; i<listLen; i++) {
		Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
		itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
		if (i == 0) {
		    count += itemLen - zshPtr->outPos;
		} else {
		    count += itemLen;
		}
	    }
	}







|



|







1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
		Tcl_DecrRefCount(zshPtr->currentInput);
		zshPtr->currentInput = 0;
	    }
	    inflateEnd(&zshPtr->stream);
	}
    } else {
	Tcl_ListObjLength(NULL, zshPtr->outData, &listLen);
	if (count == TCL_AUTO_LENGTH) {
	    count = 0;
	    for (i=0; i<listLen; i++) {
		Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
		itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen);
		if (i == 0) {
		    count += itemLen - zshPtr->outPos;
		} else {
		    count += itemLen;
		}
	    }
	}
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
		&& (listLen > 0)) {
	    /*
	     * Get the next chunk off our list of chunks and grab the data out
	     * of it.
	     */

	    Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
	    itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
	    if (itemLen-zshPtr->outPos >= count-dataPos) {
		unsigned len = count - dataPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		zshPtr->outPos += len;
		dataPos += len;
		if (zshPtr->outPos == itemLen) {
		    zshPtr->outPos = 0;
		}
	    } else {
		unsigned len = itemLen - zshPtr->outPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		dataPos += len;
		zshPtr->outPos = 0;
	    }
	    if (zshPtr->outPos == 0) {
		Tcl_ListObjReplace(NULL, zshPtr->outData, 0, 1, 0, NULL);







|
|
|








|







1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
		&& (listLen > 0)) {
	    /*
	     * Get the next chunk off our list of chunks and grab the data out
	     * of it.
	     */

	    Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
	    itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen);
	    if (itemLen-zshPtr->outPos >= (size_t)(count-dataPos)) {
		size_t len = count - dataPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		zshPtr->outPos += len;
		dataPos += len;
		if (zshPtr->outPos == itemLen) {
		    zshPtr->outPos = 0;
		}
	    } else {
		size_t len = itemLen - zshPtr->outPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		dataPos += len;
		zshPtr->outPos = 0;
	    }
	    if (zshPtr->outPos == 0) {
		Tcl_ListObjReplace(NULL, zshPtr->outData, 0, 1, 0, NULL);
1556
1557
1558
1559
1560
1561
1562
1563

1564
1565
1566
1567
1568
1569
1570
Tcl_ZlibDeflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    int level,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, inLen = 0, e = 0, extraSize = 0;

    Byte *inData = NULL;
    z_stream stream;
    GzipHeader header;
    gz_header *headerPtr = NULL;
    Tcl_Obj *obj;

    if (!interp) {







|
>







1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
Tcl_ZlibDeflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    int level,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, e = 0, extraSize = 0;
    size_t inLen = 0;
    Byte *inData = NULL;
    z_stream stream;
    GzipHeader header;
    gz_header *headerPtr = NULL;
    Tcl_Obj *obj;

    if (!interp) {
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
    TclNewObj(obj);

    /*
     * Obtain the pointer to the byte array, we'll pass this pointer straight
     * to the deflate command.
     */

    inData = Tcl_GetByteArrayFromObj(data, &inLen);
    memset(&stream, 0, sizeof(z_stream));
    stream.avail_in = (uInt) inLen;
    stream.next_in = inData;

    /*
     * No output buffer available yet, will alloc after deflateInit2.
     */

    e = deflateInit2(&stream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL,







|

|







1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
    TclNewObj(obj);

    /*
     * Obtain the pointer to the byte array, we'll pass this pointer straight
     * to the deflate command.
     */

    inData = TclGetByteArrayFromObj(data, &inLen);
    memset(&stream, 0, sizeof(z_stream));
    stream.avail_in = inLen;
    stream.next_in = inData;

    /*
     * No output buffer available yet, will alloc after deflateInit2.
     */

    e = deflateInit2(&stream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL,
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713

1714
1715
1716
1717
1718
1719
1720
 */

int
Tcl_ZlibInflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    int bufferSize,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, inLen = 0, e = 0, newBufferSize;

    Byte *inData = NULL, *outData = NULL, *newOutData = NULL;
    z_stream stream;
    gz_header header, *headerPtr = NULL;
    Tcl_Obj *obj;
    char *nameBuf = NULL, *commentBuf = NULL;

    if (!interp) {







|


|
>







1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
 */

int
Tcl_ZlibInflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    size_t bufferSize,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, e = 0;
    size_t inLen = 0, newBufferSize;
    Byte *inData = NULL, *outData = NULL, *newOutData = NULL;
    z_stream stream;
    gz_header header, *headerPtr = NULL;
    Tcl_Obj *obj;
    char *nameBuf = NULL, *commentBuf = NULL;

    if (!interp) {
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
		"TCL_ZLIB_FORMAT_GZIP, TCL_ZLIB_FORMAT_RAW or "
		"TCL_ZLIB_FORMAT_AUTO");
    }

    if (gzipHeaderDictObj) {
	headerPtr = &header;
	memset(headerPtr, 0, sizeof(gz_header));
	nameBuf = ckalloc(MAXPATHLEN);
	header.name = (Bytef *) nameBuf;
	header.name_max = MAXPATHLEN - 1;
	commentBuf = ckalloc(MAX_COMMENT_LEN);
	header.comment = (Bytef *) commentBuf;
	header.comm_max = MAX_COMMENT_LEN - 1;
    }

    inData = Tcl_GetByteArrayFromObj(data, &inLen);
    if (bufferSize < 1) {
	/*
	 * Start with a buffer (up to) 3 times the size of the input data.
	 */

	if (inLen < 32*1024*1024) {
	    bufferSize = 3*inLen;
	} else if (inLen < 256*1024*1024) {
	    bufferSize = 2*inLen;
	} else {
	    bufferSize = inLen;
	}
    }

    TclNewObj(obj);
    outData = Tcl_SetByteArrayLength(obj, bufferSize);
    memset(&stream, 0, sizeof(z_stream));
    stream.avail_in = (uInt) inLen+1;	/* +1 because zlib can "over-request"
					 * input (but ignore it!) */
    stream.next_in = inData;
    stream.avail_out = bufferSize;
    stream.next_out = outData;

    /*
     * Initialize zlib for decompression.







|


|




|

















|







1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
		"TCL_ZLIB_FORMAT_GZIP, TCL_ZLIB_FORMAT_RAW or "
		"TCL_ZLIB_FORMAT_AUTO");
    }

    if (gzipHeaderDictObj) {
	headerPtr = &header;
	memset(headerPtr, 0, sizeof(gz_header));
	nameBuf = Tcl_Alloc(MAXPATHLEN);
	header.name = (Bytef *) nameBuf;
	header.name_max = MAXPATHLEN - 1;
	commentBuf = Tcl_Alloc(MAX_COMMENT_LEN);
	header.comment = (Bytef *) commentBuf;
	header.comm_max = MAX_COMMENT_LEN - 1;
    }

    inData = TclGetByteArrayFromObj(data, &inLen);
    if (bufferSize < 1) {
	/*
	 * Start with a buffer (up to) 3 times the size of the input data.
	 */

	if (inLen < 32*1024*1024) {
	    bufferSize = 3*inLen;
	} else if (inLen < 256*1024*1024) {
	    bufferSize = 2*inLen;
	} else {
	    bufferSize = inLen;
	}
    }

    TclNewObj(obj);
    outData = Tcl_SetByteArrayLength(obj, bufferSize);
    memset(&stream, 0, sizeof(z_stream));
    stream.avail_in = inLen+1;	/* +1 because zlib can "over-request"
					 * input (but ignore it!) */
    stream.next_in = inData;
    stream.avail_out = bufferSize;
    stream.next_out = outData;

    /*
     * Initialize zlib for decompression.
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927

1928
1929
1930
1931
1932
1933
1934
     */

    Tcl_SetByteArrayLength(obj, stream.total_out);
    if (headerPtr != NULL) {
	ExtractHeader(&header, gzipHeaderDictObj);
	SetValue(gzipHeaderDictObj, "size",
		Tcl_NewLongObj((long) stream.total_out));
	ckfree(nameBuf);
	ckfree(commentBuf);
    }
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;

  error:
    TclDecrRefCount(obj);
    ConvertError(interp, e, stream.adler);
    if (nameBuf) {
	ckfree(nameBuf);
    }
    if (commentBuf) {
	ckfree(commentBuf);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibCRC32, Tcl_ZlibAdler32 --
 *
 *	Access to the checksumming engines.
 *
 *----------------------------------------------------------------------
 */

unsigned int
Tcl_ZlibCRC32(
    unsigned int crc,
    const unsigned char *buf,
    int len)
{
    /* Nothing much to do, just wrap the crc32(). */
    return crc32(crc, (Bytef *) buf, (unsigned) len);
}

unsigned int
Tcl_ZlibAdler32(
    unsigned int adler,
    const unsigned char *buf,
    int len)
{
    return adler32(adler, (Bytef *) buf, (unsigned) len);
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibCmd --
 *
 *	Implementation of the [zlib] command.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibCmd(
    ClientData notUsed,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int command, dlen, i, option, level = -1;
    unsigned start, buffersize = 0;

    Byte *data;
    Tcl_Obj *headerDictObj;
    const char *extraInfoStr = NULL;
    static const char *const commands[] = {
	"adler32", "compress", "crc32", "decompress", "deflate", "gunzip",
	"gzip", "inflate", "push", "stream",
	NULL







|
|








|


|


















|


|






|

|



















|
|
>







1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
     */

    Tcl_SetByteArrayLength(obj, stream.total_out);
    if (headerPtr != NULL) {
	ExtractHeader(&header, gzipHeaderDictObj);
	SetValue(gzipHeaderDictObj, "size",
		Tcl_NewLongObj((long) stream.total_out));
	Tcl_Free(nameBuf);
	Tcl_Free(commentBuf);
    }
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;

  error:
    TclDecrRefCount(obj);
    ConvertError(interp, e, stream.adler);
    if (nameBuf) {
	Tcl_Free(nameBuf);
    }
    if (commentBuf) {
	Tcl_Free(commentBuf);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibCRC32, Tcl_ZlibAdler32 --
 *
 *	Access to the checksumming engines.
 *
 *----------------------------------------------------------------------
 */

unsigned int
Tcl_ZlibCRC32(
    unsigned int crc,
    const unsigned char *buf,
    size_t len)
{
    /* Nothing much to do, just wrap the crc32(). */
    return crc32(crc, (Bytef *) buf, len);
}

unsigned int
Tcl_ZlibAdler32(
    unsigned int adler,
    const unsigned char *buf,
    size_t len)
{
    return adler32(adler, (Bytef *) buf, len);
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibCmd --
 *
 *	Implementation of the [zlib] command.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibCmd(
    ClientData notUsed,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int command, i, option, level = -1;
    size_t dlen, start, buffersize = 0;
    Tcl_WideInt wideLen;
    Byte *data;
    Tcl_Obj *headerDictObj;
    const char *extraInfoStr = NULL;
    static const char *const commands[] = {
	"adler32", "compress", "crc32", "decompress", "deflate", "gunzip",
	"gzip", "inflate", "push", "stream",
	NULL
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
	if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
		(int *) &start) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc < 4) {
	    start = Tcl_ZlibAdler32(0, NULL, 0);
	}
	data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
		(uLong) Tcl_ZlibAdler32(start, data, dlen)));
	return TCL_OK;
    case CMD_CRC:			/* crc32 str ?startvalue?
					 * -> checksum */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?");
	    return TCL_ERROR;
	}
	if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
		(int *) &start) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc < 4) {
	    start = Tcl_ZlibCRC32(0, NULL, 0);
	}
	data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
		(uLong) Tcl_ZlibCRC32(start, data, dlen)));
	return TCL_OK;
    case CMD_DEFLATE:			/* deflate data ?level?
					 * -> rawCompressedData */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?level?");







|
















|







1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
	if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
		(int *) &start) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc < 4) {
	    start = Tcl_ZlibAdler32(0, NULL, 0);
	}
	data = TclGetByteArrayFromObj(objv[2], &dlen);
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
		(uLong) Tcl_ZlibAdler32(start, data, dlen)));
	return TCL_OK;
    case CMD_CRC:			/* crc32 str ?startvalue?
					 * -> checksum */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?");
	    return TCL_ERROR;
	}
	if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
		(int *) &start) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc < 4) {
	    start = Tcl_ZlibCRC32(0, NULL, 0);
	}
	data = TclGetByteArrayFromObj(objv[2], &dlen);
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
		(uLong) Tcl_ZlibCRC32(start, data, dlen)));
	return TCL_OK;
    case CMD_DEFLATE:			/* deflate data ?level?
					 * -> rawCompressedData */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?level?");
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081

2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100

2101
2102
2103
2104
2105
2106
2107
    case CMD_INFLATE:			/* inflate rawcomprdata ?bufferSize?
					 *	-> decompressedData */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?");
	    return TCL_ERROR;
	}
	if (objc > 3) {
	    if (Tcl_GetIntFromObj(interp, objv[3],
		    (int *) &buffersize) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
		    || buffersize > MAX_BUFFER_SIZE) {
		goto badBuffer;
	    }

	}
	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2],
		buffersize, NULL);
    case CMD_DECOMPRESS:		/* decompress zlibcomprdata \
					 *    ?bufferSize?
					 *	-> decompressedData */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?");
	    return TCL_ERROR;
	}
	if (objc > 3) {
	    if (Tcl_GetIntFromObj(interp, objv[3],
		    (int *) &buffersize) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
		    || buffersize > MAX_BUFFER_SIZE) {
		goto badBuffer;
	    }

	}
	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2],
		buffersize, NULL);
    case CMD_GUNZIP: {			/* gunzip gzippeddata ?bufferSize?
					 *	-> decompressedData */
	Tcl_Obj *headerVarObj;








|
|


|
|


>











|
|


|
|


>







2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
    case CMD_INFLATE:			/* inflate rawcomprdata ?bufferSize?
					 *	-> decompressedData */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?");
	    return TCL_ERROR;
	}
	if (objc > 3) {
	    if (Tcl_GetWideIntFromObj(interp, objv[3],
		    &wideLen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (wideLen < MIN_NONSTREAM_BUFFER_SIZE
		    || wideLen > MAX_BUFFER_SIZE) {
		goto badBuffer;
	    }
	    buffersize = wideLen;
	}
	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2],
		buffersize, NULL);
    case CMD_DECOMPRESS:		/* decompress zlibcomprdata \
					 *    ?bufferSize?
					 *	-> decompressedData */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?");
	    return TCL_ERROR;
	}
	if (objc > 3) {
	    if (Tcl_GetWideIntFromObj(interp, objv[3],
		    &wideLen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (wideLen < MIN_NONSTREAM_BUFFER_SIZE
		    || wideLen > MAX_BUFFER_SIZE) {
		goto badBuffer;
	    }
	    buffersize = wideLen;
	}
	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2],
		buffersize, NULL);
    case CMD_GUNZIP: {			/* gunzip gzippeddata ?bufferSize?
					 *	-> decompressedData */
	Tcl_Obj *headerVarObj;

2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131

2132
2133
2134
2135
2136
2137
2138

	    if (Tcl_GetIndexFromObj(interp, objv[i], gunzipopts, "option", 0,
		    &option) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (option) {
	    case 0:
		if (Tcl_GetIntFromObj(interp, objv[i+1],
			(int *) &buffersize) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
			|| buffersize > MAX_BUFFER_SIZE) {
		    goto badBuffer;
		}

		break;
	    case 1:
		headerVarObj = objv[i+1];
		headerDictObj = Tcl_NewObj();
		break;
	    }
	}







|
|


|
|


>







2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146

	    if (Tcl_GetIndexFromObj(interp, objv[i], gunzipopts, "option", 0,
		    &option) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (option) {
	    case 0:
		if (Tcl_GetWideIntFromObj(interp, objv[i+1],
			&wideLen) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (wideLen < MIN_NONSTREAM_BUFFER_SIZE
			|| wideLen > MAX_BUFFER_SIZE) {
		    goto badBuffer;
		}
		buffersize = wideLen;
		break;
	    case 1:
		headerVarObj = objv[i+1];
		headerDictObj = Tcl_NewObj();
		break;
	    }
	}
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	int len;

	(void) Tcl_GetByteArrayFromObj(compDictObj, &len);
	if (len == 0) {
	    compDictObj = NULL;
	}
	Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
    }

    /*







|







2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	int len;

	(void) TclGetByteArrayFromObj(compDictObj, &len);
	if (len == 0) {
	    compDictObj = NULL;
	}
	Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
    }

    /*
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
    }

    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	int len;

	(void) Tcl_GetByteArrayFromObj(compDictObj, &len);
	if (len == 0) {
	    compDictObj = NULL;
	}
	Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
    }

    /*







|

|







2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
    }

    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	size_t len;

	(void) TclGetByteArrayFromObj(compDictObj, &len);
	if (len == 0) {
	    compDictObj = NULL;
	}
	Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
    }

    /*
2892
2893
2894
2895
2896
2897
2898
2899

2900
2901
2902
2903
2904
2905
2906

static int
ZlibTransformClose(
    ClientData instanceData,
    Tcl_Interp *interp)
{
    ZlibChannelData *cd = instanceData;
    int e, written, result = TCL_OK;


    /*
     * Delete the support timer.
     */

    ZlibTransformEventTimerKill(cd);








|
>







2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915

static int
ZlibTransformClose(
    ClientData instanceData,
    Tcl_Interp *interp)
{
    ZlibChannelData *cd = instanceData;
    int e, result = TCL_OK;
    size_t written;

    /*
     * Delete the support timer.
     */

    ZlibTransformEventTimerKill(cd);

2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
		/* TODO: is this the right way to do errors on close? */
		if (!TclInThreadExit()) {
		    ConvertError(interp, e, cd->outStream.adler);
		}
		result = TCL_ERROR;
		break;
	    }
	    if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) < 0) {
		/* TODO: is this the right way to do errors on close?
		 * Note: when close is called from FinalizeIOSubsystem then
		 * interp may be NULL */
		if (!TclInThreadExit() && interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "error while finalizing file: %s",
			    Tcl_PosixError(interp)));







|







2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
		/* TODO: is this the right way to do errors on close? */
		if (!TclInThreadExit()) {
		    ConvertError(interp, e, cd->outStream.adler);
		}
		result = TCL_ERROR;
		break;
	    }
	    if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) == TCL_IO_FAILURE) {
		/* TODO: is this the right way to do errors on close?
		 * Note: when close is called from FinalizeIOSubsystem then
		 * interp may be NULL */
		if (!TclInThreadExit() && interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "error while finalizing file: %s",
			    Tcl_PosixError(interp)));
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
    if (cd->compDictObj) {
	Tcl_DecrRefCount(cd->compDictObj);
	cd->compDictObj = NULL;
    }
    Tcl_DStringFree(&cd->decompressed);

    if (cd->inBuffer) {
	ckfree(cd->inBuffer);
	cd->inBuffer = NULL;
    }
    if (cd->outBuffer) {
	ckfree(cd->outBuffer);
	cd->outBuffer = NULL;
    }
    ckfree(cd);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformInput --







|



|


|







2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
    if (cd->compDictObj) {
	Tcl_DecrRefCount(cd->compDictObj);
	cd->compDictObj = NULL;
    }
    Tcl_DStringFree(&cd->decompressed);

    if (cd->inBuffer) {
	Tcl_Free(cd->inBuffer);
	cd->inBuffer = NULL;
    }
    if (cd->outBuffer) {
	Tcl_Free(cd->outBuffer);
	cd->outBuffer = NULL;
    }
    Tcl_Free(cd);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformInput --
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049

	readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, cd->readAheadLimit);

	/*
	 * Three cases here:
	 *  1.	Got some data from the underlying channel (readBytes > 0) so
	 *	it should be fed through the decompression engine.
	 *  2.	Got an error (readBytes < 0) which we should report up except
	 *	for the case where we can convert it to a short read.
	 *  3.	Got an end-of-data from EOF or blocking (readBytes == 0). If
	 *	it is EOF, try flushing the data out of the decompressor.
	 */

	if (readBytes < 0) {

	    /* See ReflectInput() in tclIORTrans.c */
	    if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) {
		return gotBytes;
	    }

	    *errorCodePtr = Tcl_GetErrno();







|





|







3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058

	readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, cd->readAheadLimit);

	/*
	 * Three cases here:
	 *  1.	Got some data from the underlying channel (readBytes > 0) so
	 *	it should be fed through the decompression engine.
	 *  2.	Got an error (readBytes == -1) which we should report up except
	 *	for the case where we can convert it to a short read.
	 *  3.	Got an end-of-data from EOF or blocking (readBytes == 0). If
	 *	it is EOF, try flushing the data out of the decompressor.
	 */

	if (readBytes == -1) {

	    /* See ReflectInput() in tclIORTrans.c */
	    if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) {
		return gotBytes;
	    }

	    *errorCodePtr = Tcl_GetErrno();
3101
3102
3103
3104
3105
3106
3107

3108
3109
3110
3111
3112
3113
3114
3115
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    ZlibChannelData *cd = instanceData;
    Tcl_DriverOutputProc *outProc =
	    Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent));

    int e, produced;
    Tcl_Obj *errObj;

    if (cd->mode == TCL_ZLIB_STREAM_INFLATE) {
	return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
		errorCodePtr);
    }








>
|







3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    ZlibChannelData *cd = instanceData;
    Tcl_DriverOutputProc *outProc =
	    Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent));
    int e;
    size_t produced;
    Tcl_Obj *errObj;

    if (cd->mode == TCL_ZLIB_STREAM_INFLATE) {
	return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
		errorCodePtr);
    }

3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
    while (cd->outStream.avail_in > 0) {
	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
		Z_NO_FLUSH, &produced);
	if (e != Z_OK || produced == 0) {
	    break;
	}

	if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
	    *errorCodePtr = Tcl_GetErrno();
	    return -1;
	}
    }

    if (e == Z_OK) {
	return toWrite - cd->outStream.avail_in;







|







3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
    while (cd->outStream.avail_in > 0) {
	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
		Z_NO_FLUSH, &produced);
	if (e != Z_OK || produced == 0) {
	    break;
	}

	if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) == TCL_IO_FAILURE) {
	    *errorCodePtr = Tcl_GetErrno();
	    return -1;
	}
    }

    if (e == Z_OK) {
	return toWrite - cd->outStream.avail_in;
3163
3164
3165
3166
3167
3168
3169
3170

3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196

static int
ZlibTransformFlush(
    Tcl_Interp *interp,
    ZlibChannelData *cd,
    int flushType)
{
    int e, len;


    cd->outStream.avail_in = 0;
    do {
	/*
	 * Get the bytes to go out of the compression engine.
	 */

	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
		flushType, &len);
	if (e != Z_OK && e != Z_BUF_ERROR) {
	    ConvertError(interp, e, cd->outStream.adler);
	    return TCL_ERROR;
	}

	/*
	 * Write the bytes we've received to the next layer.
	 */

	if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) < 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "problem flushing channel: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*







|
>


















|







3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207

static int
ZlibTransformFlush(
    Tcl_Interp *interp,
    ZlibChannelData *cd,
    int flushType)
{
    int e;
    size_t len;

    cd->outStream.avail_in = 0;
    do {
	/*
	 * Get the bytes to go out of the compression engine.
	 */

	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
		flushType, &len);
	if (e != Z_OK && e != Z_BUF_ERROR) {
	    ConvertError(interp, e, cd->outStream.adler);
	    return TCL_ERROR;
	}

	/*
	 * Write the bytes we've received to the next layer.
	 */

	if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) == TCL_IO_FAILURE) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "problem flushing channel: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
    if (optionName && (strcmp(optionName, "-dictionary") == 0)
	    && (cd->format != TCL_ZLIB_FORMAT_GZIP)) {
	Tcl_Obj *compDictObj;
	int code;

	TclNewStringObj(compDictObj, value, strlen(value));
	Tcl_IncrRefCount(compDictObj);
	(void) Tcl_GetByteArrayFromObj(compDictObj, NULL);
	if (cd->compDictObj) {
	    TclDecrRefCount(cd->compDictObj);
	}
	cd->compDictObj = compDictObj;
	code = Z_OK;
	if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
	    code = SetDeflateDictionary(&cd->outStream, compDictObj);







|







3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
    if (optionName && (strcmp(optionName, "-dictionary") == 0)
	    && (cd->format != TCL_ZLIB_FORMAT_GZIP)) {
	Tcl_Obj *compDictObj;
	int code;

	TclNewStringObj(compDictObj, value, strlen(value));
	Tcl_IncrRefCount(compDictObj);
	Tcl_GetByteArrayFromObj(compDictObj, NULL);
	if (cd->compDictObj) {
	    TclDecrRefCount(cd->compDictObj);
	}
	cd->compDictObj = compDictObj;
	code = Z_OK;
	if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
	    code = SetDeflateDictionary(&cd->outStream, compDictObj);
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
		Tcl_DStringAppendElement(dsPtr,
			Tcl_GetString(cd->compDictObj));
	    } else {
		Tcl_DStringAppendElement(dsPtr, "");
	    }
	} else {
	    if (cd->compDictObj) {
		int len;
		const char *str = TclGetStringFromObj(cd->compDictObj, &len);

		Tcl_DStringAppend(dsPtr, str, len);
	    }
	    return TCL_OK;
	}
    }

    /*
     * The "header" option, which is only valid on inflating gzip channels,







<
|

|







3393
3394
3395
3396
3397
3398
3399

3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
		Tcl_DStringAppendElement(dsPtr,
			Tcl_GetString(cd->compDictObj));
	    } else {
		Tcl_DStringAppendElement(dsPtr, "");
	    }
	} else {
	    if (cd->compDictObj) {

		const char *str = TclGetString(cd->compDictObj);

		Tcl_DStringAppend(dsPtr, str, cd->compDictObj->length);
	    }
	    return TCL_OK;
	}
    }

    /*
     * The "header" option, which is only valid on inflating gzip channels,
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
    Tcl_Obj *gzipHeaderDictPtr,	/* A description of header to use, or NULL to
				 * use a default. Ignored if not compressing
				 * to produce gzip-format data. */
    Tcl_Obj *compDictObj)	/* Byte-array object containing compression
				 * dictionary (not dictObj!) to use if
				 * necessary. */
{
    ZlibChannelData *cd = ckalloc(sizeof(ZlibChannelData));
    Tcl_Channel chan;
    int wbits = 0;

    if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) {
	Tcl_Panic("unknown mode: %d", mode);
    }








|







3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
    Tcl_Obj *gzipHeaderDictPtr,	/* A description of header to use, or NULL to
				 * use a default. Ignored if not compressing
				 * to produce gzip-format data. */
    Tcl_Obj *compDictObj)	/* Byte-array object containing compression
				 * dictionary (not dictObj!) to use if
				 * necessary. */
{
    ZlibChannelData *cd = Tcl_Alloc(sizeof(ZlibChannelData));
    Tcl_Channel chan;
    int wbits = 0;

    if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) {
	Tcl_Panic("unknown mode: %d", mode);
    }

3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
     */

    if (mode == TCL_ZLIB_STREAM_INFLATE) {
	if (inflateInit2(&cd->inStream, wbits) != Z_OK) {
	    goto error;
	}
	cd->inAllocated = DEFAULT_BUFFER_SIZE;
	cd->inBuffer = ckalloc(cd->inAllocated);
	if (cd->flags & IN_HEADER) {
	    if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) {
		goto error;
	    }
	}
	if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) {
	    if (SetInflateDictionary(&cd->inStream, cd->compDictObj) != Z_OK) {
		goto error;
	    }
	}
    } else {
	if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
		MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) {
	    goto error;
	}
	cd->outAllocated = DEFAULT_BUFFER_SIZE;
	cd->outBuffer = ckalloc(cd->outAllocated);
	if (cd->flags & OUT_HEADER) {
	    if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) {
		goto error;
	    }
	}
	if (cd->compDictObj) {
	    if (SetDeflateDictionary(&cd->outStream, cd->compDictObj) != Z_OK) {







|
















|







3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
     */

    if (mode == TCL_ZLIB_STREAM_INFLATE) {
	if (inflateInit2(&cd->inStream, wbits) != Z_OK) {
	    goto error;
	}
	cd->inAllocated = DEFAULT_BUFFER_SIZE;
	cd->inBuffer = Tcl_Alloc(cd->inAllocated);
	if (cd->flags & IN_HEADER) {
	    if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) {
		goto error;
	    }
	}
	if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) {
	    if (SetInflateDictionary(&cd->inStream, cd->compDictObj) != Z_OK) {
		goto error;
	    }
	}
    } else {
	if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
		MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) {
	    goto error;
	}
	cd->outAllocated = DEFAULT_BUFFER_SIZE;
	cd->outBuffer = Tcl_Alloc(cd->outAllocated);
	if (cd->flags & OUT_HEADER) {
	    if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) {
		goto error;
	    }
	}
	if (cd->compDictObj) {
	    if (SetDeflateDictionary(&cd->outStream, cd->compDictObj) != Z_OK) {
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
    cd->chan = chan;
    cd->parent = Tcl_GetStackedChannel(chan);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return chan;

  error:
    if (cd->inBuffer) {
	ckfree(cd->inBuffer);
	inflateEnd(&cd->inStream);
    }
    if (cd->outBuffer) {
	ckfree(cd->outBuffer);
	deflateEnd(&cd->outStream);
    }
    if (cd->compDictObj) {
	Tcl_DecrRefCount(cd->compDictObj);
    }
    ckfree(cd);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ResultCopy --







|



|





|







3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
    cd->chan = chan;
    cd->parent = Tcl_GetStackedChannel(chan);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return chan;

  error:
    if (cd->inBuffer) {
	Tcl_Free(cd->inBuffer);
	inflateEnd(&cd->inStream);
    }
    if (cd->outBuffer) {
	Tcl_Free(cd->outBuffer);
	deflateEnd(&cd->outStream);
    }
    if (cd->compDictObj) {
	Tcl_DecrRefCount(cd->compDictObj);
    }
    Tcl_Free(cd);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ResultCopy --
3904
3905
3906
3907
3908
3909
3910






3911
3912
3913
3914
3915
3916
3917
     */

    cfg[0].key = "zlibVersion";
    cfg[0].value = zlibVersion();
    cfg[1].key = NULL;
    Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1");







    /*
     * Formally provide the package as a Tcl built-in.
     */

    return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
}








>
>
>
>
>
>







3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
     */

    cfg[0].key = "zlibVersion";
    cfg[0].value = zlibVersion();
    cfg[1].key = NULL;
    Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1");

    /*
     * Allow command type introspection to do something sensible with streams.
     */

    TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream");

    /*
     * Formally provide the package as a Tcl built-in.
     */

    return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
}

4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
}

int
Tcl_ZlibInflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    int bufferSize,
    Tcl_Obj *gzipHeaderDictObj)
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
	Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
    }
    return TCL_ERROR;
}

unsigned int
Tcl_ZlibCRC32(
    unsigned int crc,
    const char *buf,
    int len)
{
    return 0;
}

unsigned int
Tcl_ZlibAdler32(
    unsigned int adler,
    const char *buf,
    int len)
{
    return 0;
}

void
Tcl_ZlibStreamSetCompressionDictionary(
    Tcl_ZlibStream zshandle,







|













|








|







4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
}

int
Tcl_ZlibInflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    size_t bufferSize,
    Tcl_Obj *gzipHeaderDictObj)
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
	Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
    }
    return TCL_ERROR;
}

unsigned int
Tcl_ZlibCRC32(
    unsigned int crc,
    const char *buf,
    size_t len)
{
    return 0;
}

unsigned int
Tcl_ZlibAdler32(
    unsigned int adler,
    const char *buf,
    size_t len)
{
    return 0;
}

void
Tcl_ZlibStreamSetCompressionDictionary(
    Tcl_ZlibStream zshandle,
Changes to library/auto.tcl.
69
70
71
72
73
74
75



















































76
77
78
79
80
81
82
	# 1. From an environment variable, if it exists.  Placing this first
	#    gives the end-user ultimate control to work-around any bugs, or
	#    to customize.

        if {[info exists env($enVarName)]} {
            lappend dirs $env($enVarName)
        }




















































	# 2. In the package script directory registered within the
	#    configuration of the package itself.

	catch {
	    lappend dirs [::${basename}::pkgconfig get scriptdir,runtime]
	}







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
	# 1. From an environment variable, if it exists.  Placing this first
	#    gives the end-user ultimate control to work-around any bugs, or
	#    to customize.

        if {[info exists env($enVarName)]} {
            lappend dirs $env($enVarName)
        }

	catch {
      set found 0
	    set root [zipfs root]
	    set mountpoint [file join $root lib [string tolower $basename]]
      lappend dirs [file join $root app ${basename}_library]
      lappend dirs [file join $root lib $mountpoint ${basename}_library]
      lappend dirs [file join $root lib $mountpoint]
	    if {![zipfs exists [file join $root app ${basename}_library]] \
	      && ![zipfs exists $mountpoint]} {
	      set found 0
	      foreach pkgdat [info loaded] {
	        lassign $pkgdat dllfile dllpkg
	        if {[string tolower $dllpkg] ne [string tolower $basename]} continue
	        if {$dllfile eq {}} {
	          # Loaded statically
	          break
	        }
          set found 1
	        zipfs mount $mountpoint $dllfile
	        break
	      }
	      if {!$found} {
  	      set paths {}
  	      lappend paths [file join $root app]
    	    lappend paths [::${basename}::pkgconfig get libdir,runtime]
	        lappend paths [::${basename}::pkgconfig get bindir,runtime]
	        if {[catch {::${basename}::pkgconfig get zipfile,runtime} zipfile]} {
  	        set zipfile [string tolower \
  	          "lib${basename}_[join [list {*}[split $version .] {*}$patch] _].zip"]
  	      }
  	      lappend paths [file dirname [file join [pwd] [info nameofexecutable]]]
          foreach path $paths {
            set archive [file join $path $zipfile]
            if {![file exists $archive]} continue
            zipfs mount $mountpoint $archive
            if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} {
              lappend dirs [file join $mountpoint ${basename}_library]
              set found 1
              break
            } elseif {[zipfs exists [file join $mountpoint $initScript]]} {
              lappend dirs [file join $mountpoint $initScript]
              set found 1
              break
            } else {
              catch {zipfs unmount $archive}
            }
          }
        }
      }
   }

	# 2. In the package script directory registered within the
	#    configuration of the package itself.

	catch {
	    lappend dirs [::${basename}::pkgconfig get scriptdir,runtime]
	}
Changes to library/http/http.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22


23
24
25

26

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63






64
65
66


67
68
69














70






71
72
73
74
75
76
77
# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy.
#	These procedures use a callback interface to avoid using vwait, which
#	is not defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.8.13

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {
	    -accept */*


	    -proxyhost {}
	    -proxyport {}
	    -proxyfilter http::ProxyRequired

	    -urlencoding utf-8

	}
	# We need a useragent string of this style or various servers will refuse to
	# send us compressed content even when we ask for it. This follows the
	# de-facto layout of user-agent strings in current browsers.
	# Safe interpreters do not have ::tcl_platform(os) or
	# ::tcl_platform(osVersion).
	if {[interp issafe]} {
	    set http(-useragent) "Mozilla/5.0\
                (Windows; U;\
                Windows NT 10.0)\
                http/[package provide http] Tcl/[package provide Tcl]"
	} else {
	    set http(-useragent) "Mozilla/5.0\
                ([string totitle $::tcl_platform(platform)]; U;\
                $::tcl_platform(os) $::tcl_platform(osVersion))\
                http/[package provide http] Tcl/[package provide Tcl]"
	}
    }

    proc init {} {
	# Set up the map for quoting chars. RFC3986 Section 2.3 say percent
	# encode all except: "... percent-encoded octets in the ranges of
	# ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period
	# (%2E), underscore (%5F), or tilde (%7E) should not be created by URI
	# producers ..."
	for {set i 0} {$i <= 256} {incr i} {
	    set c [format %c $i]
	    if {![string match {[-._~a-zA-Z0-9]} $c]} {
		set map($c) %[format %.2X $i]
	    }
	}
	# These are handled specially
	set map(\n) %0D%0A
	variable formMap [array get map]

	# Create a map for HTTP/1.1 open sockets
	variable socketmap






	if {[info exists socketmap]} {
	    # Close but don't remove open sockets on re-init
	    foreach {url sock} [array get socketmap] {


		catch {close $sock}
	    }
	}














	array set socketmap {}






    }
    init

    variable urlTypes
    if {![info exists urlTypes]} {
	set urlTypes(http) [list 80 ::socket]
    }













|








>
>



>

>

|
|
|




|
|
|


|
|
|




















|
>
>
>
>
>
>
|
|
|
>
>
|


>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy.
#	These procedures use a callback interface to avoid using vwait, which
#	is not defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.9.0

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {
	    -accept */*
	    -pipeline 1
	    -postfresh 0
	    -proxyhost {}
	    -proxyport {}
	    -proxyfilter http::ProxyRequired
	    -repost 0
	    -urlencoding utf-8
	    -zip 1
	}
	# We need a useragent string of this style or various servers will
	# refuse to send us compressed content even when we ask for it. This
	# follows the de-facto layout of user-agent strings in current browsers.
	# Safe interpreters do not have ::tcl_platform(os) or
	# ::tcl_platform(osVersion).
	if {[interp issafe]} {
	    set http(-useragent) "Mozilla/5.0\
		(Windows; U;\
		Windows NT 10.0)\
		http/[package provide http] Tcl/[package provide Tcl]"
	} else {
	    set http(-useragent) "Mozilla/5.0\
		([string totitle $::tcl_platform(platform)]; U;\
		$::tcl_platform(os) $::tcl_platform(osVersion))\
		http/[package provide http] Tcl/[package provide Tcl]"
	}
    }

    proc init {} {
	# Set up the map for quoting chars. RFC3986 Section 2.3 say percent
	# encode all except: "... percent-encoded octets in the ranges of
	# ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period
	# (%2E), underscore (%5F), or tilde (%7E) should not be created by URI
	# producers ..."
	for {set i 0} {$i <= 256} {incr i} {
	    set c [format %c $i]
	    if {![string match {[-._~a-zA-Z0-9]} $c]} {
		set map($c) %[format %.2X $i]
	    }
	}
	# These are handled specially
	set map(\n) %0D%0A
	variable formMap [array get map]

	# Create a map for HTTP/1.1 open sockets
	variable socketMapping
	variable socketRdState
	variable socketWrState
	variable socketRdQueue
	variable socketWrQueue
	variable socketClosing
	variable socketPlayCmd
	if {[info exists socketMapping]} {
	    # Close open sockets on re-init.  Do not permit retries.
	    foreach {url sock} [array get socketMapping] {
		unset -nocomplain socketClosing($url)
		unset -nocomplain socketPlayCmd($url)
		CloseSocket $sock
	    }
	}

	# CloseSocket should have unset the socket* arrays, one element at
	# a time.  Now unset anything that was overlooked.
	# Traces on "unset socketRdState(*)" will call CancelReadPipeline and
	# cancel any queued responses.
	# Traces on "unset socketWrState(*)" will call CancelWritePipeline and
	# cancel any queued requests.
	array unset socketMapping
	array unset socketRdState
	array unset socketWrState
	array unset socketRdQueue
	array unset socketWrQueue
	array unset socketClosing
	array unset socketPlayCmd
	array set socketMapping {}
	array set socketRdState {}
	array set socketWrState {}
	array set socketRdQueue {}
	array set socketWrQueue {}
	array set socketClosing {}
	array set socketPlayCmd {}
    }
    init

    variable urlTypes
    if {![info exists urlTypes]} {
	set urlTypes(http) [list 80 ::socket]
    }
91
92
93
94
95
96
97
98

99




100
101
102
103
104
105
106

    # Let user control default keepalive for compatibility
    variable defaultKeepalive
    if {![info exists defaultKeepalive]} {
	set defaultKeepalive 0
    }

    namespace export geturl config reset wait formatQuery register unregister

    # Useful, but not exported: data size status code




}

# http::Log --
#
#	Debugging output -- define this to observe HTTP/1.1 socket usage.
#	Should echo any args received.
#







|
>
|
>
>
>
>







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

    # Let user control default keepalive for compatibility
    variable defaultKeepalive
    if {![info exists defaultKeepalive]} {
	set defaultKeepalive 0
    }

    namespace export geturl config reset wait formatQuery quoteString
    namespace export register unregister registerError
    # - Useful, but not exported: data, size, status, code, cleanup, error,
    #   meta, ncode, mapReply, init.  Comments suggest that "init" can be used
    #   for re-initialisation, although the command is undocumented.
    # - Not exported, probably should be upper-case initial letter as part
    #   of the internals: getTextLine, make-transformation-chunked.
}

# http::Log --
#
#	Debugging output -- define this to observe HTTP/1.1 socket usage.
#	Should echo any args received.
#
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201








202
203
204

205
206
207
208



209
210

211
212
213



214





215
216
217

218
219
220
221
222
223
224
225
226

























































































































































































































227
228
229
230
231
232
233
234
235
236
237









238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253

254












255
256
257
258














































259


260
261
262


263

264

265
266
267





268








269







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322

323
324

325

326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341

342
343
344
345
346
347
348
# http::Finish --
#
#	Clean up the socket and eval close time callbacks
#
# Arguments:
#	token	    Connection token.
#	errormsg    (optional) If set, forces status to error.
#       skipCB      (optional) If set, don't call the -command callback. This
#		    is useful when geturl wants to throw an exception instead
#		    of calling the callback. That way, the same error isn't
#		    reported to two places.
#
# Side Effects:
#        Closes the socket

proc http::Finish {token {errormsg ""} {skipCB 0}} {








    variable $token
    upvar 0 $token state
    global errorInfo errorCode

    if {$errormsg ne ""} {
	set state(error) [list $errormsg $errorInfo $errorCode]
	set state(status) "error"
    }



    if { ($state(status) eq "timeout")
       || ($state(status) eq "error")

       || ([info exists state(-keepalive)] && !$state(-keepalive))
       || ([info exists state(connection)] && ($state(connection) eq "close"))
    } {



        CloseSocket $state(sock) $token





    }
    if {[info exists state(after)]} {
	after cancel $state(after)

    }
    if {[info exists state(-command)] && !$skipCB
	    && ![info exists state(done-command-cb)]} {
	set state(done-command-cb) yes
	if {[catch {eval $state(-command) {$token}} err] && $errormsg eq ""} {
	    set state(error) [list $err $errorInfo $errorCode]
	    set state(status) error
	}
    }

























































































































































































































}

# http::CloseSocket -
#
#	Close a socket and remove it from the persistent sockets table.  If
#	possible an http token is included here but when we are called from a
#	fileevent on remote closure we need to find the correct entry - hence
#	the second section.

proc ::http::CloseSocket {s {token {}}} {
    variable socketmap









    catch {fileevent $s readable {}}
    set conn_id {}
    if {$token ne ""} {
        variable $token
        upvar 0 $token state
        if {[info exists state(socketinfo)]} {
	    set conn_id $state(socketinfo)
        }
    } else {
        set map [array get socketmap]
        set ndx [lsearch -exact $map $s]
        if {$ndx != -1} {
	    incr ndx -1
	    set conn_id [lindex $map $ndx]
        }
    }

    if {$conn_id eq {} || ![info exists socketmap($conn_id)]} {












        Log "Closing socket $s (no connection info)"
        if {[catch {close $s} err]} {
	    Log "Error: $err"
	}














































    } else {


	if {[info exists socketmap($conn_id)]} {
	    Log "Closing connection $conn_id (sock $socketmap($conn_id))"
	    if {[catch {close $socketmap($conn_id)} err]} {


		Log "Error: $err"

	    }

	    unset socketmap($conn_id)
	} else {
	    Log "Cannot close connection $conn_id - no socket in socket map"





	}








    }







}

# http::reset --
#
#	See documentation for details.
#
# Arguments:
#	token	Connection token.
#	why	Status info.
#
# Side Effects:
#       See Finish

proc http::reset {token {why reset}} {
    variable $token
    upvar 0 $token state
    set state(status) $why
    catch {fileevent $state(sock) readable {}}
    catch {fileevent $state(sock) writable {}}
    Finish $token
    if {[info exists state(error)]} {
	set errorlist $state(error)
	unset state
	eval ::error $errorlist
    }
}

# http::geturl --
#
#	Establishes a connection to a remote url via http.
#
# Arguments:
#       url		The http URL to goget.
#       args		Option value pairs. Valid options include:
#				-blocksize, -validate, -headers, -timeout
# Results:
#	Returns a token for this connection. This token is the name of an
#	array that the caller should unset to garbage collect the state.

proc http::geturl {url args} {
    variable http
    variable urlTypes
    variable defaultCharset
    variable defaultKeepalive
    variable strict

    # Initialize the state variable, an array. We'll return the name of this
    # array as the token for the transaction.

    if {![info exists http(uid)]} {
	set http(uid) 0
    }
    set token [namespace current]::[incr http(uid)]

    variable $token
    upvar 0 $token state

    reset $token


    # Process command options.

    array set state {
	-binary		false
	-blocksize	8192
	-queryblocksize 8192
	-validate	0
	-headers	{}
	-timeout	0
	-type		application/x-www-form-urlencoded
	-queryprogress	{}
	-protocol	1.1
	binary		0
	state		connecting
	meta		{}

	coding		{}
	currentsize	0
	totalsize	0
	querylength	0
	queryoffset	0
	type		text/html
	body		{}







|





|


>
>
>
>
>
>
>
>



>




>
>
>
|

>



>
>
>
|
>
>
>
>
>



>

|
|






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







|

|
|
>
>
>
>
>
>
>
>
>

|

|
|
|
|
|

|
|
|

|
|

>
|
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
|
|
|
>
>
|
>
|
>
|
|
<
>
>
>
>
>
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>











|




















|
|



















>


>

>














|

>







223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616

617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
# http::Finish --
#
#	Clean up the socket and eval close time callbacks
#
# Arguments:
#	token	    Connection token.
#	errormsg    (optional) If set, forces status to error.
#	skipCB      (optional) If set, don't call the -command callback. This
#		    is useful when geturl wants to throw an exception instead
#		    of calling the callback. That way, the same error isn't
#		    reported to two places.
#
# Side Effects:
#        May close the socket.

proc http::Finish {token {errormsg ""} {skipCB 0}} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    global errorInfo errorCode
    set closeQueue 0
    if {$errormsg ne ""} {
	set state(error) [list $errormsg $errorInfo $errorCode]
	set state(status) "error"
    }
    if {[info commands ${token}EventCoroutine] ne {}} {
	rename ${token}EventCoroutine {}
    }
    if {  ($state(status) eq "timeout")
       || ($state(status) eq "error")
       || ($state(status) eq "eof")
       || ([info exists state(-keepalive)] && !$state(-keepalive))
       || ([info exists state(connection)] && ($state(connection) eq "close"))
    } {
	set closeQueue 1
	set connId $state(socketinfo)
	set sock $state(sock)
	CloseSocket $state(sock) $token
    } elseif {
	  ([info exists state(-keepalive)] && $state(-keepalive))
       && ([info exists state(connection)] && ($state(connection) ne "close"))
    } {
	KeepSocket $token
    }
    if {[info exists state(after)]} {
	after cancel $state(after)
	unset state(after)
    }
    if {[info exists state(-command)] && (!$skipCB)
	    && (![info exists state(done-command-cb)])} {
	set state(done-command-cb) yes
	if {[catch {eval $state(-command) {$token}} err] && $errormsg eq ""} {
	    set state(error) [list $err $errorInfo $errorCode]
	    set state(status) error
	}
    }

    if {    $closeQueue
	 && [info exists socketMapping($connId)]
	 && ($socketMapping($connId) eq $sock)
    } {
	http::CloseQueuedQueries $connId $token
    }
}

# http::KeepSocket -
#
#	Keep a socket in the persistent sockets table and connect it to its next
#	queued task if possible.  Otherwise leave it idle and ready for its next
#	use.
#
#	If $socketClosing(*), then ($state(connection) eq "close") and therefore
#	this command will not be called by Finish.
#
# Arguments:
#	token	    Connection token.

proc http::KeepSocket {token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]

    # Keep this socket open for another request ("Keep-Alive").
    # React if the server half-closes the socket.
    # Discussion is in http::geturl.
    catch {fileevent $state(sock) readable [list http::CheckEof $state(sock)]}

    # The line below should not be changed in production code.
    # It is edited by the test suite.
    set TEST_EOF 0
    if {$TEST_EOF} {
	# ONLY for testing reaction to server eof.
	# No server timeouts will be caught.
	catch {fileevent $state(sock) readable {}}
    }

    if {    [info exists state(socketinfo)]
	 && [info exists socketMapping($state(socketinfo))]
    } {
	set connId $state(socketinfo)
	# The value "Rready" is set only here.
	set socketRdState($connId) Rready

	if {    $state(-pipeline)
	     && [info exists socketRdQueue($connId)]
	     && [llength $socketRdQueue($connId)]
	} {
	    # The usual case for pipelined responses - if another response is
	    # queued, arrange to read it.
	    set token3 [lindex $socketRdQueue($connId) 0]
	    set socketRdQueue($connId) [lrange $socketRdQueue($connId) 1 end]
	    variable $token3
	    upvar 0 $token3 state3
	    set tk2 [namespace tail $token3]

	    #Log pipelined, GRANT read access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    ReceiveResponse $token3

	    # Other pipelined cases.
	    # - The test above ensures that, for the pipelined cases in the two
	    #   tests below, the read queue is empty.
	    # - In those two tests, check whether the next write will be
	    #   nonpipeline.
	} elseif {
		$state(-pipeline)
	     && [info exists socketWrState($connId)]
	     && ($socketWrState($connId) eq "peNding")

	     && [info exists socketWrQueue($connId)]
	     && [llength $socketWrQueue($connId)]
	     && (![set token3 [lindex $socketWrQueue($connId) 0]
		   set ${token3}(-pipeline)
		  ]
		)
	} {
	    # This case:
	    # - Now it the time to run the "pending" request.
	    # - The next token in the write queue is nonpipeline, and
	    #   socketWrState has been marked "pending" (in
	    #   http::NextPipelinedWrite or http::geturl) so a new pipelined
	    #   request cannot jump the queue.
	    #
	    # Tests:
	    # - In this case the read queue (tested above) is empty and this
	    #   "pending" write token is in front of the rest of the write
	    #   queue.
	    # - The write state is not Wready and therefore appears to be busy,
	    #   but because it is "pending" we know that it is reserved for the
	    #   first item in the write queue, a non-pipelined request that is
	    #   waiting for the read queue to empty.  That has now happened: so
	    #   give that request read and write access.
	    variable $token3
	    set conn [set ${token3}(tmpConnArgs)]
	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    set socketWrState($connId) $token3
	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	    # Connect does its own fconfigure.
	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	    #Log ---- $state(sock) << conn to $token3 for HTTP request (c)

	} elseif {
		$state(-pipeline)
	     && [info exists socketWrState($connId)]
	     && ($socketWrState($connId) eq "peNding")

	} {
	    # Should not come here.  The second block in the previous "elseif"
	    # test should be tautologous (but was needed in an earlier
	    # implementation) and will be removed after testing.
	    # If we get here, the value "pending" was assigned in error.
	    # This error would block the queue for ever.
	    Log ^X$tk <<<<< Error in queueing of requests >>>>> - token $token

	} elseif {
		$state(-pipeline)
	     && [info exists socketWrState($connId)]
	     && ($socketWrState($connId) eq "Wready")

	     && [info exists socketWrQueue($connId)]
	     && [llength $socketWrQueue($connId)]
	     && (![set token3 [lindex $socketWrQueue($connId) 0]
		   set ${token3}(-pipeline)
		  ]
		)
	} {
	    # This case:
	    # - The next token in the write queue is nonpipeline, and
	    #   socketWrState is Wready.  Get the next event from socketWrQueue.
	    # Tests:
	    # - In this case the read state (tested above) is Rready and the
	    #   write state (tested here) is Wready - there is no "pending"
	    #   request.
	    # Code:
	    # - The code is the same as the code below for the nonpipelined
	    #   case with a queued request.
	    variable $token3
	    set conn [set ${token3}(tmpConnArgs)]
	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    set socketWrState($connId) $token3
	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	    # Connect does its own fconfigure.
	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	    #Log ---- $state(sock) << conn to $token3 for HTTP request (c)

	} elseif {
		(!$state(-pipeline))
	     && [info exists socketWrQueue($connId)]
	     && [llength $socketWrQueue($connId)]
	     && ($state(connection) ne "close")
	} {
	    # If not pipelined, (socketRdState eq Rready) tells us that we are
	    # ready for the next write - there is no need to check
	    # socketWrState. Write the next request, if one is waiting.
	    # If the next request is pipelined, it receives premature read
	    # access to the socket. This is not a problem.
	    set token3 [lindex $socketWrQueue($connId) 0]
	    variable $token3
	    set conn [set ${token3}(tmpConnArgs)]
	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    set socketWrState($connId) $token3
	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	    # Connect does its own fconfigure.
	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	    #Log ---- $state(sock) << conn to $token3 for HTTP request (d)

	} elseif {(!$state(-pipeline))} {
	    set socketWrState($connId) Wready
	    # Rready and Wready and idle: nothing to do.
	}

    } else {
	CloseSocket $state(sock) $token
	# There is no socketMapping($state(socketinfo)), so it does not matter
	# that CloseQueuedQueries is not called.
    }
}

# http::CheckEof -
#
#	Read from a socket and close it if eof.
#	The command is bound to "fileevent readable" on an idle socket, and
#	"eof" is the only event that should trigger the binding, occurring when
#	the server times out and half-closes the socket.
#
#	A read is necessary so that [eof] gives a meaningful result.
#	Any bytes sent are junk (or a bug).

proc http::CheckEof {sock} {
    set junk [read $sock]
    set n [string length $junk]
    if {$n} {
	Log "WARNING: $n bytes received but no HTTP request sent"
    }

    if {[catch {eof $sock} res] || $res} {
	# The server has half-closed the socket.
	# If a new write has started, its transaction will fail and
	# will then be error-handled.
	CloseSocket $sock
    }
}

# http::CloseSocket -
#
#	Close a socket and remove it from the persistent sockets table.  If
#	possible an http token is included here but when we are called from a
#	fileevent on remote closure we need to find the correct entry - hence
#	the "else" block of the first "if" command.

proc http::CloseSocket {s {token {}}} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    set tk [namespace tail $token]

    catch {fileevent $s readable {}}
    set connId {}
    if {$token ne ""} {
	variable $token
	upvar 0 $token state
	if {[info exists state(socketinfo)]} {
	    set connId $state(socketinfo)
	}
    } else {
	set map [array get socketMapping]
	set ndx [lsearch -exact $map $s]
	if {$ndx != -1} {
	    incr ndx -1
	    set connId [lindex $map $ndx]
	}
    }
    if {    ($connId ne {})
	 && [info exists socketMapping($connId)]
	 && ($socketMapping($connId) eq $s)
    } {
	Log "Closing connection $connId (sock $socketMapping($connId))"
	if {[catch {close $socketMapping($connId)} err]} {
	    Log "Error closing connection: $err"
	}
	if {$token eq {}} {
	    # Cases with a non-empty token are handled by Finish, so the tokens
	    # are finished in connection order.
	    http::CloseQueuedQueries $connId
	}
    } else {
	Log "Closing socket $s (no connection info)"
	if {[catch {close $s} err]} {
	    Log "Error closing socket: $err"
	}
    }
}

# http::CloseQueuedQueries
#
#	connId  - identifier "domain:port" for the connection
#	token   - (optional) used only for logging
#
# Called from http::CloseSocket and http::Finish, after a connection is closed,
# to clear the read and write queues if this has not already been done.

proc http::CloseQueuedQueries {connId {token {}}} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    if {![info exists socketMapping($connId)]} {
	# Command has already been called.
	# Don't come here again - especially recursively.
	return
    }

    # Used only for logging.
    if {$token eq {}} {
	set tk {}
    } else {
	set tk [namespace tail $token]
    }

    if {    [info exists socketPlayCmd($connId)]
	 && ($socketPlayCmd($connId) ne {ReplayIfClose Wready {} {}})
    } {
	# Before unsetting, there is some unfinished business.
	# - If the server sent "Connection: close", we have stored the command
	#   for retrying any queued requests in socketPlayCmd, so copy that
	#   value for execution below.  socketClosing(*) was also set.
	# - Also clear the queues to prevent calls to Finish that would set the
	#   state for the requests that will be retried to "finished with error
	#   status".
	set unfinished $socketPlayCmd($connId)
	set socketRdQueue($connId) {}
	set socketWrQueue($connId) {}
    } else {
	set unfinished {}
    }

    Unset $connId

    if {$unfinished ne {}} {
	Log ^R$tk Any unfinished transactions (excluding $token) failed \
		- token $token
	{*}$unfinished
    }
}

# http::Unset

#
#	The trace on "unset socketRdState(*)" will call CancelReadPipeline
#	and cancel any queued responses.
#	The trace on "unset socketWrState(*)" will call CancelWritePipeline
#	and cancel any queued requests.

proc http::Unset {connId} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    unset socketMapping($connId)
    unset socketRdState($connId)
    unset socketWrState($connId)
    unset -nocomplain socketRdQueue($connId)
    unset -nocomplain socketWrQueue($connId)
    unset -nocomplain socketClosing($connId)
    unset -nocomplain socketPlayCmd($connId)
}

# http::reset --
#
#	See documentation for details.
#
# Arguments:
#	token	Connection token.
#	why	Status info.
#
# Side Effects:
#        See Finish

proc http::reset {token {why reset}} {
    variable $token
    upvar 0 $token state
    set state(status) $why
    catch {fileevent $state(sock) readable {}}
    catch {fileevent $state(sock) writable {}}
    Finish $token
    if {[info exists state(error)]} {
	set errorlist $state(error)
	unset state
	eval ::error $errorlist
    }
}

# http::geturl --
#
#	Establishes a connection to a remote url via http.
#
# Arguments:
#	url		The http URL to goget.
#	args		Option value pairs. Valid options include:
#				-blocksize, -validate, -headers, -timeout
# Results:
#	Returns a token for this connection. This token is the name of an
#	array that the caller should unset to garbage collect the state.

proc http::geturl {url args} {
    variable http
    variable urlTypes
    variable defaultCharset
    variable defaultKeepalive
    variable strict

    # Initialize the state variable, an array. We'll return the name of this
    # array as the token for the transaction.

    if {![info exists http(uid)]} {
	set http(uid) 0
    }
    set token [namespace current]::[incr http(uid)]
    ##Log Starting http::geturl - token $token
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    reset $token
    Log ^A$tk URL $url - token $token

    # Process command options.

    array set state {
	-binary		false
	-blocksize	8192
	-queryblocksize 8192
	-validate	0
	-headers	{}
	-timeout	0
	-type		application/x-www-form-urlencoded
	-queryprogress	{}
	-protocol	1.1
	binary		0
	state		created
	meta		{}
	method		{}
	coding		{}
	currentsize	0
	totalsize	0
	querylength	0
	queryoffset	0
	type		text/html
	body		{}
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582




















583









584
585
















586


















587



588






589
590






591
592
593
594
595
596
597
598
599
































600
601
602
603
604



605
606
607
608
609
610
611
612
613
614
615







616



617







618
619
620

621



622































623
624
625
626
627















































































628

629
630
631
632
633
634
635
    if {$port != $defport} {
	append url : $port
    }
    append url $srvurl
    # Don't append the fragment!
    set state(url) $url

    # If a timeout is specified we set up the after event and arrange for an
    # asynchronous socket connection.

    set sockopts [list -async]
    if {$state(-timeout) > 0} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]
    }

    # If we are using the proxy, we must pass in the full URL that includes
    # the server name.

    if {[info exists phost] && ($phost ne "")} {
	set srvurl $url
	set targetAddr [list $phost $pport]
    } else {
	set targetAddr [list $host $port]
    }
    # Proxy connections aren't shared among different hosts.
    set state(socketinfo) $host:$port

    # Save the accept types at this point to prevent a race condition. [Bug
    # c11a51c482]
    set state(accept-types) $http(-accept)





















    # See if we are supposed to use a previously opened channel.









    if {$state(-keepalive)} {
	variable socketmap
















	if {[info exists socketmap($state(socketinfo))]} {


















	    if {[catch {fconfigure $socketmap($state(socketinfo))}]} {



		Log "WARNING: socket for $state(socketinfo) was closed"






		unset socketmap($state(socketinfo))
	    } else {






		set sock $socketmap($state(socketinfo))
		Log "reusing socket $sock for $state(socketinfo)"
		catch {fileevent $sock writable {}}
		catch {fileevent $sock readable {}}
	    }
	}
	# don't automatically close this connection socket
	set state(connection) {}
    }
































    if {![info exists sock]} {
	# Pass -myaddr directly to the socket command
	if {[info exists state(-myaddr)]} {
	    lappend sockopts -myaddr $state(-myaddr)
	}



        if {[catch {eval $defcmd $sockopts $targetAddr} sock errdict]} {
	    # something went wrong while trying to establish the connection.
	    # Clean up after events and such, but DON'T call the command
	    # callback (if available) because we're going to throw an
	    # exception from here instead.

	    set state(sock) $sock
	    Finish $token "" 1
	    cleanup $token
	    dict unset errdict -level
	    return -options $errdict $sock







        }



    }







    set state(sock) $sock
    Log "Using $sock for $state(socketinfo)" \
        [expr {$state(-keepalive)?"keepalive":""}]

    if {$state(-keepalive)} {



        set socketmap($state(socketinfo)) $sock































    }

    if {![info exists phost]} {
	set phost ""
    }















































































    fileevent $sock writable [list http::Connect $token $proto $phost $srvurl]


    # Wait for the connection to complete.
    if {![info exists state(-command)]} {
	# geturl does EVERYTHING asynchronously, so if the user
	# calls it synchronously, we just do a wait here.
	http::wait $token








<
<
<

<
<
<
<

















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>

|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
|
>
>
>
>
>
>
|

>
>
>
>
>
>
|
|
<
<
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





>
>
>
|
|




|
|



>
>
>
>
>
>
>
|
>
>
>
|
>
>
>
>
>
>
>

|
|
>
|
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>







924
925
926
927
928
929
930



931




932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036


1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
    if {$port != $defport} {
	append url : $port
    }
    append url $srvurl
    # Don't append the fragment!
    set state(url) $url




    set sockopts [list -async]





    # If we are using the proxy, we must pass in the full URL that includes
    # the server name.

    if {[info exists phost] && ($phost ne "")} {
	set srvurl $url
	set targetAddr [list $phost $pport]
    } else {
	set targetAddr [list $host $port]
    }
    # Proxy connections aren't shared among different hosts.
    set state(socketinfo) $host:$port

    # Save the accept types at this point to prevent a race condition. [Bug
    # c11a51c482]
    set state(accept-types) $http(-accept)

    if {$isQuery || $isQueryChannel} {
	# It's a POST.
	# A client wishing to send a non-idempotent request SHOULD wait to send
	# that request until it has received the response status for the
	# previous request.
	if {$http(-postfresh)} {
	    # Override -keepalive for a POST.  Use a new connection, and thus
	    # avoid the small risk of a race against server timeout.
	    set state(-keepalive) 0
	} else {
	    # Allow -keepalive but do not -pipeline - wait for the previous
	    # transaction to finish.
	    # There is a small risk of a race against server timeout.
	    set state(-pipeline) 0
	}
    } else {
	# It's a GET or HEAD.
	set state(-pipeline) $http(-pipeline)
    }

    # See if we are supposed to use a previously opened channel.
    # - In principle, ANY call to http::geturl could use a previously opened
    #   channel if it is available - the "Connection: keep-alive" header is a
    #   request to leave the channel open AFTER completion of this call.
    # - In fact, we try to use an existing channel only if -keepalive 1 -- this
    #   means that at most one channel is left open for each value of
    #   $state(socketinfo). This property simplifies the mapping of open
    #   channels.
    set reusing 0
    set alreadyQueued 0
    if {$state(-keepalive)} {
	variable socketMapping
	variable socketRdState
	variable socketWrState
	variable socketRdQueue
	variable socketWrQueue
	variable socketClosing
	variable socketPlayCmd

	if {[info exists socketMapping($state(socketinfo))]} {
	    # - If the connection is idle, it has a "fileevent readable" binding
	    #   to http::CheckEof, in case the server times out and half-closes
	    #   the socket (http::CheckEof closes the other half).
	    # - We leave this binding in place until just before the last
	    #   puts+flush in http::Connected (GET/HEAD) or http::Write (POST),
	    #   after which the HTTP response might be generated.

	    if {    [info exists socketClosing($state(socketinfo))]
		       && $socketClosing($state(socketinfo))
	    } {
		# socketClosing(*) is set because the server has sent a
		# "Connection: close" header.
		# Do not use the persistent socket again.
		# Since we have only one persistent socket per server, and the
		# old socket is not yet dead, add the request to the write queue
		# of the dying socket, which will be replayed by ReplayIfClose.
		# Also add it to socketWrQueue(*) which is used only if an error
		# causes a call to Finish.
		set reusing 1
		set sock $socketMapping($state(socketinfo))
		Log "reusing socket $sock for $state(socketinfo) - token $token"

		set alreadyQueued 1
		lassign $socketPlayCmd($state(socketinfo)) com0 com1 com2 com3
		lappend com3 $token
		set socketPlayCmd($state(socketinfo)) [list $com0 $com1 $com2 $com3]
		lappend socketWrQueue($state(socketinfo)) $token
	    } elseif {[catch {fconfigure $socketMapping($state(socketinfo))}]} {
		# FIXME Is it still possible for this code to be executed? If
		#       so, this could be another place to call TestForReplay,
		#       rather than discarding the queued transactions.
		Log "WARNING: socket for $state(socketinfo) was closed\
			- token $token"
		Log "WARNING - if testing, pay special attention to this\
			case (GH) which is seldom executed - token $token"

		# This will call CancelReadPipeline, CancelWritePipeline, and
		# cancel any queued requests, responses.
		Unset $state(socketinfo)
	    } else {
		# Use the persistent socket.
		# The socket may not be ready to write: an earlier request might
		# still be still writing (in the pipelined case) or
		# writing/reading (in the nonpipeline case). This possibility
		# is handled by socketWrQueue later in this command.
		set reusing 1
		set sock $socketMapping($state(socketinfo))
		Log "reusing socket $sock for $state(socketinfo) - token $token"



	    }
	    # Do not automatically close the connection socket.
	    set state(connection) {}
	}
    }

    if {$reusing} {
	# Define state(tmpState) and state(tmpOpenCmd) for use
	# by http::ReplayIfDead if the persistent connection has died.
	set state(tmpState) [array get state]

	# Pass -myaddr directly to the socket command
	if {[info exists state(-myaddr)]} {
	    lappend sockopts -myaddr $state(-myaddr)
	}

	set state(tmpOpenCmd) [list {*}$defcmd {*}$sockopts {*}$targetAddr]
    }

    set state(reusing) $reusing
    # Excluding ReplayIfDead and the decision whether to call it, there are four
    # places outside http::geturl where state(reusing) is used:
    # - Connected   - if reusing and not pipelined, start the state(-timeout)
    #                 timeout (when writing).
    # - DoneRequest - if reusing and pipelined, send the next pipelined write
    # - Event       - if reusing and pipelined, start the state(-timeout)
    #                 timeout (when reading).
    # - Event       - if (not reusing) and pipelined, send the next pipelined
    #                 write

    # See comments above re the start of this timeout in other cases.
    if {(!$state(reusing)) && ($state(-timeout) > 0)} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]
    }

    if {![info exists sock]} {
	# Pass -myaddr directly to the socket command
	if {[info exists state(-myaddr)]} {
	    lappend sockopts -myaddr $state(-myaddr)
	}
	set pre [clock milliseconds]
	##Log pre socket opened, - token $token
	##Log [concat $defcmd $sockopts $targetAddr] - token $token
	if {[catch {eval $defcmd $sockopts $targetAddr} sock errdict]} {
	    # Something went wrong while trying to establish the connection.
	    # Clean up after events and such, but DON'T call the command
	    # callback (if available) because we're going to throw an
	    # exception from here instead.

	    set state(sock) NONE
	    Finish $token $sock 1
	    cleanup $token
	    dict unset errdict -level
	    return -options $errdict $sock
	} else {
	    # Initialisation of a new socket.
	    ##Log post socket opened, - token $token
	    ##Log socket opened, now fconfigure - token $token
	    set delay [expr {[clock milliseconds] - $pre}]
	    if {$delay > 3000} {
		Log socket delay $delay - token $token
	    }
	    fconfigure $sock -translation {auto crlf} \
			     -buffersize $state(-blocksize)
	    ##Log socket opened, DONE fconfigure - token $token
	}
    }
    # Command [socket] is called with -async, but takes 5s to 5.1s to return,
    # with probability of order 1 in 10,000.  This may be a bizarre scheduling
    # issue with my (KJN's) system (Fedora Linux).
    # This does not cause a problem (unless the request times out when this
    # command returns).

    set state(sock) $sock
    Log "Using $sock for $state(socketinfo) - token $token" \
	[expr {$state(-keepalive)?"keepalive":""}]

    if {    $state(-keepalive)
	 && (![info exists socketMapping($state(socketinfo))])
    } {
	# Freshly-opened socket that we would like to become persistent.
	set socketMapping($state(socketinfo)) $sock

	if {![info exists socketRdState($state(socketinfo))]} {
	    set socketRdState($state(socketinfo)) {}
	    set varName ::http::socketRdState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelReadPipeline
	}
	if {![info exists socketWrState($state(socketinfo))]} {
	    set socketWrState($state(socketinfo)) {}
	    set varName ::http::socketWrState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelWritePipeline
	}

	if {$state(-pipeline)} {
	    #Log new, init for pipelined, GRANT write access to $token in geturl
	    # Also grant premature read access to the socket. This is OK.
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	} else {
	    # socketWrState is not used by this non-pipelined transaction.
	    # We cannot leave it as "Wready" because the next call to
	    # http::geturl with a pipelined transaction would conclude that the
	    # socket is available for writing.
	    #Log new, init for nonpipeline, GRANT r/w access to $token in geturl
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	}

	set socketRdQueue($state(socketinfo)) {}
	set socketWrQueue($state(socketinfo)) {}
	set socketClosing($state(socketinfo)) 0
	set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
    }

    if {![info exists phost]} {
	set phost ""
    }
    if {$reusing} {
	# For use by http::ReplayIfDead if the persistent connection has died.
	# Also used by NextPipelinedWrite.
	set state(tmpConnArgs) [list $proto $phost $srvurl]
    }

    # The element socketWrState($connId) has a value which is either the name of
    # the token that is permitted to write to the socket, or "Wready" if no
    # token is permitted to write.
    #
    # The code that sets the value to Wready immediately calls
    # http::NextPipelinedWrite, which examines socketWrQueue($connId) and
    # processes the next request in the queue, if there is one.  The value
    # Wready is not found when the interpreter is in the event loop unless the
    # socket is idle.
    #
    # The element socketRdState($connId) has a value which is either the name of
    # the token that is permitted to read from the socket, or "Rready" if no
    # token is permitted to read.
    #
    # The code that sets the value to Rready then examines
    # socketRdQueue($connId) and processes the next request in the queue, if
    # there is one.  The value Rready is not found when the interpreter is in
    # the event loop unless the socket is idle.

    if {$alreadyQueued} {
	# A write may or may not be in progress.  There is no need to set
	# socketWrState to prevent another call stealing write access - all
	# subsequent calls on this socket will come here because the socket
	# will close after the current read, and its
	# socketClosing($connId) is 1.
	##Log "HTTP request for token $token is queued"

    } elseif {    $reusing
	       && $state(-pipeline)
	       && ($socketWrState($state(socketinfo)) ne "Wready")
    } {
	##Log "HTTP request for token $token is queued for pipelined use"
	lappend socketWrQueue($state(socketinfo)) $token

    } elseif {    $reusing
	       && (!$state(-pipeline))
	       && ($socketWrState($state(socketinfo)) ne "Wready")
    } {
	# A write is queued or in progress.  Lappend to the write queue.
	##Log "HTTP request for token $token is queued for nonpipeline use"
	lappend socketWrQueue($state(socketinfo)) $token

    } elseif {    $reusing
	       && (!$state(-pipeline))
	       && ($socketWrState($state(socketinfo)) eq "Wready")
	       && ($socketRdState($state(socketinfo)) ne "Rready")
    } {
	# A read is queued or in progress, but not a write.  Cannot start the
	# nonpipeline transaction, but must set socketWrState to prevent a
	# pipelined request jumping the queue.
	##Log "HTTP request for token $token is queued for nonpipeline use"
	#Log re-use nonpipeline, GRANT delayed write access to $token in geturl

	set socketWrState($state(socketinfo)) peNding
	lappend socketWrQueue($state(socketinfo)) $token

    } else {
	if {$reusing && $state(-pipeline)} {
	    #Log re-use pipelined, GRANT write access to $token in geturl
	    set socketWrState($state(socketinfo)) $token

	} elseif {$reusing} {
	    # Cf tests above - both are ready.
	    #Log re-use nonpipeline, GRANT r/w access to $token in geturl
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	}

	# All (!$reusing) cases come here, and also some $reusing cases if the
	# connection is ready.
	#Log ---- $state(socketinfo) << conn to $token for HTTP request (a)
	# Connect does its own fconfigure.
	fileevent $sock writable \
		[list http::Connect $token $proto $phost $srvurl]
    }

    # Wait for the connection to complete.
    if {![info exists state(-command)]} {
	# geturl does EVERYTHING asynchronously, so if the user
	# calls it synchronously, we just do a wait here.
	http::wait $token

644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670







671
672
673

674





675
676
677
678
679
680
681
682
683
684
685
686


687

688
689
690
691
692
693
694
	    # callback (if available) because we're going to throw an
	    # exception from here instead.
	    set err [lindex $state(error) 0]
	    cleanup $token
	    return -code error $err
	}
    }

    return $token
}

# http::Connected --
#
#	Callback used when the connection to the HTTP server is actually
#	established.
#
# Arguments:
#       token	State token.
#       proto	What protocol (http, https, etc.) was used to connect.
#	phost	Are we using keep-alive? Non-empty if yes.
#	srvurl	Service-local URL that we're requesting
# Results:
#	None.

proc http::Connected {token proto phost srvurl} {
    variable http
    variable urlTypes








    variable $token
    upvar 0 $token state







    # Set back the variables needed here
    set sock $state(sock)
    set isQueryChannel [info exists state(-querychannel)]
    set isQuery [info exists state(-query)]
    set host [lindex [split $state(socketinfo) :] 0]
    set port [lindex [split $state(socketinfo) :] 1]

    set lower [string tolower $proto]
    set defport [lindex $urlTypes($lower) 0]

    # Send data in cr-lf format, but accept any line terminators



    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)


    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.

    catch {fconfigure $sock -blocking off}
    set how GET
    if {$isQuery} {







|









|
|








>
>
>
>
>
>
>



>

>
>
>
>
>
|









|
|
>
>
|
>







1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
	    # callback (if available) because we're going to throw an
	    # exception from here instead.
	    set err [lindex $state(error) 0]
	    cleanup $token
	    return -code error $err
	}
    }
    ##Log Leaving http::geturl - token $token
    return $token
}

# http::Connected --
#
#	Callback used when the connection to the HTTP server is actually
#	established.
#
# Arguments:
#	token	State token.
#	proto	What protocol (http, https, etc.) was used to connect.
#	phost	Are we using keep-alive? Non-empty if yes.
#	srvurl	Service-local URL that we're requesting
# Results:
#	None.

proc http::Connected {token proto phost srvurl} {
    variable http
    variable urlTypes
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]

    if {$state(reusing) && (!$state(-pipeline)) && ($state(-timeout) > 0)} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]
    }

    # Set back the variables needed here.
    set sock $state(sock)
    set isQueryChannel [info exists state(-querychannel)]
    set isQuery [info exists state(-query)]
    set host [lindex [split $state(socketinfo) :] 0]
    set port [lindex [split $state(socketinfo) :] 1]

    set lower [string tolower $proto]
    set defport [lindex $urlTypes($lower) 0]

    # Send data in cr-lf format, but accept any line terminators.
    # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest.
    # We are concerned here with the request (write) not the response (read).
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list $trRead crlf] \
		     -buffersize $state(-blocksize)

    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.

    catch {fconfigure $sock -blocking off}
    set how GET
    if {$isQuery} {
703
704
705
706
707
708
709

710

711
712
713
714
715
716
717
718
719
720
721



722

723
724
725
726
727
728
729
730
731
732
733
734
735


736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
	}
    } elseif {$state(-validate)} {
	set how HEAD
    } elseif {$isQueryChannel} {
	set how POST
	# The query channel must be blocking for the async Write to
	# work properly.

	fconfigure $state(-querychannel) -blocking 1 -translation binary

	set contDone 0
    }
    if {[info exists state(-method)] && $state(-method) ne ""} {
	set how $state(-method)
    }
    # We cannot handle chunked encodings with -handler, so force HTTP/1.0
    # until we can manage this.
    if {[info exists state(-handler)]} {
	set state(-protocol) 1.0
    }
    set accept_types_seen 0



    if {[catch {

	puts $sock "$how $srvurl HTTP/$state(-protocol)"
	if {[dict exists $state(-headers) Host]} {
	    # Allow Host spoofing. [Bug 928154]
	    puts $sock "Host: [dict get $state(-headers) Host]"
	} elseif {$port == $defport} {
	    # Don't add port in this case, to handle broken servers. [Bug
	    # #504508]
	    puts $sock "Host: $host"
	} else {
	    puts $sock "Host: $host:$port"
	}
	puts $sock "User-Agent: $http(-useragent)"
        if {$state(-protocol) == 1.0 && $state(-keepalive)} {


	    puts $sock "Connection: keep-alive"
        }
        if {$state(-protocol) > 1.0 && !$state(-keepalive)} {
	    puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
        }
        if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
	    puts $sock "Proxy-Connection: Keep-Alive"
        }
        set accept_encoding_seen 0
	set content_type_seen 0
	dict for {key value} $state(-headers) {
	    set value [string map [list \n "" \r ""] $value]
	    set key [string map {" " -} [string trim $key]]
	    if {[string equal -nocase $key "host"]} {
		continue
	    }







>
|
>


|








>
>
>

>












|
>
>

|
|

|
|

|
|







1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
	}
    } elseif {$state(-validate)} {
	set how HEAD
    } elseif {$isQueryChannel} {
	set how POST
	# The query channel must be blocking for the async Write to
	# work properly.
	lassign [fconfigure $sock -translation] trRead trWrite
	fconfigure $state(-querychannel) -blocking 1 \
					 -translation [list $trRead binary]
	set contDone 0
    }
    if {[info exists state(-method)] && ($state(-method) ne "")} {
	set how $state(-method)
    }
    # We cannot handle chunked encodings with -handler, so force HTTP/1.0
    # until we can manage this.
    if {[info exists state(-handler)]} {
	set state(-protocol) 1.0
    }
    set accept_types_seen 0

    Log ^B$tk begin sending request - token $token

    if {[catch {
	set state(method) $how
	puts $sock "$how $srvurl HTTP/$state(-protocol)"
	if {[dict exists $state(-headers) Host]} {
	    # Allow Host spoofing. [Bug 928154]
	    puts $sock "Host: [dict get $state(-headers) Host]"
	} elseif {$port == $defport} {
	    # Don't add port in this case, to handle broken servers. [Bug
	    # #504508]
	    puts $sock "Host: $host"
	} else {
	    puts $sock "Host: $host:$port"
	}
	puts $sock "User-Agent: $http(-useragent)"
	if {($state(-protocol) >= 1.0) && $state(-keepalive)} {
	    # Send this header, because a 1.1 server is not compelled to treat
	    # this as the default.
	    puts $sock "Connection: keep-alive"
	}
	if {($state(-protocol) > 1.0) && !$state(-keepalive)} {
	    puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
	}
	if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
	    puts $sock "Proxy-Connection: Keep-Alive"
	}
	set accept_encoding_seen 0
	set content_type_seen 0
	dict for {key value} $state(-headers) {
	    set value [string map [list \n "" \r ""] $value]
	    set key [string map {" " -} [string trim $key]]
	    if {[string equal -nocase $key "host"]} {
		continue
	    }
767
768
769
770
771
772
773

774


775
776
777
778
779
780
781
782
783
784
	    }
	}
	# Allow overriding the Accept header on a per-connection basis. Useful
	# for working with REST services. [Bug c11a51c482]
	if {!$accept_types_seen} {
	    puts $sock "Accept: $state(accept-types)"
	}

        if {!$accept_encoding_seen && ![info exists state(-handler)]} {


	    puts $sock "Accept-Encoding: gzip,deflate,compress"
        }
	if {$isQueryChannel && $state(querylength) == 0} {
	    # Try to determine size of data in channel. If we cannot seek, the
	    # surrounding catch will trap us

	    set start [tell $state(-querychannel)]
	    seek $state(-querychannel) 0 end
	    set state(querylength) \
		    [expr {[tell $state(-querychannel)] - $start}]







>
|
>
>

|
|







1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
	    }
	}
	# Allow overriding the Accept header on a per-connection basis. Useful
	# for working with REST services. [Bug c11a51c482]
	if {!$accept_types_seen} {
	    puts $sock "Accept: $state(accept-types)"
	}
	if {    (!$accept_encoding_seen)
	     && (![info exists state(-handler)])
	     && $http(-zip)
	} {
	    puts $sock "Accept-Encoding: gzip,deflate,compress"
	}
	if {$isQueryChannel && ($state(querylength) == 0)} {
	    # Try to determine size of data in channel. If we cannot seek, the
	    # surrounding catch will trap us

	    set start [tell $state(-querychannel)]
	    seek $state(-querychannel) 0 end
	    set state(querylength) \
		    [expr {[tell $state(-querychannel)] - $start}]
799
800
801
802
803
804
805

806
807
808
809
810
811
812






813
814


815











816
817


818

819
820
821
822
823










824
825










826


827
828
829
830
831








































































































































































































































































































































































































































































































































































































































































































832
833
834
835
836
837
838
839
840
841
842
	# data. Having both fileevents active changes the timing and the
	# behavior, but no two platforms (among Solaris, Linux, and NT) behave
	# the same, and none behave all that well in any case. Servers should
	# always read their POST data if they expect the client to read their
	# response.

	if {$isQuery || $isQueryChannel} {

	    if {!$content_type_seen} {
		puts $sock "Content-Type: $state(-type)"
	    }
	    if {!$contDone} {
		puts $sock "Content-Length: $state(querylength)"
	    }
	    puts $sock ""






	    fconfigure $sock -translation {auto binary}
	    fileevent $sock writable [list http::Write $token]


	} else {











	    puts $sock ""
	    flush $sock


	    fileevent $sock readable [list http::Event $sock $token]

	}

    } err]} {
	# The socket probably was never connected, or the connection dropped
	# later.











	# if state(status) is error, it means someone's already called Finish










	# to do the above-described clean up.


	if {$state(status) ne "error"} {
	    Finish $token $err
	}
    }
}









































































































































































































































































































































































































































































































































































































































































































# Data access functions:
# Data - the URL data
# Status - the transaction status: ok, reset, eof, timeout
# Code - the HTTP transaction code, e.g., 200
# Size - the size of the URL data

proc http::data {token} {
    variable $token
    upvar 0 $token state
    return $state(body)







>







>
>
>
>
>
>
|

>
>

>
>
>
>
>
>
>
>
>
>
>


>
>
|
>



|
|
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
|
>
>
|




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



|







1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
	# data. Having both fileevents active changes the timing and the
	# behavior, but no two platforms (among Solaris, Linux, and NT) behave
	# the same, and none behave all that well in any case. Servers should
	# always read their POST data if they expect the client to read their
	# response.

	if {$isQuery || $isQueryChannel} {
	    # POST method.
	    if {!$content_type_seen} {
		puts $sock "Content-Type: $state(-type)"
	    }
	    if {!$contDone} {
		puts $sock "Content-Length: $state(querylength)"
	    }
	    puts $sock ""
	    flush $sock
	    # Flush flushes the error in the https case with a bad handshake:
	    # else the socket never becomes writable again, and hangs until
	    # timeout (if any).

	    lassign [fconfigure $sock -translation] trRead trWrite
	    fconfigure $sock -translation [list $trRead binary]
	    fileevent $sock writable [list http::Write $token]
	    # The http::Write command decides when to make the socket readable,
	    # using the same test as the GET/HEAD case below.
	} else {
	    # GET or HEAD method.
	    if {    (![catch {fileevent $sock readable} binding])
		 && ($binding eq [list http::CheckEof $sock])
	    } {
		# Remove the "fileevent readable" binding of an idle persistent
		# socket to http::CheckEof.  We can no longer treat bytes
		# received as junk. The server might still time out and
		# half-close the socket if it has not yet received the first
		# "puts".
		fileevent $sock readable {}
	    }
	    puts $sock ""
	    flush $sock
	    Log ^C$tk end sending request - token $token
	    # End of writing (GET/HEAD methods).  The request has been sent.

	    DoneRequest $token
	}

    } err]} {
	# The socket probably was never connected, OR the connection dropped
	# later, OR https handshake error, which may be discovered as late as
	# the "flush" command above...
	Log "WARNING - if testing, pay special attention to this\
		case (GI) which is seldom executed - token $token"
	if {[info exists state(reusing)] && $state(reusing)} {
	    # The socket was closed at the server end, and closed at
	    # this end by http::CheckEof.
    	    if {[TestForReplay $token write $err a]} {
		return
	    } else {
		Finish $token {failed to re-use socket}
	    }

	    # else:
	    # This is NOT a persistent socket that has been closed since its
	    # last use.
	    # If any other requests are in flight or pipelined/queued, they will
	    # be discarded.
	} elseif {$state(status) eq ""} {
	    # ...https handshake errors come here.
	    set msg [registerError $sock]
	    registerError $sock {}
	    if {$msg eq {}} {
		set msg {failed to use socket}
	    }
	    Finish $token $msg
	} elseif {$state(status) ne "error"} {
	    Finish $token $err
	}
    }
}

# http::registerError
#
#	Called (for example when processing TclTLS activity) to register
#	an error for a connection on a specific socket.  This helps
#	http::Connected to deliver meaningful error messages, e.g. when a TLS
#	certificate fails verification.
#
#	Usage: http::registerError socket ?newValue?
#
#	"set" semantics, except that a "get" (a call without a new value) for a
#	non-existent socket returns {}, not an error.

proc http::registerError {sock args} {
    variable registeredErrors

    if {    ([llength $args] == 0)
	 && (![info exists registeredErrors($sock)])
    } {
	return
    } elseif {    ([llength $args] == 1)
	       && ([lindex $args 0] eq {})
    } {
	unset -nocomplain registeredErrors($sock)
	return
    }
    set registeredErrors($sock) {*}$args
}

# http::DoneRequest --
#
#	Command called when a request has been sent.  It will arrange the
#	next request and/or response as appropriate.
#
#	If this command is called when $socketClosing(*), the request $token
#	that calls it must be pipelined and destined to fail.

proc http::DoneRequest {token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    # If pipelined, connect the next HTTP request to the socket.
    if {$state(reusing) && $state(-pipeline)} {
	# Enable next token (if any) to write.
	# The value "Wready" is set only here, and
	# in http::Event after reading the response-headers of a
	# non-reusing transaction.
	# Previous value is $token. It cannot be pending.
	set socketWrState($state(socketinfo)) Wready

	# Now ready to write the next pipelined request (if any).
	http::NextPipelinedWrite $token
    } else {
	# If pipelined, this is the first transaction on this socket.  We wait
	# for the response headers to discover whether the connection is
	# persistent.  (If this is not done and the connection is not
	# persistent, we SHOULD retry and then MUST NOT pipeline before knowing
	# that we have a persistent connection
	# (rfc2616 8.1.2.2)).
    }

    # Connect to receive the response, unless the socket is pipelined
    # and another response is being sent.
    # This code block is separate from the code below because there are
    # cases where socketRdState already has the value $token.
    if {    $state(-keepalive)
	 && $state(-pipeline)
	 && [info exists socketRdState($state(socketinfo))]
	 && ($socketRdState($state(socketinfo)) eq "Rready")
    } {
	#Log pipelined, GRANT read access to $token in Connected
	set socketRdState($state(socketinfo)) $token
    }

    if {    $state(-keepalive)
	 && $state(-pipeline)
	 && [info exists socketRdState($state(socketinfo))]
	 && ($socketRdState($state(socketinfo)) ne $token)
    } {
	# Do not read from the socket until it is ready.
	##Log "HTTP response for token $token is queued for pipelined use"
	# If $socketClosing(*), then the caller will be a pipelined write and
	# execution will come here.
	# This token has already been recorded as "in flight" for writing.
	# When the socket is closed, the read queue will be cleared in
	# CloseQueuedQueries and so the "lappend" here has no effect.
	lappend socketRdQueue($state(socketinfo)) $token
    } else {
	# In the pipelined case, connection for reading depends on the
	# value of socketRdState.
	# In the nonpipeline case, connection for reading always occurs.
	ReceiveResponse $token
    }
}

# http::ReceiveResponse
#
#	Connects token to its socket for reading.

proc http::ReceiveResponse {token} {
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    #Log ---- $state(socketinfo) >> conn to $token for HTTP response
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list auto $trWrite] \
		     -buffersize $state(-blocksize)
    Log ^D$tk begin receiving response - token $token

    coroutine ${token}EventCoroutine http::Event $sock $token
    fileevent $sock readable ${token}EventCoroutine
}

# http::NextPipelinedWrite
#
# - Connecting a socket to a token for writing is done by this command and by
#   command KeepSocket.
# - If another request has a pipelined write scheduled for $token's socket,
#   and if the socket is ready to accept it, connect the write and update
#   the queue accordingly.
# - This command is called from http::DoneRequest and http::Event,
#   IF $state(-pipeline) AND (the current transfer has reached the point at
#   which the socket is ready for the next request to be written).
# - This command is called when a token has write access and is pipelined and
#   keep-alive, and sets socketWrState to Wready.
# - The command need not consider the case where socketWrState is set to a token
#   that does not yet have write access.  Such a token is waiting for Rready,
#   and the assignment of the connection to the token will be done elsewhere (in
#   http::KeepSocket).
# - This command cannot be called after socketWrState has been set to a
#   "pending" token value (that is then overwritten by the caller), because that
#   value is set by this command when it is called by an earlier token when it
#   relinquishes its write access, and the pending token is always the next in
#   line to write.

proc http::NextPipelinedWrite {token} {
    variable http
    variable socketRdState
    variable socketWrState
    variable socketWrQueue
    variable socketClosing
    variable $token
    upvar 0 $token state
    set connId $state(socketinfo)

    if {    [info exists socketClosing($connId)]
	 && $socketClosing($connId)
    } {
	# socketClosing(*) is set because the server has sent a
	# "Connection: close" header.
	# Behave as if the queues are empty - so do nothing.
    } elseif {    $state(-pipeline)
	 && [info exists socketWrState($connId)]
	 && ($socketWrState($connId) eq "Wready")

	 && [info exists socketWrQueue($connId)]
	 && [llength $socketWrQueue($connId)]
	 && ([set token2 [lindex $socketWrQueue($connId) 0]
	      set ${token2}(-pipeline)
	     ]
	    )
    } {
	# - The usual case for a pipelined connection, ready for a new request.
	#Log pipelined, GRANT write access to $token2 in NextPipelinedWrite
	set conn [set ${token2}(tmpConnArgs)]
	set socketWrState($connId) $token2
	set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	# Connect does its own fconfigure.
	fileevent $state(sock) writable [list http::Connect $token2 {*}$conn]
	#Log ---- $connId << conn to $token2 for HTTP request (b)

	# In the tests below, the next request will be nonpipeline.
    } elseif {    $state(-pipeline)
	       && [info exists socketWrState($connId)]
	       && ($socketWrState($connId) eq "Wready")

	       && [info exists socketWrQueue($connId)]
	       && [llength $socketWrQueue($connId)]
	       && (![ set token3 [lindex $socketWrQueue($connId) 0]
		      set ${token3}(-pipeline)
		    ]
		  )

	       && [info exists socketRdState($connId)]
	       && ($socketRdState($connId) eq "Rready")
    } {
	# The case in which the next request will be non-pipelined, and the read
	# and write queues is ready: which is the condition for a non-pipelined
	# write.
	variable $token3
	upvar 0 $token3 state3
	set conn [set ${token3}(tmpConnArgs)]
	#Log nonpipeline, GRANT r/w access to $token3 in NextPipelinedWrite
	set socketRdState($connId) $token3
	set socketWrState($connId) $token3
	set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	# Connect does its own fconfigure.
	fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	#Log ---- $state(sock) << conn to $token3 for HTTP request (c)

    } elseif {    $state(-pipeline)
	 && [info exists socketWrState($connId)]
	 && ($socketWrState($connId) eq "Wready")

	 && [info exists socketWrQueue($connId)]
	 && [llength $socketWrQueue($connId)]
	 && (![set token2 [lindex $socketWrQueue($connId) 0]
	      set ${token2}(-pipeline)
	     ]
	    )
    } {
	# - The case in which the next request will be non-pipelined, but the
	#   read queue is NOT ready.
	# - A read is queued or in progress, but not a write.  Cannot start the
	#   nonpipeline transaction, but must set socketWrState to prevent a new
	#   pipelined request (in http::geturl) jumping the queue.
	# - Because socketWrState($connId) is not set to Wready, the assignment
	#   of the connection to $token2 will be done elsewhere - by command
	#   http::KeepSocket when $socketRdState($connId) is set to "Rready".

	#Log re-use nonpipeline, GRANT delayed write access to $token in NextP..
	set socketWrState($connId) peNding
    }
}

# http::CancelReadPipeline
#
#	Cancel pipelined responses on a closing "Keep-Alive" socket.
#
#	- Called by a variable trace on "unset socketRdState($connId)".
#	- The variable relates to a Keep-Alive socket, which has been closed.
#	- Cancels all pipelined responses. The requests have been sent,
#	  the responses have not yet been received.
#	- This is a hard cancel that ends each transaction with error status,
#	  and closes the connection. Do not use it if you want to replay failed
#	  transactions.
#	- N.B. Always delete ::http::socketRdState($connId) before deleting
#	  ::http::socketRdQueue($connId), or this command will do nothing.
#
# Arguments
#	As for a trace command on a variable.

proc http::CancelReadPipeline {name1 connId op} {
    variable socketRdQueue
    ##Log CancelReadPipeline $name1 $connId $op
    if {[info exists socketRdQueue($connId)]} {
	set msg {the connection was closed by CancelReadPipeline}
	foreach token $socketRdQueue($connId) {
	    set tk [namespace tail $token]
	    Log ^X$tk end of response "($msg)" - token $token
	    set ${token}(status) eof
	    Finish $token ;#$msg
	}
	set socketRdQueue($connId) {}
    }
}

# http::CancelWritePipeline
#
#	Cancel queued events on a closing "Keep-Alive" socket.
#
#	- Called by a variable trace on "unset socketWrState($connId)".
#	- The variable relates to a Keep-Alive socket, which has been closed.
#	- In pipelined or nonpipeline case: cancels all queued requests.  The
#	  requests have not yet been sent, the responses are not due.
#	- This is a hard cancel that ends each transaction with error status,
#	  and closes the connection. Do not use it if you want to replay failed
#	  transactions.
#	- N.B. Always delete ::http::socketWrState($connId) before deleting
#	  ::http::socketWrQueue($connId), or this command will do nothing.
#
# Arguments
#	As for a trace command on a variable.

proc http::CancelWritePipeline {name1 connId op} {
    variable socketWrQueue

    ##Log CancelWritePipeline $name1 $connId $op
    if {[info exists socketWrQueue($connId)]} {
	set msg {the connection was closed by CancelWritePipeline}
	foreach token $socketWrQueue($connId) {
	    set tk [namespace tail $token]
	    Log ^X$tk end of response "($msg)" - token $token
	    set ${token}(status) eof
	    Finish $token ;#$msg
	}
	set socketWrQueue($connId) {}
    }
}

# http::ReplayIfDead --
#
# - A query on a re-used persistent socket failed at the earliest opportunity,
#   because the socket had been closed by the server.  Keep the token, tidy up,
#   and try to connect on a fresh socket.
# - The connection is monitored for eof by the command http::CheckEof.  Thus
#   http::ReplayIfDead is needed only when a server event (half-closing an
#   apparently idle connection), and a client event (sending a request) occur at
#   almost the same time, and neither client nor server detects the other's
#   action before performing its own (an "asynchronous close event").
# - To simplify testing of http::ReplayIfDead, set TEST_EOF 1 in
#   http::KeepSocket, and then http::ReplayIfDead will be called if http::geturl
#   is called at any time after the server timeout.
#
# Arguments:
#	token	Connection token.
#
# Side Effects:
#	Use the same token, but try to open a new socket.

proc http::ReplayIfDead {tokenArg doing} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $tokenArg
    upvar 0 $tokenArg stateArg

    Log running http::ReplayIfDead for $tokenArg $doing

    # 1. Merge the tokens for transactions in flight, the read (response) queue,
    #    and the write (request) queue.

    set InFlightR {}
    set InFlightW {}

    # Obtain the tokens for transactions in flight.
    if {$stateArg(-pipeline)} {
	# Two transactions may be in flight.  The "read" transaction was first.
	# It is unlikely that the server would close the socket if a response
	# was pending; however, an earlier request (as well as the present
	# request) may have been sent and ignored if the socket was half-closed
	# by the server.

	if {    [info exists socketRdState($stateArg(socketinfo))]
	     && ($socketRdState($stateArg(socketinfo)) ne "Rready")
	} {
	    lappend InFlightR $socketRdState($stateArg(socketinfo))
	} elseif {($doing eq "read")} {
	    lappend InFlightR $tokenArg
	}

	if {    [info exists socketWrState($stateArg(socketinfo))]
	     && $socketWrState($stateArg(socketinfo)) ni {Wready peNding}
	} {
	    lappend InFlightW $socketWrState($stateArg(socketinfo))
	} elseif {($doing eq "write")} {
	    lappend InFlightW $tokenArg
	}

	# Report any inconsistency of $tokenArg with socket*state.
	if {    ($doing eq "read")
	     && [info exists socketRdState($stateArg(socketinfo))]
	     && ($tokenArg ne $socketRdState($stateArg(socketinfo)))
	} {
	    Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \
		    ne socketRdState($stateArg(socketinfo)) \
		      $socketRdState($stateArg(socketinfo))

	} elseif {
		($doing eq "write")
	     && [info exists socketWrState($stateArg(socketinfo))]
	     && ($tokenArg ne $socketWrState($stateArg(socketinfo)))
	} {
	    Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \
		    ne socketWrState($stateArg(socketinfo)) \
		      $socketWrState($stateArg(socketinfo))
	}
    } else {
	# One transaction should be in flight.
	# socketRdState, socketWrQueue are used.
	# socketRdQueue should be empty.

	# Report any inconsistency of $tokenArg with socket*state.
	if {$tokenArg ne $socketRdState($stateArg(socketinfo))} {
	    Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \
		    ne socketRdState($stateArg(socketinfo)) \
		      $socketRdState($stateArg(socketinfo))
	}

	# Report the inconsistency that socketRdQueue is non-empty.
	if {    [info exists socketRdQueue($stateArg(socketinfo))]
	     && ($socketRdQueue($stateArg(socketinfo)) ne {})
	} {
	    Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \
		    has read queue socketRdQueue($stateArg(socketinfo)) \
		    $socketRdQueue($stateArg(socketinfo)) ne {}
	}

	lappend InFlightW $socketRdState($stateArg(socketinfo))
	set socketRdQueue($stateArg(socketinfo)) {}
    }

    set newQueue {}
    lappend newQueue {*}$InFlightR
    lappend newQueue {*}$socketRdQueue($stateArg(socketinfo))
    lappend newQueue {*}$InFlightW
    lappend newQueue {*}$socketWrQueue($stateArg(socketinfo))


    # 2. Tidy up tokenArg.  This is a cut-down form of Finish/CloseSocket.
    #    Do not change state(status).
    #    No need to after cancel stateArg(after) - either this is done in
    #    ReplayCore/ReInit, or Finish is called.

    catch {close $stateArg(sock)}

    # 2a. Tidy the tokens in the queues - this is done in ReplayCore/ReInit.
    # - Transactions, if any, that are awaiting responses cannot be completed.
    #   They are listed for re-sending in newQueue.
    # - All tokens are preserved for re-use by ReplayCore, and their variables
    #   will be re-initialised by calls to ReInit.
    # - The relevant element of socketMapping, socketRdState, socketWrState,
    #   socketRdQueue, socketWrQueue, socketClosing, socketPlayCmd will be set
    #   to new values in ReplayCore.

    ReplayCore $newQueue
}

# http::ReplayIfClose --
#
#	A request on a socket that was previously "Connection: keep-alive" has
#	received a "Connection: close" response header.  The server supplies
#	that response correctly, but any later requests already queued on this
#	connection will be lost when the socket closes.
#
#	This command takes arguments that represent the socketWrState,
#	socketRdQueue and socketWrQueue for this connection.  The socketRdState
#	is not needed because the server responds in full to the request that
#	received the "Connection: close" response header.
#
#	Existing request tokens $token (::http::$n) are preserved.  The caller
#	will be unaware that the request was processed this way.

proc http::ReplayIfClose {Wstate Rqueue Wqueue} {
    Log running http::ReplayIfClose for $Wstate $Rqueue $Wqueue

    if {$Wstate in $Rqueue || $Wstate in $Wqueue} {
	Log WARNING duplicate token in http::ReplayIfClose - token $Wstate
	set Wstate Wready
    }

    # 1. Create newQueue
    set InFlightW {}
    if {$Wstate ni {Wready peNding}} {
	lappend InFlightW $Wstate
    }

    set newQueue {}
    lappend newQueue {*}$Rqueue
    lappend newQueue {*}$InFlightW
    lappend newQueue {*}$Wqueue

    # 2. Cleanup - none needed, done by the caller.

    ReplayCore $newQueue
}

# http::ReInit --
#
#	Command to restore a token's state to a condition that
#	makes it ready to replay a request.
#
#	Command http::geturl stores extra state in state(tmp*) so
#	we don't need to do the argument processing again.
#
#	The caller must:
#	- Set state(reusing) and state(sock) to their new values after calling
#	  this command.
#	- Unset state(tmpState), state(tmpOpenCmd) if future calls to ReplayCore
#	  or ReInit are inappropriate for this token. Typically only one retry
#	  is allowed.
#	The caller may also unset state(tmpConnArgs) if this value (and the
#	token) will be used immediately.  The value is needed by tokens that
#	will be stored in a queue.
#
# Arguments:
#	token	Connection token.
#
# Return Value: (boolean) true iff the re-initialisation was successful.

proc http::ReInit {token} {
    variable $token
    upvar 0 $token state

    if {!(
	      [info exists state(tmpState)]
	   && [info exists state(tmpOpenCmd)]
	   && [info exists state(tmpConnArgs)]
	 )
    } {
	Log FAILED in http::ReInit via ReplayCore - NO tmp vars for $token
	return 0
    }

    if {[info exists state(after)]} {
	after cancel $state(after)
	unset state(after)
    }

    # Don't alter state(status) - this would trigger http::wait if it is in use.
    set tmpState    $state(tmpState)
    set tmpOpenCmd  $state(tmpOpenCmd)
    set tmpConnArgs $state(tmpConnArgs)
    foreach name [array names state] {
	if {$name ne "status"} {
	    unset state($name)
	}
    }

    # Don't alter state(status).
    # Restore state(tmp*) - the caller may decide to unset them.
    # Restore state(tmpConnArgs) which is needed for connection.
    # state(tmpState), state(tmpOpenCmd) are needed only for retries.

    dict unset tmpState status
    array set state $tmpState
    set state(tmpState)    $tmpState
    set state(tmpOpenCmd)  $tmpOpenCmd
    set state(tmpConnArgs) $tmpConnArgs

    return 1
}

# http::ReplayCore --
#
#	Command to replay a list of requests, using existing connection tokens.
#
#	Abstracted from http::geturl which stores extra state in state(tmp*) so
#	we don't need to do the argument processing again.
#
# Arguments:
#	newQueue	List of connection tokens.
#
# Side Effects:
#	Use existing tokens, but try to open a new socket.

proc http::ReplayCore {newQueue} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    if {[llength $newQueue] == 0} {
	# Nothing to do.
	return
    }

    ##Log running ReplayCore for {*}$newQueue
    set newToken [lindex $newQueue 0]
    set newQueue [lrange $newQueue 1 end]

    # 3. Use newToken, and restore its values of state(*).  Do not restore
    #    elements tmp* - we try again only once.

    set token $newToken
    variable $token
    upvar 0 $token state

    if {![ReInit $token]} {
	Log FAILED in http::ReplayCore - NO tmp vars
	Finish $token {cannot send this request again}
	return
    }

    set tmpState    $state(tmpState)
    set tmpOpenCmd  $state(tmpOpenCmd)
    set tmpConnArgs $state(tmpConnArgs)
    unset state(tmpState)
    unset state(tmpOpenCmd)
    unset state(tmpConnArgs)

    set state(reusing) 0

    if {$state(-timeout) > 0} {
	set resetCmd [list http::reset $token timeout]
	set state(after) [after $state(-timeout) $resetCmd]
    }

    set pre [clock milliseconds]
    ##Log pre socket opened, - token $token
    ##Log $tmpOpenCmd - token $token
    # 4. Open a socket.
    if {[catch {eval $tmpOpenCmd} sock]} {
	# Something went wrong while trying to establish the connection.
	Log FAILED - $sock
	set state(sock) NONE
	Finish $token $sock
	return
    }
    ##Log post socket opened, - token $token
    set delay [expr {[clock milliseconds] - $pre}]
    if {$delay > 3000} {
	Log socket delay $delay - token $token
    }
    # Command [socket] is called with -async, but takes 5s to 5.1s to return,
    # with probability of order 1 in 10,000.  This may be a bizarre scheduling
    # issue with my (KJN's) system (Fedora Linux).
    # This does not cause a problem (unless the request times out when this
    # command returns).

    # 5. Configure the persistent socket data.
    if {$state(-keepalive)} {
	set socketMapping($state(socketinfo)) $sock

	if {![info exists socketRdState($state(socketinfo))]} {
	    set socketRdState($state(socketinfo)) {}
	    set varName ::http::socketRdState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelReadPipeline
	}

	if {![info exists socketWrState($state(socketinfo))]} {
	    set socketWrState($state(socketinfo)) {}
	    set varName ::http::socketWrState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelWritePipeline
	}

	if {$state(-pipeline)} {
	    #Log new, init for pipelined, GRANT write acc to $token ReplayCore
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	} else {
	    #Log new, init for nonpipeline, GRANT r/w acc to $token ReplayCore
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	}

	set socketRdQueue($state(socketinfo)) {}
	set socketWrQueue($state(socketinfo)) $newQueue
	set socketClosing($state(socketinfo)) 0
	set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
    }

    ##Log pre newQueue ReInit, - token $token
    # 6. Configure sockets in the queue.
    foreach tok $newQueue {
	if {[ReInit $tok]} {
	    set ${tok}(reusing) 1
	    set ${tok}(sock) $sock
	} else {
	    set ${tok}(reusing) 1
	    set ${tok}(sock) NONE
	    Finish $token {cannot send this request again}
	}
    }

    # 7. Configure the socket for newToken to send a request.
    set state(sock) $sock
    Log "Using $sock for $state(socketinfo) - token $token" \
	[expr {$state(-keepalive)?"keepalive":""}]

    # Initialisation of a new socket.
    ##Log socket opened, now fconfigure - token $token
    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)
    ##Log socket opened, DONE fconfigure - token $token

    # Connect does its own fconfigure.
    fileevent $sock writable [list http::Connect $token {*}$tmpConnArgs]
    #Log ---- $sock << conn to $token for HTTP request (e)
}

# Data access functions:
# Data - the URL data
# Status - the transaction status: ok, reset, eof, timeout, error
# Code - the HTTP transaction code, e.g., 200
# Size - the size of the URL data

proc http::data {token} {
    variable $token
    upvar 0 $token state
    return $state(body)
891
892
893
894
895
896
897







898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916

917
918
919
920
921















922
923

924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940









941
942

943
944
945
946
947
948
949
950
951
952













953

954
955
956
957
958
959
960
961
962
963
964
965













966
967
968
969
970
971
972
973
974
975
976
977
978

979
980
981


982

983
984
985
986
987
988
989
990
991
992
993
994
995


996
997
998
999
1000
1001
1002
1003
1004









1005
1006




1007
1008
1009
1010
1011
1012

1013
1014

1015
1016
1017
1018










1019

















1020




































1021
1022


1023
1024














1025






1026

















1027



1028




1029











1030

1031


1032


1033
1034
1035
1036
1037
1038


1039
1040
1041
1042
1043
1044
1045
1046









1047
1048
1049


1050
1051
1052
1053




1054
1055
1056
1057
1058

1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073

1074
1075
1076
1077
1078
1079

1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114

1115
1116
1117




1118


1119

1120
1121
1122

1123






1124

1125


1126
1127




























1128




1129
1130
1131

1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144



1145
1146
1147
1148








1149


1150
1151

















1152









1153



1154
1155
1156


1157
1158
1159
1160


1161
1162


1163
1164
1165




1166
1167
1168
1169
1170
1171



1172
1173
1174
1175

1176

1177
1178
1179
1180
1181
1182
1183
1184
1185

1186

1187
1188







1189
1190





1191

1192
1193

1194
























































1195
1196
1197
1198
1199
1200
1201
#
# Side Effects
#	unsets the state array

proc http::cleanup {token} {
    variable $token
    upvar 0 $token state







    if {[info exists state]} {
	unset state
    }
}

# http::Connect
#
#	This callback is made when an asyncronous connection completes.
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Sets the status of the connection, which unblocks
# 	the waiting geturl call

proc http::Connect {token proto phost srvurl} {
    variable $token
    upvar 0 $token state

    set err "due to unexpected EOF"
    if {
	[eof $state(sock)] ||
	[set err [fconfigure $state(sock) -error]] ne ""
    } {















	Finish $token "connect failed $err"
    } else {

	fileevent $state(sock) writable {}
	::http::Connected $token $proto $phost $srvurl
    }
    return
}

# http::Write
#
#	Write POST query data to the socket
#
# Arguments
#	token	The token for the connection
#
# Side Effects
#	Write the socket and handle callbacks.

proc http::Write {token} {









    variable $token
    upvar 0 $token state

    set sock $state(sock)

    # Output a block.  Tcl will buffer this if the socket blocks
    set done 0
    if {[catch {
	# Catch I/O errors on dead sockets

	if {[info exists state(-query)]} {
	    # Chop up large query strings so queryprogress callback can give
	    # smooth feedback.















	    puts -nonewline $sock \
		[string range $state(-query) $state(queryoffset) \
		     [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
	    incr state(queryoffset) $state(-queryblocksize)
	    if {$state(queryoffset) >= $state(querylength)} {
		set state(queryoffset) $state(querylength)
		set done 1
	    }
	} else {
	    # Copy blocks from the query channel

	    set outStr [read $state(-querychannel) $state(-queryblocksize)]













	    puts -nonewline $sock $outStr
	    incr state(queryoffset) [string length $outStr]
	    if {[eof $state(-querychannel)]} {
		set done 1
	    }
	}
    } err]} {
	# Do not call Finish here, but instead let the read half of the socket
	# process whatever server reply there is to get.

	set state(posterror) $err
	set done 1
    }

    if {$done} {
	catch {flush $sock}
	fileevent $sock writable {}


	fileevent $sock readable [list http::Event $sock $token]

    }

    # Callback to the client after we've completely handled everything.

    if {[string length $state(-queryprogress)]} {
	eval $state(-queryprogress) \
	    [list $token $state(querylength) $state(queryoffset)]
    }
}

# http::Event
#
#	Handle input on the socket


#
# Arguments
#	sock	The socket receiving input.
#	token	The token returned from http::geturl
#
# Side Effects
#	Read the socket and handle callbacks.

proc http::Event {sock token} {









    variable $token
    upvar 0 $token state





    if {![info exists state]} {
	Log "Event $sock with invalid token '$token' - remote close?"
	if {![eof $sock]} {
	    if {[set d [read $sock]] ne ""} {
		Log "WARNING: additional data left on closed socket"

	    }
	}

	CloseSocket $sock
	return
    }
    if {$state(state) eq "connecting"} {










	if {[catch {gets $sock state(http)} n]} {

















	    return [Finish $token $n]




































	} elseif {$n >= 0} {
	    set state(state) "header"


	}
    } elseif {$state(state) eq "header"} {














	if {[catch {gets $sock line} n]} {






	    return [Finish $token $n]

















	} elseif {$n == 0} {



	    # We have now read all headers




	    # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3











	    if {$state(http) == "" || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)} {

		set state(state) "connecting"


		return


	    }

	    set state(state) body

	    # If doing a HEAD, then we won't get any body
	    if {$state(-validate)} {


		Eof $token
		return
	    }

	    # For non-chunked transfer we may have no body - in this case we
	    # may get no further file event if the connection doesn't close
	    # and no more data is sent. We can tell and must finish up now -
	    # not later.









	    if {
		!(([info exists state(connection)]
			&& ($state(connection) eq "close"))


		    || [info exists state(transfer)])
		&& ($state(totalsize) == 0)
	    } {
		Log "body size is 0 and no events likely - complete."




		Eof $token
		return
	    }

	    # We have to use binary translation to count bytes properly.

	    fconfigure $sock -translation binary

	    if {
		$state(-binary) || [IsBinaryContentType $state(type)]
	    } {
		# Turn off conversions for non-text data
		set state(binary) 1
	    }
	    if {[info exists state(-channel)]} {
		if {$state(binary) || [llength [ContentEncoding $token]]} {
		    fconfigure $state(-channel) -translation binary
		}
		if {![info exists state(-handler)]} {
		    # Initiate a sequence of background fcopies
		    fileevent $sock readable {}

		    CopyStart $sock $token
		    return
		}
	    }
	} elseif {$n > 0} {
	    # Process header lines

	    if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
		switch -- [string tolower $key] {
		    content-type {
			set state(type) [string trim [string tolower $value]]
			# grab the optional charset information
			if {[regexp -nocase \
				 {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \
				 $state(type) -> cs]} {
			    set state(charset) [string map {{\"} \"} $cs]
			} else {
			    regexp -nocase {charset\s*=\s*(\S+?);?} \
				$state(type) -> state(charset)
			}
		    }
		    content-length {
			set state(totalsize) [string trim $value]
		    }
		    content-encoding {
			set state(coding) [string trim $value]
		    }
		    transfer-encoding {
			set state(transfer) \
			    [string trim [string tolower $value]]
		    }
		    proxy-connection -
		    connection {
			set state(connection) \
			    [string trim [string tolower $value]]
		    }
		}
		lappend state(meta) $key [string trim $value]
	    }
	}
    } else {
	# Now reading body

	if {[catch {
	    if {[info exists state(-handler)]} {
		set n [eval $state(-handler) [list $sock $token]]




	    } elseif {[info exists state(transfer_final)]} {


		set line [getTextLine $sock]

		set n [string length $line]
		if {$n > 0} {
		    Log "found $n bytes following final chunk"

		    append state(transfer_final) $line






		} else {

		    Log "final chunk part"


		    Eof $token
		}




























	    } elseif {




		[info exists state(transfer)]
		&& $state(transfer) eq "chunked"
	    } {

		set size 0
		set chunk [getTextLine $sock]
		set n [string length $chunk]
		if {[string trim $chunk] ne ""} {
		    scan $chunk %x size
		    if {$size != 0} {
			set bl [fconfigure $sock -blocking]
			fconfigure $sock -blocking 1
			set chunk [read $sock $size]
			fconfigure $sock -blocking $bl
			set n [string length $chunk]
			if {$n >= 0} {
			    append state(body) $chunk



			}
			if {$size != [string length $chunk]} {
			    Log "WARNING: mis-sized chunk:\
				was [string length $chunk], should be $size"








			}


			getTextLine $sock
		    } else {

















			set state(transfer_final) {}









		    }



		}
	    } else {
		#Log "read non-chunk $state(currentsize) of $state(totalsize)"


		set block [read $sock $state(-blocksize)]
		set n [string length $block]
		if {$n >= 0} {
		    append state(body) $block


		}
	    }


	    if {[info exists state]} {
		if {$n >= 0} {
		    incr state(currentsize) $n




		}
		# If Content-Length - check for end of data.
		if {
		    ($state(totalsize) > 0)
		    && ($state(currentsize) >= $state(totalsize))
		} {



		    Eof $token
		}
	    }
	} err]} {

	    return [Finish $token $err]

	} else {
	    if {[info exists state(-progress)]} {
		eval $state(-progress) \
		    [list $token $state(totalsize) $state(currentsize)]
	    }
	}
    }

    # catch as an Eof above may have closed the socket already

    if {![catch {eof $sock} eof] && $eof} {

	if {[info exists $token]} {
	    set state(connection) close







	    Eof $token
	} else {





	    # open connection closed on a token that has been cleaned up.

	    CloseSocket $sock
	}

	return
























































    }
}

# http::IsBinaryContentType --
#
#	Determine if the content-type means that we should definitely transfer
#	the data as binary. [Bug 838e99a76d]







>
>
>
>
>
>
>



















>





>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>



<













>
>
>
>
>
>
>
>
>


>










>
>
>
>
>
>
>
>
>
>
>
>
>
|
>












>
>
>
>
>
>
>
>
>
>
>
>
>













>



>
>
|
>












|
>
>









>
>
>
>
>
>
>
>
>


>
>
>
>

|
|
|
|
|
>
|
|
>
|
|
|
|
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
|
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
|
>
|
>
>
|
>
>
|

|

|
|
>
>
|
|
|

|
|
|
|
>
>
>
>
>
>
>
>
>
|
|
|
>
>
|
|
|
|
>
>
>
>
|
|
|

|
>
|

|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
>
>
>
>
|
>
>
|
>
|
|
<
>
|
>
>
>
>
>
>
|
>
|
>
>
|
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
|
|
|
>
|
|
|
|
|
|
<
|
|
<
|
|
|
>
>
>
|
|
|
|
>
>
>
>
>
>
>
>
|
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
|
>
>
>
|
|
|
>
>
|
|
|
|
>
>
|
|
>
>
|
|
|
>
>
>
>
|
|
|
|
|
|
>
>
>
|
|
|
|
>
|
>
|
|
|
|
|
|
|

|
>
|
>
|
|
>
>
>
>
>
>
>
|
|
>
>
>
>
>
|
>
|
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311

2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716

2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730

2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773

2774
2775

2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
#
# Side Effects
#	unsets the state array

proc http::cleanup {token} {
    variable $token
    upvar 0 $token state
    if {[info commands ${token}EventCoroutine] ne {}} {
	rename ${token}EventCoroutine {}
    }
    if {[info exists state(after)]} {
	after cancel $state(after)
	unset state(after)
    }
    if {[info exists state]} {
	unset state
    }
}

# http::Connect
#
#	This callback is made when an asyncronous connection completes.
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Sets the status of the connection, which unblocks
# 	the waiting geturl call

proc http::Connect {token proto phost srvurl} {
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set err "due to unexpected EOF"
    if {
	[eof $state(sock)] ||
	[set err [fconfigure $state(sock) -error]] ne ""
    } {
	Log "WARNING - if testing, pay special attention to this\
		case (GJ) which is seldom executed - token $token"
	if {[info exists state(reusing)] && $state(reusing)} {
	    # The socket was closed at the server end, and closed at
	    # this end by http::CheckEof.
	    if {[TestForReplay $token write $err b]} {
		return
	    }

	    # else:
	    # This is NOT a persistent socket that has been closed since its
	    # last use.
	    # If any other requests are in flight or pipelined/queued, they will
	    # be discarded.
	}
	Finish $token "connect failed $err"
    } else {
	set state(state) connecting
	fileevent $state(sock) writable {}
	::http::Connected $token $proto $phost $srvurl
    }

}

# http::Write
#
#	Write POST query data to the socket
#
# Arguments
#	token	The token for the connection
#
# Side Effects
#	Write the socket and handle callbacks.

proc http::Write {token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    # Output a block.  Tcl will buffer this if the socket blocks
    set done 0
    if {[catch {
	# Catch I/O errors on dead sockets

	if {[info exists state(-query)]} {
	    # Chop up large query strings so queryprogress callback can give
	    # smooth feedback.
	    if {    $state(queryoffset) + $state(-queryblocksize)
		 >= $state(querylength)
	    } {
		# This will be the last puts for the request-body.
		if {    (![catch {fileevent $sock readable} binding])
		     && ($binding eq [list http::CheckEof $sock])
		} {
		    # Remove the "fileevent readable" binding of an idle
		    # persistent socket to http::CheckEof.  We can no longer
		    # treat bytes received as junk. The server might still time
		    # out and half-close the socket if it has not yet received
		    # the first "puts".
		    fileevent $sock readable {}
		}
	    }
	    puts -nonewline $sock \
		[string range $state(-query) $state(queryoffset) \
		     [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
	    incr state(queryoffset) $state(-queryblocksize)
	    if {$state(queryoffset) >= $state(querylength)} {
		set state(queryoffset) $state(querylength)
		set done 1
	    }
	} else {
	    # Copy blocks from the query channel

	    set outStr [read $state(-querychannel) $state(-queryblocksize)]
	    if {[eof $state(-querychannel)]} {
		# This will be the last puts for the request-body.
		if {    (![catch {fileevent $sock readable} binding])
		     && ($binding eq [list http::CheckEof $sock])
		} {
		    # Remove the "fileevent readable" binding of an idle
		    # persistent socket to http::CheckEof.  We can no longer
		    # treat bytes received as junk. The server might still time
		    # out and half-close the socket if it has not yet received
		    # the first "puts".
		    fileevent $sock readable {}
		}
	    }
	    puts -nonewline $sock $outStr
	    incr state(queryoffset) [string length $outStr]
	    if {[eof $state(-querychannel)]} {
		set done 1
	    }
	}
    } err]} {
	# Do not call Finish here, but instead let the read half of the socket
	# process whatever server reply there is to get.

	set state(posterror) $err
	set done 1
    }

    if {$done} {
	catch {flush $sock}
	fileevent $sock writable {}
	Log ^C$tk end sending request - token $token
	# End of writing (POST method).  The request has been sent.

	DoneRequest $token
    }

    # Callback to the client after we've completely handled everything.

    if {[string length $state(-queryprogress)]} {
	eval $state(-queryprogress) \
	    [list $token $state(querylength) $state(queryoffset)]
    }
}

# http::Event
#
#	Handle input on the socket. This command is the core of
#	the coroutine commands ${token}EventCoroutine that are
#	bound to "fileevent $sock readable" and process input.
#
# Arguments
#	sock	The socket receiving input.
#	token	The token returned from http::geturl
#
# Side Effects
#	Read the socket and handle callbacks.

proc http::Event {sock token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    while 1 {
	yield
	##Log Event call - token $token

	if {![info exists state]} {
	    Log "Event $sock with invalid token '$token' - remote close?"
	    if {![eof $sock]} {
		if {[set d [read $sock]] ne ""} {
		    Log "WARNING: additional data left on closed socket\
			    - token $token"
		}
	    }
	    Log ^X$tk end of response (token error) - token $token
	    CloseSocket $sock
	    return
	}
	if {$state(state) eq "connecting"} {
	    ##Log - connecting - token $token
	    if {    $state(reusing)
		 && $state(-pipeline)
		 && ($state(-timeout) > 0)
		 && (![info exists state(after)])
	    } {
		set state(after) [after $state(-timeout) \
			[list http::reset $token timeout]]
	    }

	    if {[catch {gets $sock state(http)} nsl]} {
		Log "WARNING - if testing, pay special attention to this\
			case (GK) which is seldom executed - token $token"
		if {[info exists state(reusing)] && $state(reusing)} {
		    # The socket was closed at the server end, and closed at
		    # this end by http::CheckEof.

		    if {[TestForReplay $token read $nsl c]} {
			return
		    }

		    # else:
		    # This is NOT a persistent socket that has been closed since
		    # its last use.
		    # If any other requests are in flight or pipelined/queued,
		    # they will be discarded.
		} else {
		    Log ^X$tk end of response (error) - token $token
		    Finish $token $nsl
		    return
		}
	    } elseif {$nsl >= 0} {
		##Log - connecting 1 - token $token
		set state(state) "header"
	    } elseif {    [eof $sock]
		       && [info exists state(reusing)]
		       && $state(reusing)
	    } {
		# The socket was closed at the server end, and we didn't notice.
		# This is the first read - where the closure is usually first
		# detected.

		if {[TestForReplay $token read {} d]} {
		    return
		}

		# else:
		# This is NOT a persistent socket that has been closed since its
		# last use.
		# If any other requests are in flight or pipelined/queued, they
		# will be discarded.
	    }
	} elseif {$state(state) eq "header"} {
	    if {[catch {gets $sock line} nhl]} {
		##Log header failed - token $token
		Log ^X$tk end of response (error) - token $token
		Finish $token $nhl
		return
	    } elseif {$nhl == 0} {
		##Log header done - token $token
		Log ^E$tk end of response headers - token $token
		# We have now read all headers
		# We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
		if {    ($state(http) == "")
		     || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)
		} {
		    set state(state) "connecting"
		    continue
		    # This was a "return" in the pre-coroutine code.
		}

		if {    ([info exists state(connection)])
		     && ([info exists socketMapping($state(socketinfo))])
		     && ($state(connection) eq "keep-alive")
		     && ($state(-keepalive))
		     && (!$state(reusing))
		     && ($state(-pipeline))
		} {
		    # Response headers received for first request on a
		    # persistent socket.  Now ready for pipelined writes (if
		    # any).
		    # Previous value is $token. It cannot be "pending".
		    set socketWrState($state(socketinfo)) Wready
		    http::NextPipelinedWrite $token
		}

		# Once a "close" has been signaled, the client MUST NOT send any
		# more requests on that connection.
		#
		# If either the client or the server sends the "close" token in
		# the Connection header, that request becomes the last one for
		# the connection.

		if {    ([info exists state(connection)])
		     && ([info exists socketMapping($state(socketinfo))])
		     && ($state(connection) eq "close")
		     && ($state(-keepalive))
		} {
		    # The server warns that it will close the socket after this
		    # response.
		    ##Log WARNING - socket will close after response for $token
		    # Prepare data for a call to ReplayIfClose.
		    if {    ($socketRdQueue($state(socketinfo)) ne {})
			 || ($socketWrQueue($state(socketinfo)) ne {})
			 || ($socketWrState($state(socketinfo)) ni
						[list Wready peNding $token])
		    } {
			set InFlightW $socketWrState($state(socketinfo))
			if {$InFlightW in [list Wready peNding $token]} {
			    set InFlightW Wready
			} else {
			    set msg "token ${InFlightW} is InFlightW"
			    ##Log $msg - token $token
			}

			set socketPlayCmd($state(socketinfo)) \
				[list ReplayIfClose $InFlightW \
				$socketRdQueue($state(socketinfo)) \
				$socketWrQueue($state(socketinfo))]

			# - All tokens are preserved for re-use by ReplayCore.
			# - Queues are preserved in case of Finish with error,
			#   but are not used for anything else because
			#   socketClosing(*) is set below.
			# - Cancel the state(after) timeout events.
			foreach tokenVal $socketRdQueue($state(socketinfo)) {
			    if {[info exists ${tokenVal}(after)]} {
				after cancel [set ${tokenVal}(after)]
				unset ${tokenVal}(after)
			    }
			}

		    } else {
			set socketPlayCmd($state(socketinfo)) \
				{ReplayIfClose Wready {} {}}
		    }

		    # Do not allow further connections on this socket.
		    set socketClosing($state(socketinfo)) 1
		}

		set state(state) body

		# If doing a HEAD, then we won't get any body
		if {$state(-validate)} {
		    Log ^F$tk end of response for HEAD request - token $token
		    set state(state) complete
		    Eot $token
		    return
		}

		# - For non-chunked transfer we may have no body - in this case
		#   we may get no further file event if the connection doesn't
		#   close and no more data is sent. We can tell and must finish
		#   up now - not later - the alternative would be to wait until
		#   the server times out.
		# - In this case, the server has NOT told the client it will
		#   close the connection, AND it has NOT indicated the resource
		#   length EITHER by setting the Content-Length (totalsize) OR
		#   by using chunked Transfer-Encoding.
		# - Do not worry here about the case (Connection: close) because
		#   the server should close the connection.
		# - IF (NOT Connection: close) AND (NOT chunked encoding) AND
		#      (totalsize == 0).

		if {    (!(    [info exists state(connection)]
			    && ($state(connection) eq "close")
			  )
			)
		     && (![info exists state(transfer)])
		     && ($state(totalsize) == 0)
		} {
		    set msg {body size is 0 and no events likely - complete}
		    Log "$msg - token $token"
		    set msg {(length unknown, set to 0)}
		    Log ^F$tk end of response body {*}$msg - token $token
		    set state(state) complete
		    Eot $token
		    return
		}

		# We have to use binary translation to count bytes properly.
		lassign [fconfigure $sock -translation] trRead trWrite
		fconfigure $sock -translation [list binary $trWrite]

		if {
		    $state(-binary) || [IsBinaryContentType $state(type)]
		} {
		    # Turn off conversions for non-text data.
		    set state(binary) 1
		}
		if {[info exists state(-channel)]} {
		    if {$state(binary) || [llength [ContentEncoding $token]]} {
			fconfigure $state(-channel) -translation binary
		    }
		    if {![info exists state(-handler)]} {
			# Initiate a sequence of background fcopies.
			fileevent $sock readable {}
			rename ${token}EventCoroutine {}
			CopyStart $sock $token
			return
		    }
		}
	    } elseif {$nhl > 0} {
		# Process header lines.
		##Log header - token $token - $line
		if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
		    switch -- [string tolower $key] {
			content-type {
			    set state(type) [string trim [string tolower $value]]
			    # Grab the optional charset information.
			    if {[regexp -nocase \
				    {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \
				    $state(type) -> cs]} {
				set state(charset) [string map {{\"} \"} $cs]
			    } else {
				regexp -nocase {charset\s*=\s*(\S+?);?} \
					$state(type) -> state(charset)
			    }
			}
			content-length {
			    set state(totalsize) [string trim $value]
			}
			content-encoding {
			    set state(coding) [string trim $value]
			}
			transfer-encoding {
			    set state(transfer) \
				    [string trim [string tolower $value]]
			}
			proxy-connection -
			connection {
			    set state(connection) \
				    [string trim [string tolower $value]]
			}
		    }
		    lappend state(meta) $key [string trim $value]
		}
	    }
	} else {
	    # Now reading body
	    ##Log body - token $token
	    if {[catch {
		if {[info exists state(-handler)]} {
		    set n [eval $state(-handler) [list $sock $token]]
		    ##Log handler $n - token $token
		    # N.B. the protocol has been set to 1.0 because the -handler
		    # logic is not expected to handle chunked encoding.
		    # FIXME Allow -handler with 1.1 on dechunked stacked chan.
		    if {$state(totalsize) == 0} {
			# We know the transfer is complete only when the server
			# closes the connection - i.e. eof is not an error.
			set state(state) complete
		    }
		    if {![string is integer -strict $n]} {
			if 1 {

			    # Do not tolerate bad -handler - fail with error
			    # status.
			    set msg {the -handler command for http::geturl must\
				    return an integer (the number of bytes\
				    read)}
			    Log ^X$tk end of response (handler error) -\
				    token $token
			    Eot $token $msg
			} else {
			    # Tolerate the bad -handler, and continue.  The
			    # penalty:
			    # (a) Because the handler returns nonsense, we know
			    #     the transfer is complete only when the server
			    #     closes the connection - i.e. eof is not an

			    #     error.
			    # (b) http::size will not be accurate.
			    # (c) The transaction is already downgraded to 1.0
			    #     to avoid chunked transfer encoding.  It MUST
			    #     also be forced to "Connection: close" or the
			    #     HTTP/1.0 equivalent; or it MUST fail (as
			    #     above) if the server sends
			    #     "Connection: keep-alive" or the HTTP/1.0
			    #     equivalent.
			    set n 0
			    set state(state) complete
			}
		    }
		} elseif {[info exists state(transfer_final)]} {
		    # This code forgives EOF in place of the final CRLF.
		    set line [getTextLine $sock]
		    set n [string length $line]
		    set state(state) complete
		    if {$n > 0} {
			# - HTTP trailers (late response headers) are permitted
			#   by Chunked Transfer-Encoding, and can be safely
			#   ignored.
			# - Do not count these bytes in the total received for
			#   the response body.
			Log "trailer of $n bytes after final chunk -\
				token $token"
			append state(transfer_final) $line
			set n 0
		    } else {
			Log ^F$tk end of response body (chunked) - token $token
			Log "final chunk part - token $token"
			Eot $token
		    }
		} elseif {    [info exists state(transfer)]
			   && ($state(transfer) eq "chunked")
		} {
		    ##Log chunked - token $token
		    set size 0
		    set hexLenChunk [getTextLine $sock]
		    #set ntl [string length $hexLenChunk]
		    if {[string trim $hexLenChunk] ne ""} {
			scan $hexLenChunk %x size
			if {$size != 0} {

			    ##Log chunk-measure $size - token $token
			    set chunk [BlockingRead $sock $size]

			    set n [string length $chunk]
			    if {$n >= 0} {
				append state(body) $chunk
				incr state(log_size) [string length $chunk]
				##Log chunk $n cumul $state(log_size) -\
					token $token
			    }
			    if {$size != [string length $chunk]} {
				Log "WARNING: mis-sized chunk:\
				    was [string length $chunk], should be\
				    $size - token $token"
				set n 0
				set state(connection) close
				Log ^X$tk end of response (chunk error) \
					- token $token
				set msg {error in chunked encoding - fetch\
					terminated}
				Eot $token $msg
			    }
			    # CRLF that follows chunk.
			    # If eof, this is handled at the end of this proc.
			    getTextLine $sock
			} else {
			    set n 0
			    set state(transfer_final) {}
			}
		    } else {
			# Line expected to hold chunk length is empty, or eof.
			##Log bad-chunk-measure - token $token
			set n 0
			set state(connection) close
			Log ^X$tk end of response (chunk error) - token $token
			Eot $token {error in chunked encoding -\
				fetch terminated}
		    }
		} else {
		    ##Log unchunked - token $token
		    if {$state(totalsize) == 0} {
			# We know the transfer is complete only when the server
			# closes the connection.
			set state(state) complete
			set reqSize $state(-blocksize)
		    } else {
			# Ask for the whole of the unserved response-body.
			# This works around a problem with a tls::socket - for
			# https in keep-alive mode, and a request for
			# $state(-blocksize) bytes, the last part of the
			# resource does not get read until the server times out.
			set reqSize [expr {  $state(totalsize)
					   - $state(currentsize)}]

			# The workaround fails if reqSize is
			# capped at $state(-blocksize).
			# set reqSize [expr {min($reqSize, $state(-blocksize))}]
		    }
		    set c $state(currentsize)
		    set t $state(totalsize)
		    ##Log non-chunk currentsize $c of totalsize $t -\
			    token $token
		    set block [read $sock $reqSize]
		    set n [string length $block]
		    if {$n >= 0} {
			append state(body) $block
			##Log non-chunk [string length $state(body)] -\
				token $token
		    }
		}
		# This calculation uses n from the -handler, chunked, or
		# unchunked case as appropriate.
		if {[info exists state]} {
		    if {$n >= 0} {
			incr state(currentsize) $n
			set c $state(currentsize)
			set t $state(totalsize)
			##Log another $n currentsize $c totalsize $t -\
				token $token
		    }
		    # If Content-Length - check for end of data.
		    if {
			   ($state(totalsize) > 0)
			&& ($state(currentsize) >= $state(totalsize))
		    } {
			Log ^F$tk end of response body (unchunked) -\
				token $token
			set state(state) complete
			Eot $token
		    }
		}
	    } err]} {
		Log ^X$tk end of response (error ${err}) - token $token
		Finish $token $err
		return
	    } else {
		if {[info exists state(-progress)]} {
		    eval $state(-progress) \
			[list $token $state(totalsize) $state(currentsize)]
		}
	    }
	}

	# catch as an Eot above may have closed the socket already
	# $state(state) may be connecting, header, body, or complete
	if {![set cc [catch {eof $sock} eof]] && $eof} {
	    ##Log eof - token $token
	    if {[info exists $token]} {
		set state(connection) close
		if {$state(state) eq "complete"} {
		    # This includes all cases in which the transaction
		    # can be completed by eof.
		    # The value "complete" is set only in http::Event, and it is
		    # used only in the test above.
		    Log ^F$tk end of response body (unchunked, eof) -\
			    token $token
		    Eot $token
		} else {
		    # Premature eof.
		    Log ^X$tk end of response (unexpected eof) - token $token
		    Eot $token eof
		}
	    } else {
		# open connection closed on a token that has been cleaned up.
		Log ^X$tk end of response (token error) - token $token
		CloseSocket $sock
	    }
	} elseif {$cc} {
	    return
	}
    }
}

# http::TestForReplay
#
#	Command called if eof is discovered when a socket is first used for a
#	new transaction.  Typically this occurs if a persistent socket is used
#	after a period of idleness and the server has half-closed the socket.
#
# token  - the connection token returned by http::geturl
# doing  - "read" or "write"
# err    - error message, if any
# caller - code to identify the caller - used only in logging
#
# Return Value: boolean, true iff the command calls http::ReplayIfDead.

proc http::TestForReplay {token doing err caller} {
    variable http
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    if {$doing eq "read"} {
	set code Q
	set action response
	set ing reading
    } else {
	set code P
	set action request
	set ing writing
    }

    if {$err eq {}} {
	set err "detect eof when $ing (server timed out?)"
    }

    if {$state(method) eq "POST" && !$http(-repost)} {
	# No Replay.
	# The present transaction will end when Finish is called.
	# That call to Finish will abort any other transactions
	# currently in the write queue.
	# For calls from http::Event this occurs when execution
	# reaches the code block at the end of that proc.
	set msg {no retry for POST with http::config -repost 0}
	Log reusing socket failed "($caller)" - $msg - token $token
	Log error - $err - token $token
	Log ^X$tk end of $action (error) - token $token
	return 0
    } else {
	# Replay.
	set msg {try a new socket}
	Log reusing socket failed "($caller)" - $msg - token $token
	Log error - $err - token $token
	Log ^$code$tk Any unfinished (incl this one) failed - token $token
	ReplayIfDead $token $doing
	return 1
    }
}

# http::IsBinaryContentType --
#
#	Determine if the content-type means that we should definitely transfer
#	the data as binary. [Bug 838e99a76d]
1225
1226
1227
1228
1229
1230
1231
1232



1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247










































1248
1249
1250
1251
1252
1253
1254
	return false
    }
    return true
}

# http::getTextLine --
#
#	Get one line with the stream in blocking crlf mode



#
# Arguments
#	sock	The socket receiving input.
#
# Results:
#	The line of text, without trailing newline

proc http::getTextLine {sock} {
    set tr [fconfigure $sock -translation]
    set bl [fconfigure $sock -blocking]
    fconfigure $sock -translation crlf -blocking 1
    set r [gets $sock]
    fconfigure $sock -translation $tr -blocking $bl
    return $r
}











































# http::CopyStart
#
#	Error handling wrapper around fcopy
#
# Arguments
#	sock	The socket to copy from







|
>
>
>









|
|
|
|


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
	return false
    }
    return true
}

# http::getTextLine --
#
#	Get one line with the stream in crlf mode.
#	Used if Transfer-Encoding is chunked.
#	Empty line is not distinguished from eof.  The caller must
#	be able to handle this.
#
# Arguments
#	sock	The socket receiving input.
#
# Results:
#	The line of text, without trailing newline

proc http::getTextLine {sock} {
    set tr [fconfigure $sock -translation]
    lassign $tr trRead trWrite
    fconfigure $sock -translation [list crlf $trWrite]
    set r [BlockingGets $sock]
    fconfigure $sock -translation $tr
    return $r
}

# http::BlockingRead
#
#	Replacement for a blocking read.
#	The caller must be a coroutine.

proc http::BlockingRead {sock size} {
    if {$size < 1} {
	return
    }
    set result {}
    while 1 {
	set need [expr {$size - [string length $result]}]
	set block [read $sock $need]
	set eof [eof $sock]
	append result $block
	if {[string length $result] >= $size || $eof} {
	    return $result
	} else {
	    yield
	}
    }
}

# http::BlockingGets
#
#	Replacement for a blocking gets.
#	The caller must be a coroutine.
#	Empty line is not distinguished from eof.  The caller must
#	be able to handle this.

proc http::BlockingGets {sock} {
    while 1 {
	set count [gets $sock line]
	set eof [eof $sock]
	if {$count > -1 || $eof} {
	    return $line
	} else {
	    yield
	}
    }
}

# http::CopyStart
#
#	Error handling wrapper around fcopy
#
# Arguments
#	sock	The socket to copy from
1267
1268
1269
1270
1271
1272
1273




1274
1275
1276
1277
1278
1279
1280
    } else {
	if {$initial} {
	    foreach coding [ContentEncoding $token] {
		zlib push $coding $sock
	    }
	}
	if {[catch {




	    fcopy $sock $state(-channel) -size $state(-blocksize) -command \
		[list http::CopyDone $token]
	} err]} {
	    Finish $token $err
	}
    }
}







>
>
>
>







3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
    } else {
	if {$initial} {
	    foreach coding [ContentEncoding $token] {
		zlib push $coding $sock
	    }
	}
	if {[catch {
	    # FIXME Keep-Alive on https tls::socket with unchunked transfer
	    # hangs until the server times out. A workaround is possible, as for
	    # the case without -channel, but it does not use the neat "fcopy"
	    # solution.
	    fcopy $sock $state(-channel) -size $state(-blocksize) -command \
		[list http::CopyDone $token]
	} err]} {
	    Finish $token $err
	}
    }
}
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
	}
	puts -nonewline $state(-channel) $chunk
	if {[info exists state(-progress)]} {
	    eval [linsert $state(-progress) end \
		      $token $state(totalsize) $state(currentsize)]
	}
    } else {
	Log "CopyChunk Finish $token"
	if {[info exists state(zlib)]} {
	    set excess ""
	    foreach stream $state(zlib) {
		catch {set excess [$stream add -finalize $excess]}
	    }
	    puts -nonewline $state(-channel) $excess
	    foreach stream $state(zlib) { $stream close }
	    unset state(zlib)
	}
	Eof $token ;# FIX ME: pipelining.
    }
}

# http::CopyDone
#
#	fcopy completion callback
#







|









|







3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
	}
	puts -nonewline $state(-channel) $chunk
	if {[info exists state(-progress)]} {
	    eval [linsert $state(-progress) end \
		      $token $state(totalsize) $state(currentsize)]
	}
    } else {
	Log "CopyChunk Finish - token $token"
	if {[info exists state(zlib)]} {
	    set excess ""
	    foreach stream $state(zlib) {
		catch {set excess [$stream add -finalize $excess]}
	    }
	    puts -nonewline $state(-channel) $excess
	    foreach stream $state(zlib) { $stream close }
	    unset state(zlib)
	}
	Eot $token ;# FIX ME: pipelining.
    }
}

# http::CopyDone
#
#	fcopy completion callback
#
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342

1343








1344
1345
1346






1347
1348
1349
1350
1351
1352
1353
1354
1355
1356




1357

1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368

1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
    upvar 0 $token state
    set sock $state(sock)
    incr state(currentsize) $count
    if {[info exists state(-progress)]} {
	eval $state(-progress) \
	    [list $token $state(totalsize) $state(currentsize)]
    }
    # At this point the token may have been reset
    if {[string length $error]} {
	Finish $token $error
    } elseif {[catch {eof $sock} iseof] || $iseof} {
	Eof $token
    } else {
	CopyStart $sock $token 0
    }
}

# http::Eof
#

#	Handle eof on the socket








#
# Arguments
#	token	The token returned from http::geturl






#
# Side Effects
#	Clean up the socket

proc http::Eof {token {force 0}} {
    variable $token
    upvar 0 $token state
    if {$state(state) eq "header"} {
	# Premature eof
	set state(status) eof




    } else {

	set state(status) ok
    }

    if {[string length $state(body)] > 0} {
	if {[catch {
	    foreach coding [ContentEncoding $token] {
		set state(body) [zlib $coding $state(body)]
	    }
	} err]} {
	    Log "error doing decompression: $err"
	    return [Finish $token $err]

	}

	if {!$state(binary)} {
	    # If we are getting text, set the incoming channel's encoding
	    # correctly.  iso8859-1 is the RFC default, but this could be any IANA
	    # charset.  However, we only know how to convert what we have
	    # encodings for.

	    set enc [CharsetToEncoding $state(charset)]
	    if {$enc ne "binary"} {
		set state(body) [encoding convertfrom $enc $state(body)]
	    }

	    # Translate text line endings.
	    set state(body) [string map {\r\n \n \r \n} $state(body)]
	}
    }
    Finish $token
}

# http::wait --
#
#	See documentation for details.
#
# Arguments:
#	token	Connection token.
#
# Results:
#        The status after the wait.

proc http::wait {token} {
    variable $token
    upvar 0 $token state

    if {![info exists state(status)] || $state(status) eq ""} {
	# We must wait on the original variable name, not the upvar alias







|



|





|

>
|
>
>
>
>
>
>
>
>



>
>
>
>
>
>




|


|
|

>
>
>
>

>









|
|
>




|
|











|










|







3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
    upvar 0 $token state
    set sock $state(sock)
    incr state(currentsize) $count
    if {[info exists state(-progress)]} {
	eval $state(-progress) \
	    [list $token $state(totalsize) $state(currentsize)]
    }
    # At this point the token may have been reset.
    if {[string length $error]} {
	Finish $token $error
    } elseif {[catch {eof $sock} iseof] || $iseof} {
	Eot $token
    } else {
	CopyStart $sock $token 0
    }
}

# http::Eot
#
#	Called when either:
#	a. An eof condition is detected on the socket.
#	b. The client decides that the response is complete.
#	c. The client detects an inconsistency and aborts the transaction.
#
#	Does:
#	1. Set state(status)
#	2. Reverse any Content-Encoding
#	3. Convert charset encoding and line ends if necessary
#	4. Call http::Finish
#
# Arguments
#	token	The token returned from http::geturl
#	force	(previously) optional, has no effect
#	reason	- "eof" means premature EOF (not EOF as the natural end of
#		  the response)
#		- "" means completion of response, with or without EOF
#		- anything else describes an error confition other than
#		  premature EOF.
#
# Side Effects
#	Clean up the socket

proc http::Eot {token {reason {}}} {
    variable $token
    upvar 0 $token state
    if {$reason eq "eof"} {
	# Premature eof.
	set state(status) eof
	set reason {}
    } elseif {$reason ne ""} {
	# Abort the transaction.
	set state(status) $reason
    } else {
	# The response is complete.
	set state(status) ok
    }

    if {[string length $state(body)] > 0} {
	if {[catch {
	    foreach coding [ContentEncoding $token] {
		set state(body) [zlib $coding $state(body)]
	    }
	} err]} {
	    Log "error doing decompression for token $token: $err"
	    Finish $token $err
	    return
	}

	if {!$state(binary)} {
	    # If we are getting text, set the incoming channel's encoding
	    # correctly.  iso8859-1 is the RFC default, but this could be any
	    # IANA charset.  However, we only know how to convert what we have
	    # encodings for.

	    set enc [CharsetToEncoding $state(charset)]
	    if {$enc ne "binary"} {
		set state(body) [encoding convertfrom $enc $state(body)]
	    }

	    # Translate text line endings.
	    set state(body) [string map {\r\n \n \r \n} $state(body)]
	}
    }
    Finish $token $reason
}

# http::wait --
#
#	See documentation for details.
#
# Arguments:
#	token	Connection token.
#
# Results:
#	The status after the wait.

proc http::wait {token} {
    variable $token
    upvar 0 $token state

    if {![info exists state(status)] || $state(status) eq ""} {
	# We must wait on the original variable name, not the upvar alias
1417
1418
1419
1420
1421
1422
1423






1424
1425
1426
1427
1428
1429
1430
# Arguments:
#	args	A list of name-value pairs.
#
# Results:
#	TODO

proc http::formatQuery {args} {






    set result ""
    set sep ""
    foreach i $args {
	append result $sep [mapReply $i]
	if {$sep eq "="} {
	    set sep &
	} else {







>
>
>
>
>
>







3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
# Arguments:
#	args	A list of name-value pairs.
#
# Results:
#	TODO

proc http::formatQuery {args} {
    if {[llength $args] % 2} {
        return \
            -code error \
            -errorcode [list HTTP BADARGCNT $args] \
            {Incorrect number of arguments, must be an even number.}
    }
    set result ""
    set sep ""
    foreach i $args {
	append result $sep [mapReply $i]
	if {$sep eq "="} {
	    set sep &
	} else {
1461
1462
1463
1464
1465
1466
1467

1468
1469
1470
1471
1472
1473
1474
	regexp "\[\u0100-\uffff\]" $converted badChar
	# Return this error message for maximum compatibility... :^/
	return -code error \
	    "can't read \"formMap($badChar)\": no such element in array"
    }
    return $converted
}


# http::ProxyRequired --
#	Default proxy filter.
#
# Arguments:
#	host	The destination host
#







>







3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
	regexp "\[\u0100-\uffff\]" $converted badChar
	# Return this error message for maximum compatibility... :^/
	return -code error \
	    "can't read \"formMap($badChar)\": no such element in array"
    }
    return $converted
}
interp alias {} http::quoteString {} http::mapReply

# http::ProxyRequired --
#	Default proxy filter.
#
# Arguments:
#	host	The destination host
#
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559


1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576

1577

1578
1579
1580
1581
1582
1583
1584
1585
		    return -code error "unsupported content-encoding \"$coding\""
		}
	    }
	}
    }
    return $r
}

proc http::make-transformation-chunked {chan command} {
    set lambda {{chan command} {
        set data ""
        set size -1
        yield
        while {1} {
            chan configure $chan -translation {crlf binary}
            while {[gets $chan line] < 1} { yield }
            chan configure $chan -translation {binary binary}
            if {[scan $line %x size] != 1} { return -code error "invalid size: \"$line\"" }


            set chunk ""
            while {$size && ![chan eof $chan]} {
                set part [chan read $chan $size]
                incr size -[string length $part]
                append chunk $part
            }
            if {[catch {
		uplevel #0 [linsert $command end $chunk]
	    }]} {
		http::Log "Error in callback: $::errorInfo"
	    }
            if {[string length $chunk] == 0} {
		# channel might have been closed in the callback
                catch {chan event $chan readable {}}
                return
            }
        }

    }}

    coroutine dechunk$chan ::apply $lambda $chan $command
    chan event $chan readable [namespace origin dechunk$chan]
    return
}

# Local variables:
# indent-tabs-mode: t
# End:








|
<
|
|
|
|
|
|
|
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
>
|
|
<





3382
3383
3384
3385
3386
3387
3388
3389
3390

3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422

3423
3424
3425
3426
3427
		    return -code error "unsupported content-encoding \"$coding\""
		}
	    }
	}
    }
    return $r
}

proc http::ReceiveChunked {chan command} {

    set data ""
    set size -1
    yield
    while {1} {
	chan configure $chan -translation {crlf binary}
	while {[gets $chan line] < 1} { yield }
	chan configure $chan -translation {binary binary}
	if {[scan $line %x size] != 1} {
	    return -code error "invalid size: \"$line\""
	}
	set chunk ""
	while {$size && ![chan eof $chan]} {
	    set part [chan read $chan $size]
	    incr size -[string length $part]
	    append chunk $part
	}
	if {[catch {
	    uplevel #0 [linsert $command end $chunk]
	}]} {
	    http::Log "Error in callback: $::errorInfo"
	}
	if {[string length $chunk] == 0} {
	    # channel might have been closed in the callback
	    catch {chan event $chan readable {}}
	    return
	}
    }
}

proc http::make-transformation-chunked {chan command} {
    coroutine [namespace current]::dechunk$chan ::http::ReceiveChunked $chan $command
    chan event $chan readable [namespace current]::dechunk$chan

}

# Local variables:
# indent-tabs-mode: t
# End:
Changes to library/http/pkgIndex.tcl.
1
2
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.8.13 [list tclPkgSetup $dir http 2.8.13 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

|
1
2
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.9.0 [list tclPkgSetup $dir http 2.9.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
Changes to library/init.tcl.
1
2
3
4
5
6
7
8
9



10
11
12
13
14
15
16
# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.



#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# This test intentionally written in pre-7.5 Tcl
if {[info commands package] == ""} {








|
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2004 by Kevin B. Kenny.
# Copyright (c) 2018 by Sean Woods
#
# All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# This test intentionally written in pre-7.5 Tcl
if {[info commands package] == ""} {
791
792
793
794
795
796
797

















    foreach s [lsort -unique $filelist] {
	if {[file tail $s] ni {. ..}} {
	    file copy -force -- $s [file join $dest [file tail $s]]
	}
    }
    return
}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
    foreach s [lsort -unique $filelist] {
	if {[file tail $s] ni {. ..}} {
	    file copy -force -- $s [file join $dest [file tail $s]]
	}
    }
    return
}
set isafe [interp issafe]
###
# Package manifest for all Tcl packages included in the /library file system
###
set isafe [interp issafe]
set dir [file dirname [info script]]
foreach {safe package version file} {
  0 http            2.9.0 {http http.tcl}
  1 msgcat          1.7.0  {msgcat msgcat.tcl}
  1 opt             0.4.7  {opt optparse.tcl}
  0 platform        1.0.14 {platform platform.tcl}
  0 platform::shell 1.1.4  {platform shell.tcl}
  1 tcltest         2.4.1  {tcltest tcltest.tcl}
} {
  if {$isafe && !$safe} continue
  package ifneeded $package $version  [list source [file join $dir {*}$file]]
}
Added library/install.tcl.








































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
###
# Installer actions built into tclsh and invoked
# if the first command line argument is "install"
###
if {[llength $argv] < 2} {
  exit 0
}
namespace eval ::practcl {}
###
# Installer tools
###
proc ::practcl::_isdirectory name {
  return [file isdirectory $name]
}
###
# Return true if the pkgindex file contains
# any statement other than "package ifneeded"
# and/or if any package ifneeded loads a DLL
###
proc ::practcl::_pkgindex_directory {path} {
  set buffer {}
  set pkgidxfile [file join $path pkgIndex.tcl]
  if {![file exists $pkgidxfile]} {
    # No pkgIndex file, read the source
    foreach file [glob -nocomplain $path/*.tm] {
      set file [file normalize $file]
      set fname [file rootname [file tail $file]]
      ###
      # We used to be able to ... Assume the package is correct in the filename
      # No hunt for a "package provides"
      ###
      set package [lindex [split $fname -] 0]
      set version [lindex [split $fname -] 1]
      ###
      # Read the file, and override assumptions as needed
      ###
      set fin [open $file r]
      set dat [read $fin]
      close $fin
      # Look for a teapot style Package statement
      foreach line [split $dat \n] {
        set line [string trim $line]
        if { [string range $line 0 9] != "# Package " } continue
        set package [lindex $line 2]
        set version [lindex $line 3]
        break
      }
      # Look for a package provide statement
      foreach line [split $dat \n] {
        set line [string trim $line]
        if { [string range $line 0 14] != "package provide" } continue
        set package [lindex $line 2]
        set version [lindex $line 3]
        break
      }
      append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
    }
    foreach file [glob -nocomplain $path/*.tcl] {
      if { [file tail $file] == "version_info.tcl" } continue
      set fin [open $file r]
      set dat [read $fin]
      close $fin
      if {![regexp "package provide" $dat]} continue
      set fname [file rootname [file tail $file]]
      # Look for a package provide statement
      foreach line [split $dat \n] {
        set line [string trim $line]
        if { [string range $line 0 14] != "package provide" } continue
        set package [lindex $line 2]
        set version [lindex $line 3]
        if {[string index $package 0] in "\$ \[ @"} continue
        if {[string index $version 0] in "\$ \[ @"} continue
        append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
        break
      }
    }
    return $buffer
  }
  set fin [open $pkgidxfile r]
  set dat [read $fin]
  close $fin
  set trace 0
  #if {[file tail $path] eq "tool"} {
  #  set trace 1
  #}
  set thisline {}
  foreach line [split $dat \n] {
    append thisline $line \n
    if {![info complete $thisline]} continue
    set line [string trim $line]
    if {[string length $line]==0} {
      set thisline {} ; continue
    }
    if {[string index $line 0] eq "#"} {
      set thisline {} ; continue
    }
    if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} {
      if {$trace} {puts "[file dirname $pkgidxfile] Ignoring $thisline"}
      set thisline {} ; continue
    }
    if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} {
      if {$trace} { puts "[file dirname $pkgidxfile] Ignoring $thisline" }
      set thisline {} ; continue
    }
    if {![regexp "package.*ifneeded" $thisline]} {
      # This package index contains arbitrary code
      # source instead of trying to add it to the master
      # package index
      if {$trace} { puts "[file dirname $pkgidxfile] Arbitrary code $thisline" }
      return {source [file join $dir pkgIndex.tcl]}
    }
    append buffer $thisline \n
    set thisline {}
  }
  if {$trace} {puts [list [file dirname $pkgidxfile] $buffer]}
  return $buffer
}


proc ::practcl::_pkgindex_path_subdir {path} {
  set result {}
  foreach subpath [glob -nocomplain [file join $path *]] {
    if {[file isdirectory $subpath]} {
      lappend result $subpath {*}[_pkgindex_path_subdir $subpath]
    }
  }
  return $result
}
###
# Index all paths given as though they will end up in the same
# virtual file system
###
proc ::practcl::pkgindex_path args {
  set stack {}
  set buffer {
lappend ::PATHSTACK $dir
  }
  foreach base $args {
    set base [file normalize $base]
    set paths {}
    foreach dir [glob -nocomplain [file join $base *]] {
      if {[file tail $dir] eq "teapot"} continue
      lappend paths $dir {*}[::practcl::_pkgindex_path_subdir $dir]
    }
    set i    [string length  $base]
    # Build a list of all of the paths
    if {[llength $paths]} {
      foreach path $paths {
        if {$path eq $base} continue
        set path_indexed($path) 0
      }
    } else {
      puts [list WARNING: NO PATHS FOUND IN $base]
    }
    set path_indexed($base) 1
    set path_indexed([file join $base boot tcl]) 1
    foreach teapath [glob -nocomplain [file join $base teapot *]] {
      set pkg [file tail $teapath]
      append buffer [list set pkg $pkg]
      append buffer {
set pkginstall [file join $::g(HOME) teapot $pkg]
if {![file exists $pkginstall]} {
  installDir [file join $dir teapot $pkg] $pkginstall
}
}
    }
    foreach path $paths {
      if {$path_indexed($path)} continue
      set thisdir [file_relative $base $path]
      set idxbuf [::practcl::_pkgindex_directory $path]
      if {[string length $idxbuf]} {
        incr path_indexed($path)
        append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n
        append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n
      }
    }
  }
  append buffer {
set dir [lindex $::PATHSTACK end]
set ::PATHSTACK [lrange $::PATHSTACK 0 end-1]
}
  return $buffer
}

###
# topic: 64319f4600fb63c82b2258d908f9d066
# description: Script to build the VFS file system
###
proc ::practcl::installDir {d1 d2} {

  puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]]
  file delete -force -- $d2
  file mkdir $d2

  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
    set f [file join $d1 $ftail]
    if {[file isdirectory $f] && [string compare CVS $ftail]} {
      installDir $f [file join $d2 $ftail]
    } elseif {[file isfile $f]} {
	    file copy -force $f [file join $d2 $ftail]
	    if {$::tcl_platform(platform) eq {unix}} {
        file attributes [file join $d2 $ftail] -permissions 0644
	    } else {
        file attributes [file join $d2 $ftail] -readonly 1
	    }
    }
  }

  if {$::tcl_platform(platform) eq {unix}} {
    file attributes $d2 -permissions 0755
  } else {
    file attributes $d2 -readonly 1
  }
}

proc ::practcl::copyDir {d1 d2 {toplevel 1}} {
  #if {$toplevel} {
  #  puts [list ::practcl::copyDir $d1 -> $d2]
  #}
  #file delete -force -- $d2
  file mkdir $d2

  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
    set f [file join $d1 $ftail]
    if {[file isdirectory $f] && [string compare CVS $ftail]} {
      copyDir $f [file join $d2 $ftail] 0
    } elseif {[file isfile $f]} {
      file copy -force $f [file join $d2 $ftail]
    }
  }
}

switch [lindex $argv 1] {
  mkzip {
    zipfs mkzip {*}[lrange $argv 2 end]
  }
  mkzip {
    zipfs mkimg {*}[lrange $argv 2 end]
  }
  default {
    ::practcl::[lindex $argv 1] {*}[lrange $argv 2 end]
  }
}
exit 0
Changes to library/reg/pkgIndex.tcl.
1
2
3
4
5
6
7
8
9
if {([info commands ::tcl::pkgconfig] eq "")
	|| ([info sharedlibextension] ne ".dll")} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded registry 1.3.2 \
            [list load [file join $dir tclreg13g.dll] registry]
} else {
    package ifneeded registry 1.3.2 \
            [list load [file join $dir tclreg13.dll] registry]
}



|


|


1
2
3
4
5
6
7
8
9
if {([info commands ::tcl::pkgconfig] eq "")
	|| ([info sharedlibextension] ne ".dll")} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded registry 1.3.3 \
            [list load [file join $dir tclreg13g.dll] registry]
} else {
    package ifneeded registry 1.3.3 \
            [list load [file join $dir tclreg13.dll] registry]
}
Changes to library/safe.tcl.
451
452
453
454
455
456
457
458
459
460
461
462
463







464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
    # Handling Tcl Modules, we need a restricted form of Glob.
    # This alias interposes on the 'exit' command and cleanly terminates
    # the slave.

    foreach {command alias} {
	source   AliasSource
	load     AliasLoad
	encoding AliasEncoding
	exit     interpDelete
	glob     AliasGlob
    } {
	::interp alias $slave $command {} [namespace current]::$alias $slave
    }








    # This alias lets the slave have access to a subset of the 'file'
    # command functionality.

    ::interp expose $slave file
    foreach subcommand {dirname extension rootname tail} {
	::interp alias $slave ::tcl::file::$subcommand {} \
	    ::safe::AliasFileSubcommand $slave $subcommand
    }
    foreach subcommand {
	atime attributes copy delete executable exists isdirectory isfile
	link lstat mtime mkdir nativename normalize owned readable readlink
	rename size stat tempfile type volumes writable
    } {
	::interp alias $slave ::tcl::file::$subcommand {} \
	    ::safe::BadSubcommand $slave file $subcommand
    }

    # Subcommands of info
    foreach {subcommand alias} {
	nameofexecutable   AliasExeName
    } {
	::interp alias $slave ::tcl::info::$subcommand \
	    {} [namespace current]::$alias $slave
    }

    # The allowed slave variables already have been set by Tcl_MakeSafe(3)

    # Source init.tcl and tm.tcl into the slave, to get auto_load and
    # other procedures defined:

    if {[catch {::interp eval $slave {







<





>
>
>
>
>
>
>




<




|
|
|
<
<
|
|
|
<

<
<
<
|
|
<







451
452
453
454
455
456
457

458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473

474
475
476
477
478
479
480


481
482
483

484



485
486

487
488
489
490
491
492
493
    # Handling Tcl Modules, we need a restricted form of Glob.
    # This alias interposes on the 'exit' command and cleanly terminates
    # the slave.

    foreach {command alias} {
	source   AliasSource
	load     AliasLoad

	exit     interpDelete
	glob     AliasGlob
    } {
	::interp alias $slave $command {} [namespace current]::$alias $slave
    }

    # UGLY POINT! These commands are safe (they're ensembles with unsafe
    # subcommands), but is assumed to not be by existing policies so it is
    # hidden by default. Hack it...
    foreach command {encoding file} {
	::interp alias $slave $command {} interp invokehidden $slave $command
    }

    # This alias lets the slave have access to a subset of the 'file'
    # command functionality.


    foreach subcommand {dirname extension rootname tail} {
	::interp alias $slave ::tcl::file::$subcommand {} \
	    ::safe::AliasFileSubcommand $slave $subcommand
    }

    # Subcommand of 'encoding' that has special handling; [encoding system] is
    # OK provided it has no other arguments passed to it.


    ::interp alias $slave ::tcl::encoding::system {} \
	::safe::AliasEncodingSystem $slave


    # Subcommands of info



    ::interp alias $slave ::tcl::info::nameofexecutable {} \
	::safe::AliasExeName $slave


    # The allowed slave variables already have been set by Tcl_MakeSafe(3)

    # Source init.tcl and tm.tcl into the slave, to get auto_load and
    # other procedures defined:

    if {[catch {::interp eval $slave {
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037

1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054

proc ::safe::BadSubcommand {slave command subcommand args} {
    set msg "not allowed to invoke subcommand $subcommand of $command"
    Log $slave $msg
    return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
}

# AliasEncoding is the target of the "encoding" alias in safe interpreters.

proc ::safe::AliasEncoding {slave option args} {
    # Note that [encoding dirs] is not supported in safe slaves at all
    set subcommands {convertfrom convertto names system}
    try {
	set option [tcl::prefix match -error [list -level 1 -errorcode \
		[list TCL LOOKUP INDEX option $option]] $subcommands $option]

	# Special case: [encoding system] ok, but [encoding system foo] not
	if {$option eq "system" && [llength $args]} {
	    return -code error -errorcode {TCL WRONGARGS} \
		"wrong # args: should be \"encoding system\""
	}
    } on error {msg options} {
	Log $slave $msg
	return -options $options $msg
    }
    tailcall ::interp invokehidden $slave encoding $option {*}$args
}

# Various minor hiding of platform features. [Bug 2913625]

proc ::safe::AliasExeName {slave} {
    return ""
}







|
|
|
<
<

<
<
>
|
|







|







1021
1022
1023
1024
1025
1026
1027
1028
1029
1030


1031


1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049

proc ::safe::BadSubcommand {slave command subcommand args} {
    set msg "not allowed to invoke subcommand $subcommand of $command"
    Log $slave $msg
    return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
}

# AliasEncodingSystem is the target of the "encoding system" alias in safe
# interpreters.
proc ::safe::AliasEncodingSystem {slave args} {


    try {


	# Must not pass extra arguments; safe slaves may not set the system
	# encoding but they may read it.
	if {[llength $args]} {
	    return -code error -errorcode {TCL WRONGARGS} \
		"wrong # args: should be \"encoding system\""
	}
    } on error {msg options} {
	Log $slave $msg
	return -options $options $msg
    }
    tailcall ::interp invokehidden $slave tcl:encoding:system
}

# Various minor hiding of platform features. [Bug 2913625]

proc ::safe::AliasExeName {slave} {
    return ""
}
Changes to library/tzdata/Africa/Ceuta.
11
12
13
14
15
16
17

18
19
20
21
22
23
24
    {-1379293200 3600 1 WEST}
    {-1364774400 0 0 WET}
    {-1348448400 3600 1 WEST}
    {-1333324800 0 0 WET}
    {-1316390400 3600 1 WEST}
    {-1301270400 0 0 WET}
    {-1293840000 0 0 WET}

    {-81432000 3600 1 WEST}
    {-71110800 0 0 WET}
    {141264000 3600 1 WEST}
    {147222000 0 0 WET}
    {199756800 3600 1 WEST}
    {207702000 0 0 WET}
    {231292800 3600 1 WEST}







>







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
    {-1379293200 3600 1 WEST}
    {-1364774400 0 0 WET}
    {-1348448400 3600 1 WEST}
    {-1333324800 0 0 WET}
    {-1316390400 3600 1 WEST}
    {-1301270400 0 0 WET}
    {-1293840000 0 0 WET}
    {-94694400 0 0 WET}
    {-81432000 3600 1 WEST}
    {-71110800 0 0 WET}
    {141264000 3600 1 WEST}
    {147222000 0 0 WET}
    {199756800 3600 1 WEST}
    {207702000 0 0 WET}
    {231292800 3600 1 WEST}
Changes to library/tzdata/America/Santiago.
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151


152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
    {1410062400 -10800 1 -04}
    {1463281200 -14400 0 -04}
    {1471147200 -10800 1 -04}
    {1494730800 -14400 0 -04}
    {1502596800 -10800 1 -04}
    {1526180400 -14400 0 -04}
    {1534046400 -10800 1 -04}
    {1557630000 -14400 0 -04}
    {1565496000 -10800 1 -04}
    {1589079600 -14400 0 -04}
    {1596945600 -10800 1 -04}
    {1620529200 -14400 0 -04}
    {1629000000 -10800 1 -04}
    {1652583600 -14400 0 -04}
    {1660449600 -10800 1 -04}
    {1684033200 -14400 0 -04}
    {1691899200 -10800 1 -04}
    {1715482800 -14400 0 -04}
    {1723348800 -10800 1 -04}
    {1746932400 -14400 0 -04}
    {1754798400 -10800 1 -04}
    {1778382000 -14400 0 -04}
    {1786248000 -10800 1 -04}
    {1809831600 -14400 0 -04}
    {1818302400 -10800 1 -04}
    {1841886000 -14400 0 -04}
    {1849752000 -10800 1 -04}
    {1873335600 -14400 0 -04}
    {1881201600 -10800 1 -04}
    {1904785200 -14400 0 -04}
    {1912651200 -10800 1 -04}
    {1936234800 -14400 0 -04}


    {1944100800 -10800 1 -04}
    {1967684400 -14400 0 -04}
    {1976155200 -10800 1 -04}
    {1999738800 -14400 0 -04}
    {2007604800 -10800 1 -04}
    {2031188400 -14400 0 -04}
    {2039054400 -10800 1 -04}
    {2062638000 -14400 0 -04}
    {2070504000 -10800 1 -04}
    {2094087600 -14400 0 -04}
    {2101953600 -10800 1 -04}
    {2125537200 -14400 0 -04}
    {2133403200 -10800 1 -04}
    {2156986800 -14400 0 -04}
    {2165457600 -10800 1 -04}
    {2189041200 -14400 0 -04}
    {2196907200 -10800 1 -04}
    {2220490800 -14400 0 -04}
    {2228356800 -10800 1 -04}
    {2251940400 -14400 0 -04}
    {2259806400 -10800 1 -04}
    {2283390000 -14400 0 -04}
    {2291256000 -10800 1 -04}
    {2314839600 -14400 0 -04}
    {2322705600 -10800 1 -04}
    {2346894000 -14400 0 -04}
    {2354760000 -10800 1 -04}
    {2378343600 -14400 0 -04}
    {2386209600 -10800 1 -04}
    {2409793200 -14400 0 -04}
    {2417659200 -10800 1 -04}
    {2441242800 -14400 0 -04}
    {2449108800 -10800 1 -04}
    {2472692400 -14400 0 -04}
    {2480558400 -10800 1 -04}
    {2504142000 -14400 0 -04}
    {2512612800 -10800 1 -04}
    {2536196400 -14400 0 -04}
    {2544062400 -10800 1 -04}
    {2567646000 -14400 0 -04}
    {2575512000 -10800 1 -04}
    {2599095600 -14400 0 -04}
    {2606961600 -10800 1 -04}
    {2630545200 -14400 0 -04}
    {2638411200 -10800 1 -04}
    {2661994800 -14400 0 -04}
    {2669860800 -10800 1 -04}
    {2693444400 -14400 0 -04}
    {2701915200 -10800 1 -04}
    {2725498800 -14400 0 -04}
    {2733364800 -10800 1 -04}
    {2756948400 -14400 0 -04}
    {2764814400 -10800 1 -04}
    {2788398000 -14400 0 -04}
    {2796264000 -10800 1 -04}
    {2819847600 -14400 0 -04}
    {2827713600 -10800 1 -04}
    {2851297200 -14400 0 -04}
    {2859768000 -10800 1 -04}
    {2883351600 -14400 0 -04}
    {2891217600 -10800 1 -04}
    {2914801200 -14400 0 -04}
    {2922667200 -10800 1 -04}
    {2946250800 -14400 0 -04}
    {2954116800 -10800 1 -04}
    {2977700400 -14400 0 -04}
    {2985566400 -10800 1 -04}
    {3009150000 -14400 0 -04}
    {3017016000 -10800 1 -04}
    {3040599600 -14400 0 -04}
    {3049070400 -10800 1 -04}
    {3072654000 -14400 0 -04}
    {3080520000 -10800 1 -04}
    {3104103600 -14400 0 -04}
    {3111969600 -10800 1 -04}
    {3135553200 -14400 0 -04}
    {3143419200 -10800 1 -04}
    {3167002800 -14400 0 -04}
    {3174868800 -10800 1 -04}
    {3198452400 -14400 0 -04}
    {3206318400 -10800 1 -04}
    {3230506800 -14400 0 -04}
    {3238372800 -10800 1 -04}
    {3261956400 -14400 0 -04}
    {3269822400 -10800 1 -04}
    {3293406000 -14400 0 -04}
    {3301272000 -10800 1 -04}
    {3324855600 -14400 0 -04}
    {3332721600 -10800 1 -04}
    {3356305200 -14400 0 -04}
    {3364171200 -10800 1 -04}
    {3387754800 -14400 0 -04}
    {3396225600 -10800 1 -04}
    {3419809200 -14400 0 -04}
    {3427675200 -10800 1 -04}
    {3451258800 -14400 0 -04}
    {3459124800 -10800 1 -04}
    {3482708400 -14400 0 -04}
    {3490574400 -10800 1 -04}
    {3514158000 -14400 0 -04}
    {3522024000 -10800 1 -04}
    {3545607600 -14400 0 -04}
    {3553473600 -10800 1 -04}
    {3577057200 -14400 0 -04}
    {3585528000 -10800 1 -04}
    {3609111600 -14400 0 -04}
    {3616977600 -10800 1 -04}
    {3640561200 -14400 0 -04}
    {3648427200 -10800 1 -04}
    {3672010800 -14400 0 -04}
    {3679876800 -10800 1 -04}
    {3703460400 -14400 0 -04}
    {3711326400 -10800 1 -04}
    {3734910000 -14400 0 -04}
    {3743380800 -10800 1 -04}
    {3766964400 -14400 0 -04}
    {3774830400 -10800 1 -04}
    {3798414000 -14400 0 -04}
    {3806280000 -10800 1 -04}
    {3829863600 -14400 0 -04}
    {3837729600 -10800 1 -04}
    {3861313200 -14400 0 -04}
    {3869179200 -10800 1 -04}
    {3892762800 -14400 0 -04}
    {3900628800 -10800 1 -04}
    {3924212400 -14400 0 -04}
    {3932683200 -10800 1 -04}
    {3956266800 -14400 0 -04}
    {3964132800 -10800 1 -04}
    {3987716400 -14400 0 -04}
    {3995582400 -10800 1 -04}
    {4019166000 -14400 0 -04}
    {4027032000 -10800 1 -04}
    {4050615600 -14400 0 -04}
    {4058481600 -10800 1 -04}
    {4082065200 -14400 0 -04}
    {4089931200 -10800 1 -04}
}







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168


169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
    {1410062400 -10800 1 -04}
    {1463281200 -14400 0 -04}
    {1471147200 -10800 1 -04}
    {1494730800 -14400 0 -04}
    {1502596800 -10800 1 -04}
    {1526180400 -14400 0 -04}
    {1534046400 -10800 1 -04}
    {1554606000 -14400 0 -04}
    {1567915200 -10800 1 -04}
    {1586055600 -14400 0 -04}
    {1599364800 -10800 1 -04}
    {1617505200 -14400 0 -04}
    {1630814400 -10800 1 -04}
    {1648954800 -14400 0 -04}
    {1662264000 -10800 1 -04}
    {1680404400 -14400 0 -04}
    {1693713600 -10800 1 -04}
    {1712458800 -14400 0 -04}
    {1725768000 -10800 1 -04}
    {1743908400 -14400 0 -04}
    {1757217600 -10800 1 -04}
    {1775358000 -14400 0 -04}
    {1788667200 -10800 1 -04}
    {1806807600 -14400 0 -04}
    {1820116800 -10800 1 -04}
    {1838257200 -14400 0 -04}
    {1851566400 -10800 1 -04}
    {1870311600 -14400 0 -04}
    {1883016000 -10800 1 -04}
    {1901761200 -14400 0 -04}
    {1915070400 -10800 1 -04}
    {1933210800 -14400 0 -04}
    {1946520000 -10800 1 -04}
    {1964660400 -14400 0 -04}
    {1977969600 -10800 1 -04}
    {1996110000 -14400 0 -04}
    {2009419200 -10800 1 -04}
    {2027559600 -14400 0 -04}
    {2040868800 -10800 1 -04}
    {2059614000 -14400 0 -04}
    {2072318400 -10800 1 -04}
    {2091063600 -14400 0 -04}
    {2104372800 -10800 1 -04}
    {2122513200 -14400 0 -04}
    {2135822400 -10800 1 -04}
    {2153962800 -14400 0 -04}
    {2167272000 -10800 1 -04}
    {2185412400 -14400 0 -04}
    {2198721600 -10800 1 -04}


    {2217466800 -14400 0 -04}
    {2230171200 -10800 1 -04}
    {2248916400 -14400 0 -04}
    {2262225600 -10800 1 -04}
    {2280366000 -14400 0 -04}
    {2293675200 -10800 1 -04}
    {2311815600 -14400 0 -04}
    {2325124800 -10800 1 -04}
    {2343265200 -14400 0 -04}
    {2356574400 -10800 1 -04}
    {2374714800 -14400 0 -04}
    {2388024000 -10800 1 -04}
    {2406769200 -14400 0 -04}
    {2419473600 -10800 1 -04}
    {2438218800 -14400 0 -04}
    {2451528000 -10800 1 -04}
    {2469668400 -14400 0 -04}
    {2482977600 -10800 1 -04}
    {2501118000 -14400 0 -04}
    {2514427200 -10800 1 -04}
    {2532567600 -14400 0 -04}
    {2545876800 -10800 1 -04}
    {2564017200 -14400 0 -04}
    {2577326400 -10800 1 -04}
    {2596071600 -14400 0 -04}
    {2609380800 -10800 1 -04}
    {2627521200 -14400 0 -04}
    {2640830400 -10800 1 -04}
    {2658970800 -14400 0 -04}
    {2672280000 -10800 1 -04}
    {2690420400 -14400 0 -04}
    {2703729600 -10800 1 -04}
    {2721870000 -14400 0 -04}
    {2735179200 -10800 1 -04}
    {2753924400 -14400 0 -04}
    {2766628800 -10800 1 -04}
    {2785374000 -14400 0 -04}
    {2798683200 -10800 1 -04}
    {2816823600 -14400 0 -04}
    {2830132800 -10800 1 -04}
    {2848273200 -14400 0 -04}
    {2861582400 -10800 1 -04}
    {2879722800 -14400 0 -04}
    {2893032000 -10800 1 -04}
    {2911172400 -14400 0 -04}
    {2924481600 -10800 1 -04}
    {2943226800 -14400 0 -04}
    {2955931200 -10800 1 -04}
    {2974676400 -14400 0 -04}
    {2987985600 -10800 1 -04}
    {3006126000 -14400 0 -04}
    {3019435200 -10800 1 -04}
    {3037575600 -14400 0 -04}
    {3050884800 -10800 1 -04}
    {3069025200 -14400 0 -04}
    {3082334400 -10800 1 -04}
    {3101079600 -14400 0 -04}
    {3113784000 -10800 1 -04}
    {3132529200 -14400 0 -04}
    {3145838400 -10800 1 -04}
    {3163978800 -14400 0 -04}
    {3177288000 -10800 1 -04}
    {3195428400 -14400 0 -04}
    {3208737600 -10800 1 -04}
    {3226878000 -14400 0 -04}
    {3240187200 -10800 1 -04}
    {3258327600 -14400 0 -04}
    {3271636800 -10800 1 -04}
    {3290382000 -14400 0 -04}
    {3303086400 -10800 1 -04}
    {3321831600 -14400 0 -04}
    {3335140800 -10800 1 -04}
    {3353281200 -14400 0 -04}
    {3366590400 -10800 1 -04}
    {3384730800 -14400 0 -04}
    {3398040000 -10800 1 -04}
    {3416180400 -14400 0 -04}
    {3429489600 -10800 1 -04}
    {3447630000 -14400 0 -04}
    {3460939200 -10800 1 -04}
    {3479684400 -14400 0 -04}
    {3492993600 -10800 1 -04}
    {3511134000 -14400 0 -04}
    {3524443200 -10800 1 -04}
    {3542583600 -14400 0 -04}
    {3555892800 -10800 1 -04}
    {3574033200 -14400 0 -04}
    {3587342400 -10800 1 -04}
    {3605482800 -14400 0 -04}
    {3618792000 -10800 1 -04}
    {3637537200 -14400 0 -04}
    {3650241600 -10800 1 -04}
    {3668986800 -14400 0 -04}
    {3682296000 -10800 1 -04}
    {3700436400 -14400 0 -04}
    {3713745600 -10800 1 -04}
    {3731886000 -14400 0 -04}
    {3745195200 -10800 1 -04}
    {3763335600 -14400 0 -04}
    {3776644800 -10800 1 -04}
    {3794785200 -14400 0 -04}
    {3808094400 -10800 1 -04}
    {3826839600 -14400 0 -04}
    {3839544000 -10800 1 -04}
    {3858289200 -14400 0 -04}
    {3871598400 -10800 1 -04}
    {3889738800 -14400 0 -04}
    {3903048000 -10800 1 -04}
    {3921188400 -14400 0 -04}
    {3934497600 -10800 1 -04}
    {3952638000 -14400 0 -04}
    {3965947200 -10800 1 -04}
    {3984692400 -14400 0 -04}
    {3997396800 -10800 1 -04}
    {4016142000 -14400 0 -04}
    {4029451200 -10800 1 -04}
    {4047591600 -14400 0 -04}
    {4060900800 -10800 1 -04}
    {4079041200 -14400 0 -04}
    {4092350400 -10800 1 -04}
}
Changes to library/tzdata/Asia/Macau.
1
2
3
4












5
























6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Macau) {
    {-9223372036854775808 27260 0 LMT}












    {-1830412800 28800 0 CST}
























    {-277360200 32400 1 CDT}
    {-257405400 28800 0 CST}
    {-245910600 32400 1 CDT}
    {-225955800 28800 0 CST}
    {-214473600 32400 1 CDT}
    {-194506200 28800 0 CST}
    {-182406600 32400 1 CDT}
    {-163056600 28800 0 CST}
    {-150969600 32400 1 CDT}
    {-131619600 28800 0 CST}
    {-117088200 32400 1 CDT}
    {-101367000 28800 0 CST}
    {-85638600 32400 1 CDT}
    {-69312600 28800 0 CST}
    {-53584200 32400 1 CDT}
    {-37863000 28800 0 CST}
    {-22134600 32400 1 CDT}
    {-6413400 28800 0 CST}
    {9315000 32400 1 CDT}
    {25036200 28800 0 CST}
    {40764600 32400 1 CDT}
    {56485800 28800 0 CST}
    {72201600 32400 1 CDT}
    {87922800 28800 0 CST}
    {103651200 32400 1 CDT}
    {119977200 28800 0 CST}
    {135705600 32400 1 CDT}
    {151439400 28800 0 CST}
    {167167800 32400 1 CDT}
    {182889000 28800 0 CST}
    {198617400 32400 1 CDT}
    {214338600 28800 0 CST}
    {230067000 32400 1 CDT}
    {245788200 28800 0 CST}
    {261504000 32400 1 CDT}
    {277225200 28800 0 CST}
    {292953600 32400 1 CDT}
    {309279600 28800 0 CST}
    {325008000 32400 1 CDT}
    {340729200 28800 0 CST}
}



|
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




|



|
|

|










|
|
|
|
|





|
|
<
<
<
<
<
<

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75






76
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Macau) {
    {-9223372036854775808 27250 0 LMT}
    {-2056692850 28800 0 CST}
    {-884509200 32400 0 +09}
    {-873280800 36000 1 +09}
    {-855918000 32400 0 +09}
    {-841744800 36000 1 +09}
    {-828529200 32400 0 +10}
    {-765363600 28800 0 CT}
    {-747046800 32400 1 CDT}
    {-733827600 28800 0 CST}
    {-716461200 32400 1 CDT}
    {-697021200 28800 0 CST}
    {-683715600 32400 1 CDT}
    {-667990800 28800 0 CST}
    {-654771600 32400 1 CDT}
    {-636627600 28800 0 CST}
    {-623322000 32400 1 CDT}
    {-605178000 28800 0 CST}
    {-591872400 32400 1 CDT}
    {-573642000 28800 0 CST}
    {-559818000 32400 1 CDT}
    {-541674000 28800 0 CST}
    {-528368400 32400 1 CDT}
    {-510224400 28800 0 CST}
    {-498128400 32400 1 CDT}
    {-478774800 28800 0 CST}
    {-466678800 32400 1 CDT}
    {-446720400 28800 0 CST}
    {-435229200 32400 1 CDT}
    {-415258200 28800 0 CST}
    {-403158600 32400 1 CDT}
    {-383808600 28800 0 CST}
    {-371709000 32400 1 CDT}
    {-352359000 28800 0 CST}
    {-340259400 32400 1 CDT}
    {-320909400 28800 0 CST}
    {-308809800 32400 1 CDT}
    {-288855000 28800 0 CST}
    {-277360200 32400 1 CDT}
    {-257405400 28800 0 CST}
    {-245910600 32400 1 CDT}
    {-225955800 28800 0 CST}
    {-213856200 32400 1 CDT}
    {-194506200 28800 0 CST}
    {-182406600 32400 1 CDT}
    {-163056600 28800 0 CST}
    {-148537800 32400 1 CDT}
    {-132820200 28800 0 CST}
    {-117088200 32400 1 CDT}
    {-101370600 28800 0 CST}
    {-85638600 32400 1 CDT}
    {-69312600 28800 0 CST}
    {-53584200 32400 1 CDT}
    {-37863000 28800 0 CST}
    {-22134600 32400 1 CDT}
    {-6413400 28800 0 CST}
    {9315000 32400 1 CDT}
    {25036200 28800 0 CST}
    {40764600 32400 1 CDT}
    {56485800 28800 0 CST}
    {72214200 32400 1 CDT}
    {88540200 28800 0 CST}
    {104268600 32400 1 CDT}
    {119989800 28800 0 CST}
    {126041400 32400 1 CDT}
    {151439400 28800 0 CST}
    {167167800 32400 1 CDT}
    {182889000 28800 0 CST}
    {198617400 32400 1 CDT}
    {214338600 28800 0 CST}
    {295385400 32400 1 CDT}
    {309292200 28800 0 CST}






}
Changes to library/tzdata/Asia/Manila.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Manila) {
    {-9223372036854775808 -57360 0 LMT}
    {-3944621040 29040 0 LMT}
    {-2229321840 28800 0 +08}
    {-1046678400 32400 1 +08}
    {-1038733200 28800 0 +08}
    {-873273600 32400 0 +09}
    {-794221200 28800 0 +08}
    {-496224000 32400 1 +08}
    {-489315600 28800 0 +08}
    {259344000 32400 1 +08}
    {275151600 28800 0 +08}
}





|
|
|
|
|
|
|
|
|

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Manila) {
    {-9223372036854775808 -57360 0 LMT}
    {-3944621040 29040 0 LMT}
    {-2229321840 28800 0 PST}
    {-1046678400 32400 1 PDT}
    {-1038733200 28800 0 PST}
    {-873273600 32400 0 JST}
    {-794221200 28800 0 PST}
    {-496224000 32400 1 PDT}
    {-489315600 28800 0 PST}
    {259344000 32400 1 PDT}
    {275151600 28800 0 PST}
}
Changes to library/tzdata/Asia/Pyongyang.
1
2
3
4
5
6
7
8
9
10
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Pyongyang) {
    {-9223372036854775808 30180 0 LMT}
    {-1948782180 30600 0 KST}
    {-1830414600 32400 0 JST}
    {-768646800 32400 0 KST}
    {1439564400 30600 0 KST}
    {1525447800 32400 0 KST}
}








|

1
2
3
4
5
6
7
8
9
10
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Pyongyang) {
    {-9223372036854775808 30180 0 LMT}
    {-1948782180 30600 0 KST}
    {-1830414600 32400 0 JST}
    {-768646800 32400 0 KST}
    {1439564400 30600 0 KST}
    {1525446000 32400 0 KST}
}
Changes to library/tzdata/Asia/Shanghai.
1
2
3
4
5
6
7
8
9

10
11
12
13
14
15




16
17
18
19
20
21
22




23
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Shanghai) {
    {-9223372036854775808 29143 0 LMT}
    {-2177481943 28800 0 CST}
    {-933494400 32400 1 CDT}
    {-923130000 28800 0 CST}
    {-908784000 32400 1 CDT}
    {-891594000 28800 0 CST}

    {-662716800 28800 0 CST}
    {515520000 32400 1 CDT}
    {527007600 28800 0 CST}
    {545155200 32400 1 CDT}
    {558457200 28800 0 CST}
    {576604800 32400 1 CDT}




    {589906800 28800 0 CST}
    {608659200 32400 1 CDT}
    {621961200 28800 0 CST}
    {640108800 32400 1 CDT}
    {653410800 28800 0 CST}
    {671558400 32400 1 CDT}
    {684860400 28800 0 CST}




}





|
|
|
|
>
|
|
|
|
|
|
>
>
>
>
|
|
|
|
|
|
|
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Shanghai) {
    {-9223372036854775808 29143 0 LMT}
    {-2177481943 28800 0 CST}
    {-933667200 32400 1 CDT}
    {-922093200 28800 0 CST}
    {-908870400 32400 1 CDT}
    {-888829200 28800 0 CST}
    {-881049600 32400 1 CDT}
    {-767869200 28800 0 CST}
    {-745833600 32400 1 CDT}
    {-733827600 28800 0 CST}
    {-716889600 32400 1 CDT}
    {-699613200 28800 0 CST}
    {-683884800 32400 1 CDT}
    {-670669200 28800 0 CST}
    {-652348800 32400 1 CDT}
    {-650016000 28800 0 CST}
    {515527200 32400 1 CDT}
    {527014800 28800 0 CST}
    {545162400 32400 1 CDT}
    {558464400 28800 0 CST}
    {577216800 32400 1 CDT}
    {589914000 28800 0 CST}
    {608666400 32400 1 CDT}
    {621968400 28800 0 CST}
    {640116000 32400 1 CDT}
    {653418000 28800 0 CST}
    {671565600 32400 1 CDT}
    {684867600 28800 0 CST}
}
Changes to library/tzdata/Asia/Tokyo.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Tokyo) {
    {-9223372036854775808 33539 0 LMT}
    {-2587712400 32400 0 JST}
    {-683802000 36000 1 JDT}
    {-672314400 32400 0 JST}
    {-654771600 36000 1 JDT}
    {-640864800 32400 0 JST}
    {-620298000 36000 1 JDT}
    {-609415200 32400 0 JST}
    {-588848400 36000 1 JDT}
    {-577965600 32400 0 JST}
}






|

|

|

|

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Tokyo) {
    {-9223372036854775808 33539 0 LMT}
    {-2587712400 32400 0 JST}
    {-683802000 36000 1 JDT}
    {-672310800 32400 0 JST}
    {-654771600 36000 1 JDT}
    {-640861200 32400 0 JST}
    {-620298000 36000 1 JDT}
    {-609411600 32400 0 JST}
    {-588848400 36000 1 JDT}
    {-577962000 32400 0 JST}
}
Changes to library/tzdata/Europe/Volgograd.
64
65
66
67
68
69
70

71
    {1224975600 10800 0 +03}
    {1238281200 14400 1 +04}
    {1256425200 10800 0 +03}
    {1269730800 14400 1 +04}
    {1288479600 10800 0 +03}
    {1301180400 14400 0 +04}
    {1414274400 10800 0 +03}

}







>

64
65
66
67
68
69
70
71
72
    {1224975600 10800 0 +03}
    {1238281200 14400 1 +04}
    {1256425200 10800 0 +03}
    {1269730800 14400 1 +04}
    {1288479600 10800 0 +03}
    {1301180400 14400 0 +04}
    {1414274400 10800 0 +03}
    {1540681200 14400 0 +04}
}
Changes to library/tzdata/Pacific/Easter.
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130


131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
    {1410062400 -18000 1 -06}
    {1463281200 -21600 0 -06}
    {1471147200 -18000 1 -06}
    {1494730800 -21600 0 -06}
    {1502596800 -18000 1 -06}
    {1526180400 -21600 0 -06}
    {1534046400 -18000 1 -06}
    {1557630000 -21600 0 -06}
    {1565496000 -18000 1 -06}
    {1589079600 -21600 0 -06}
    {1596945600 -18000 1 -06}
    {1620529200 -21600 0 -06}
    {1629000000 -18000 1 -06}
    {1652583600 -21600 0 -06}
    {1660449600 -18000 1 -06}
    {1684033200 -21600 0 -06}
    {1691899200 -18000 1 -06}
    {1715482800 -21600 0 -06}
    {1723348800 -18000 1 -06}
    {1746932400 -21600 0 -06}
    {1754798400 -18000 1 -06}
    {1778382000 -21600 0 -06}
    {1786248000 -18000 1 -06}
    {1809831600 -21600 0 -06}
    {1818302400 -18000 1 -06}
    {1841886000 -21600 0 -06}
    {1849752000 -18000 1 -06}
    {1873335600 -21600 0 -06}
    {1881201600 -18000 1 -06}
    {1904785200 -21600 0 -06}
    {1912651200 -18000 1 -06}
    {1936234800 -21600 0 -06}


    {1944100800 -18000 1 -06}
    {1967684400 -21600 0 -06}
    {1976155200 -18000 1 -06}
    {1999738800 -21600 0 -06}
    {2007604800 -18000 1 -06}
    {2031188400 -21600 0 -06}
    {2039054400 -18000 1 -06}
    {2062638000 -21600 0 -06}
    {2070504000 -18000 1 -06}
    {2094087600 -21600 0 -06}
    {2101953600 -18000 1 -06}
    {2125537200 -21600 0 -06}
    {2133403200 -18000 1 -06}
    {2156986800 -21600 0 -06}
    {2165457600 -18000 1 -06}
    {2189041200 -21600 0 -06}
    {2196907200 -18000 1 -06}
    {2220490800 -21600 0 -06}
    {2228356800 -18000 1 -06}
    {2251940400 -21600 0 -06}
    {2259806400 -18000 1 -06}
    {2283390000 -21600 0 -06}
    {2291256000 -18000 1 -06}
    {2314839600 -21600 0 -06}
    {2322705600 -18000 1 -06}
    {2346894000 -21600 0 -06}
    {2354760000 -18000 1 -06}
    {2378343600 -21600 0 -06}
    {2386209600 -18000 1 -06}
    {2409793200 -21600 0 -06}
    {2417659200 -18000 1 -06}
    {2441242800 -21600 0 -06}
    {2449108800 -18000 1 -06}
    {2472692400 -21600 0 -06}
    {2480558400 -18000 1 -06}
    {2504142000 -21600 0 -06}
    {2512612800 -18000 1 -06}
    {2536196400 -21600 0 -06}
    {2544062400 -18000 1 -06}
    {2567646000 -21600 0 -06}
    {2575512000 -18000 1 -06}
    {2599095600 -21600 0 -06}
    {2606961600 -18000 1 -06}
    {2630545200 -21600 0 -06}
    {2638411200 -18000 1 -06}
    {2661994800 -21600 0 -06}
    {2669860800 -18000 1 -06}
    {2693444400 -21600 0 -06}
    {2701915200 -18000 1 -06}
    {2725498800 -21600 0 -06}
    {2733364800 -18000 1 -06}
    {2756948400 -21600 0 -06}
    {2764814400 -18000 1 -06}
    {2788398000 -21600 0 -06}
    {2796264000 -18000 1 -06}
    {2819847600 -21600 0 -06}
    {2827713600 -18000 1 -06}
    {2851297200 -21600 0 -06}
    {2859768000 -18000 1 -06}
    {2883351600 -21600 0 -06}
    {2891217600 -18000 1 -06}
    {2914801200 -21600 0 -06}
    {2922667200 -18000 1 -06}
    {2946250800 -21600 0 -06}
    {2954116800 -18000 1 -06}
    {2977700400 -21600 0 -06}
    {2985566400 -18000 1 -06}
    {3009150000 -21600 0 -06}
    {3017016000 -18000 1 -06}
    {3040599600 -21600 0 -06}
    {3049070400 -18000 1 -06}
    {3072654000 -21600 0 -06}
    {3080520000 -18000 1 -06}
    {3104103600 -21600 0 -06}
    {3111969600 -18000 1 -06}
    {3135553200 -21600 0 -06}
    {3143419200 -18000 1 -06}
    {3167002800 -21600 0 -06}
    {3174868800 -18000 1 -06}
    {3198452400 -21600 0 -06}
    {3206318400 -18000 1 -06}
    {3230506800 -21600 0 -06}
    {3238372800 -18000 1 -06}
    {3261956400 -21600 0 -06}
    {3269822400 -18000 1 -06}
    {3293406000 -21600 0 -06}
    {3301272000 -18000 1 -06}
    {3324855600 -21600 0 -06}
    {3332721600 -18000 1 -06}
    {3356305200 -21600 0 -06}
    {3364171200 -18000 1 -06}
    {3387754800 -21600 0 -06}
    {3396225600 -18000 1 -06}
    {3419809200 -21600 0 -06}
    {3427675200 -18000 1 -06}
    {3451258800 -21600 0 -06}
    {3459124800 -18000 1 -06}
    {3482708400 -21600 0 -06}
    {3490574400 -18000 1 -06}
    {3514158000 -21600 0 -06}
    {3522024000 -18000 1 -06}
    {3545607600 -21600 0 -06}
    {3553473600 -18000 1 -06}
    {3577057200 -21600 0 -06}
    {3585528000 -18000 1 -06}
    {3609111600 -21600 0 -06}
    {3616977600 -18000 1 -06}
    {3640561200 -21600 0 -06}
    {3648427200 -18000 1 -06}
    {3672010800 -21600 0 -06}
    {3679876800 -18000 1 -06}
    {3703460400 -21600 0 -06}
    {3711326400 -18000 1 -06}
    {3734910000 -21600 0 -06}
    {3743380800 -18000 1 -06}
    {3766964400 -21600 0 -06}
    {3774830400 -18000 1 -06}
    {3798414000 -21600 0 -06}
    {3806280000 -18000 1 -06}
    {3829863600 -21600 0 -06}
    {3837729600 -18000 1 -06}
    {3861313200 -21600 0 -06}
    {3869179200 -18000 1 -06}
    {3892762800 -21600 0 -06}
    {3900628800 -18000 1 -06}
    {3924212400 -21600 0 -06}
    {3932683200 -18000 1 -06}
    {3956266800 -21600 0 -06}
    {3964132800 -18000 1 -06}
    {3987716400 -21600 0 -06}
    {3995582400 -18000 1 -06}
    {4019166000 -21600 0 -06}
    {4027032000 -18000 1 -06}
    {4050615600 -21600 0 -06}
    {4058481600 -18000 1 -06}
    {4082065200 -21600 0 -06}
    {4089931200 -18000 1 -06}
}







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147


148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
    {1410062400 -18000 1 -06}
    {1463281200 -21600 0 -06}
    {1471147200 -18000 1 -06}
    {1494730800 -21600 0 -06}
    {1502596800 -18000 1 -06}
    {1526180400 -21600 0 -06}
    {1534046400 -18000 1 -06}
    {1554606000 -21600 0 -06}
    {1567915200 -18000 1 -06}
    {1586055600 -21600 0 -06}
    {1599364800 -18000 1 -06}
    {1617505200 -21600 0 -06}
    {1630814400 -18000 1 -06}
    {1648954800 -21600 0 -06}
    {1662264000 -18000 1 -06}
    {1680404400 -21600 0 -06}
    {1693713600 -18000 1 -06}
    {1712458800 -21600 0 -06}
    {1725768000 -18000 1 -06}
    {1743908400 -21600 0 -06}
    {1757217600 -18000 1 -06}
    {1775358000 -21600 0 -06}
    {1788667200 -18000 1 -06}
    {1806807600 -21600 0 -06}
    {1820116800 -18000 1 -06}
    {1838257200 -21600 0 -06}
    {1851566400 -18000 1 -06}
    {1870311600 -21600 0 -06}
    {1883016000 -18000 1 -06}
    {1901761200 -21600 0 -06}
    {1915070400 -18000 1 -06}
    {1933210800 -21600 0 -06}
    {1946520000 -18000 1 -06}
    {1964660400 -21600 0 -06}
    {1977969600 -18000 1 -06}
    {1996110000 -21600 0 -06}
    {2009419200 -18000 1 -06}
    {2027559600 -21600 0 -06}
    {2040868800 -18000 1 -06}
    {2059614000 -21600 0 -06}
    {2072318400 -18000 1 -06}
    {2091063600 -21600 0 -06}
    {2104372800 -18000 1 -06}
    {2122513200 -21600 0 -06}
    {2135822400 -18000 1 -06}
    {2153962800 -21600 0 -06}
    {2167272000 -18000 1 -06}
    {2185412400 -21600 0 -06}
    {2198721600 -18000 1 -06}


    {2217466800 -21600 0 -06}
    {2230171200 -18000 1 -06}
    {2248916400 -21600 0 -06}
    {2262225600 -18000 1 -06}
    {2280366000 -21600 0 -06}
    {2293675200 -18000 1 -06}
    {2311815600 -21600 0 -06}
    {2325124800 -18000 1 -06}
    {2343265200 -21600 0 -06}
    {2356574400 -18000 1 -06}
    {2374714800 -21600 0 -06}
    {2388024000 -18000 1 -06}
    {2406769200 -21600 0 -06}
    {2419473600 -18000 1 -06}
    {2438218800 -21600 0 -06}
    {2451528000 -18000 1 -06}
    {2469668400 -21600 0 -06}
    {2482977600 -18000 1 -06}
    {2501118000 -21600 0 -06}
    {2514427200 -18000 1 -06}
    {2532567600 -21600 0 -06}
    {2545876800 -18000 1 -06}
    {2564017200 -21600 0 -06}
    {2577326400 -18000 1 -06}
    {2596071600 -21600 0 -06}
    {2609380800 -18000 1 -06}
    {2627521200 -21600 0 -06}
    {2640830400 -18000 1 -06}
    {2658970800 -21600 0 -06}
    {2672280000 -18000 1 -06}
    {2690420400 -21600 0 -06}
    {2703729600 -18000 1 -06}
    {2721870000 -21600 0 -06}
    {2735179200 -18000 1 -06}
    {2753924400 -21600 0 -06}
    {2766628800 -18000 1 -06}
    {2785374000 -21600 0 -06}
    {2798683200 -18000 1 -06}
    {2816823600 -21600 0 -06}
    {2830132800 -18000 1 -06}
    {2848273200 -21600 0 -06}
    {2861582400 -18000 1 -06}
    {2879722800 -21600 0 -06}
    {2893032000 -18000 1 -06}
    {2911172400 -21600 0 -06}
    {2924481600 -18000 1 -06}
    {2943226800 -21600 0 -06}
    {2955931200 -18000 1 -06}
    {2974676400 -21600 0 -06}
    {2987985600 -18000 1 -06}
    {3006126000 -21600 0 -06}
    {3019435200 -18000 1 -06}
    {3037575600 -21600 0 -06}
    {3050884800 -18000 1 -06}
    {3069025200 -21600 0 -06}
    {3082334400 -18000 1 -06}
    {3101079600 -21600 0 -06}
    {3113784000 -18000 1 -06}
    {3132529200 -21600 0 -06}
    {3145838400 -18000 1 -06}
    {3163978800 -21600 0 -06}
    {3177288000 -18000 1 -06}
    {3195428400 -21600 0 -06}
    {3208737600 -18000 1 -06}
    {3226878000 -21600 0 -06}
    {3240187200 -18000 1 -06}
    {3258327600 -21600 0 -06}
    {3271636800 -18000 1 -06}
    {3290382000 -21600 0 -06}
    {3303086400 -18000 1 -06}
    {3321831600 -21600 0 -06}
    {3335140800 -18000 1 -06}
    {3353281200 -21600 0 -06}
    {3366590400 -18000 1 -06}
    {3384730800 -21600 0 -06}
    {3398040000 -18000 1 -06}
    {3416180400 -21600 0 -06}
    {3429489600 -18000 1 -06}
    {3447630000 -21600 0 -06}
    {3460939200 -18000 1 -06}
    {3479684400 -21600 0 -06}
    {3492993600 -18000 1 -06}
    {3511134000 -21600 0 -06}
    {3524443200 -18000 1 -06}
    {3542583600 -21600 0 -06}
    {3555892800 -18000 1 -06}
    {3574033200 -21600 0 -06}
    {3587342400 -18000 1 -06}
    {3605482800 -21600 0 -06}
    {3618792000 -18000 1 -06}
    {3637537200 -21600 0 -06}
    {3650241600 -18000 1 -06}
    {3668986800 -21600 0 -06}
    {3682296000 -18000 1 -06}
    {3700436400 -21600 0 -06}
    {3713745600 -18000 1 -06}
    {3731886000 -21600 0 -06}
    {3745195200 -18000 1 -06}
    {3763335600 -21600 0 -06}
    {3776644800 -18000 1 -06}
    {3794785200 -21600 0 -06}
    {3808094400 -18000 1 -06}
    {3826839600 -21600 0 -06}
    {3839544000 -18000 1 -06}
    {3858289200 -21600 0 -06}
    {3871598400 -18000 1 -06}
    {3889738800 -21600 0 -06}
    {3903048000 -18000 1 -06}
    {3921188400 -21600 0 -06}
    {3934497600 -18000 1 -06}
    {3952638000 -21600 0 -06}
    {3965947200 -18000 1 -06}
    {3984692400 -21600 0 -06}
    {3997396800 -18000 1 -06}
    {4016142000 -21600 0 -06}
    {4029451200 -18000 1 -06}
    {4047591600 -21600 0 -06}
    {4060900800 -18000 1 -06}
    {4079041200 -21600 0 -06}
    {4092350400 -18000 1 -06}
}
Changes to library/tzdata/Pacific/Fiji.
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
    {1446300000 46800 1 +12}
    {1452952800 43200 0 +12}
    {1478354400 46800 1 +12}
    {1484402400 43200 0 +12}
    {1509804000 46800 1 +12}
    {1515852000 43200 0 +12}
    {1541253600 46800 1 +12}
    {1547906400 43200 0 +12}
    {1572703200 46800 1 +12}
    {1579356000 43200 0 +12}
    {1604152800 46800 1 +12}
    {1610805600 43200 0 +12}
    {1636207200 46800 1 +12}
    {1642255200 43200 0 +12}
    {1667656800 46800 1 +12}







|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
    {1446300000 46800 1 +12}
    {1452952800 43200 0 +12}
    {1478354400 46800 1 +12}
    {1484402400 43200 0 +12}
    {1509804000 46800 1 +12}
    {1515852000 43200 0 +12}
    {1541253600 46800 1 +12}
    {1547301600 43200 0 +12}
    {1572703200 46800 1 +12}
    {1579356000 43200 0 +12}
    {1604152800 46800 1 +12}
    {1610805600 43200 0 +12}
    {1636207200 46800 1 +12}
    {1642255200 43200 0 +12}
    {1667656800 46800 1 +12}
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
    {1793455200 46800 1 +12}
    {1800108000 43200 0 +12}
    {1825509600 46800 1 +12}
    {1831557600 43200 0 +12}
    {1856959200 46800 1 +12}
    {1863007200 43200 0 +12}
    {1888408800 46800 1 +12}
    {1895061600 43200 0 +12}
    {1919858400 46800 1 +12}
    {1926511200 43200 0 +12}
    {1951308000 46800 1 +12}
    {1957960800 43200 0 +12}
    {1983362400 46800 1 +12}
    {1989410400 43200 0 +12}
    {2014812000 46800 1 +12}
    {2020860000 43200 0 +12}
    {2046261600 46800 1 +12}
    {2052309600 43200 0 +12}
    {2077711200 46800 1 +12}
    {2084364000 43200 0 +12}
    {2109160800 46800 1 +12}
    {2115813600 43200 0 +12}
    {2140610400 46800 1 +12}
    {2147263200 43200 0 +12}
    {2172664800 46800 1 +12}
    {2178712800 43200 0 +12}
    {2204114400 46800 1 +12}
    {2210162400 43200 0 +12}
    {2235564000 46800 1 +12}
    {2242216800 43200 0 +12}
    {2267013600 46800 1 +12}
    {2273666400 43200 0 +12}
    {2298463200 46800 1 +12}
    {2305116000 43200 0 +12}
    {2329912800 46800 1 +12}
    {2336565600 43200 0 +12}
    {2361967200 46800 1 +12}
    {2368015200 43200 0 +12}
    {2393416800 46800 1 +12}
    {2399464800 43200 0 +12}
    {2424866400 46800 1 +12}
    {2431519200 43200 0 +12}
    {2456316000 46800 1 +12}
    {2462968800 43200 0 +12}
    {2487765600 46800 1 +12}
    {2494418400 43200 0 +12}
    {2519820000 46800 1 +12}
    {2525868000 43200 0 +12}
    {2551269600 46800 1 +12}







|











|









|











|







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
    {1793455200 46800 1 +12}
    {1800108000 43200 0 +12}
    {1825509600 46800 1 +12}
    {1831557600 43200 0 +12}
    {1856959200 46800 1 +12}
    {1863007200 43200 0 +12}
    {1888408800 46800 1 +12}
    {1894456800 43200 0 +12}
    {1919858400 46800 1 +12}
    {1926511200 43200 0 +12}
    {1951308000 46800 1 +12}
    {1957960800 43200 0 +12}
    {1983362400 46800 1 +12}
    {1989410400 43200 0 +12}
    {2014812000 46800 1 +12}
    {2020860000 43200 0 +12}
    {2046261600 46800 1 +12}
    {2052309600 43200 0 +12}
    {2077711200 46800 1 +12}
    {2083759200 43200 0 +12}
    {2109160800 46800 1 +12}
    {2115813600 43200 0 +12}
    {2140610400 46800 1 +12}
    {2147263200 43200 0 +12}
    {2172664800 46800 1 +12}
    {2178712800 43200 0 +12}
    {2204114400 46800 1 +12}
    {2210162400 43200 0 +12}
    {2235564000 46800 1 +12}
    {2241612000 43200 0 +12}
    {2267013600 46800 1 +12}
    {2273666400 43200 0 +12}
    {2298463200 46800 1 +12}
    {2305116000 43200 0 +12}
    {2329912800 46800 1 +12}
    {2336565600 43200 0 +12}
    {2361967200 46800 1 +12}
    {2368015200 43200 0 +12}
    {2393416800 46800 1 +12}
    {2399464800 43200 0 +12}
    {2424866400 46800 1 +12}
    {2430914400 43200 0 +12}
    {2456316000 46800 1 +12}
    {2462968800 43200 0 +12}
    {2487765600 46800 1 +12}
    {2494418400 43200 0 +12}
    {2519820000 46800 1 +12}
    {2525868000 43200 0 +12}
    {2551269600 46800 1 +12}
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
    {2677068000 46800 1 +12}
    {2683720800 43200 0 +12}
    {2709122400 46800 1 +12}
    {2715170400 43200 0 +12}
    {2740572000 46800 1 +12}
    {2746620000 43200 0 +12}
    {2772021600 46800 1 +12}
    {2778674400 43200 0 +12}
    {2803471200 46800 1 +12}
    {2810124000 43200 0 +12}
    {2834920800 46800 1 +12}
    {2841573600 43200 0 +12}
    {2866975200 46800 1 +12}
    {2873023200 43200 0 +12}
    {2898424800 46800 1 +12}
    {2904472800 43200 0 +12}
    {2929874400 46800 1 +12}
    {2935922400 43200 0 +12}
    {2961324000 46800 1 +12}
    {2967976800 43200 0 +12}
    {2992773600 46800 1 +12}
    {2999426400 43200 0 +12}
    {3024223200 46800 1 +12}
    {3030876000 43200 0 +12}
    {3056277600 46800 1 +12}
    {3062325600 43200 0 +12}
    {3087727200 46800 1 +12}
    {3093775200 43200 0 +12}
    {3119176800 46800 1 +12}
    {3125829600 43200 0 +12}
    {3150626400 46800 1 +12}
    {3157279200 43200 0 +12}
    {3182076000 46800 1 +12}
    {3188728800 43200 0 +12}
    {3213525600 46800 1 +12}
    {3220178400 43200 0 +12}
    {3245580000 46800 1 +12}
    {3251628000 43200 0 +12}
    {3277029600 46800 1 +12}
    {3283077600 43200 0 +12}
    {3308479200 46800 1 +12}
    {3315132000 43200 0 +12}
    {3339928800 46800 1 +12}
    {3346581600 43200 0 +12}
    {3371378400 46800 1 +12}
    {3378031200 43200 0 +12}
    {3403432800 46800 1 +12}
    {3409480800 43200 0 +12}
    {3434882400 46800 1 +12}







|











|









|











|







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
    {2677068000 46800 1 +12}
    {2683720800 43200 0 +12}
    {2709122400 46800 1 +12}
    {2715170400 43200 0 +12}
    {2740572000 46800 1 +12}
    {2746620000 43200 0 +12}
    {2772021600 46800 1 +12}
    {2778069600 43200 0 +12}
    {2803471200 46800 1 +12}
    {2810124000 43200 0 +12}
    {2834920800 46800 1 +12}
    {2841573600 43200 0 +12}
    {2866975200 46800 1 +12}
    {2873023200 43200 0 +12}
    {2898424800 46800 1 +12}
    {2904472800 43200 0 +12}
    {2929874400 46800 1 +12}
    {2935922400 43200 0 +12}
    {2961324000 46800 1 +12}
    {2967372000 43200 0 +12}
    {2992773600 46800 1 +12}
    {2999426400 43200 0 +12}
    {3024223200 46800 1 +12}
    {3030876000 43200 0 +12}
    {3056277600 46800 1 +12}
    {3062325600 43200 0 +12}
    {3087727200 46800 1 +12}
    {3093775200 43200 0 +12}
    {3119176800 46800 1 +12}
    {3125224800 43200 0 +12}
    {3150626400 46800 1 +12}
    {3157279200 43200 0 +12}
    {3182076000 46800 1 +12}
    {3188728800 43200 0 +12}
    {3213525600 46800 1 +12}
    {3220178400 43200 0 +12}
    {3245580000 46800 1 +12}
    {3251628000 43200 0 +12}
    {3277029600 46800 1 +12}
    {3283077600 43200 0 +12}
    {3308479200 46800 1 +12}
    {3314527200 43200 0 +12}
    {3339928800 46800 1 +12}
    {3346581600 43200 0 +12}
    {3371378400 46800 1 +12}
    {3378031200 43200 0 +12}
    {3403432800 46800 1 +12}
    {3409480800 43200 0 +12}
    {3434882400 46800 1 +12}
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    {3560680800 46800 1 +12}
    {3567333600 43200 0 +12}
    {3592735200 46800 1 +12}
    {3598783200 43200 0 +12}
    {3624184800 46800 1 +12}
    {3630232800 43200 0 +12}
    {3655634400 46800 1 +12}
    {3662287200 43200 0 +12}
    {3687084000 46800 1 +12}
    {3693736800 43200 0 +12}
    {3718533600 46800 1 +12}
    {3725186400 43200 0 +12}
    {3750588000 46800 1 +12}
    {3756636000 43200 0 +12}
    {3782037600 46800 1 +12}
    {3788085600 43200 0 +12}
    {3813487200 46800 1 +12}
    {3819535200 43200 0 +12}
    {3844936800 46800 1 +12}
    {3851589600 43200 0 +12}
    {3876386400 46800 1 +12}
    {3883039200 43200 0 +12}
    {3907836000 46800 1 +12}
    {3914488800 43200 0 +12}
    {3939890400 46800 1 +12}
    {3945938400 43200 0 +12}
    {3971340000 46800 1 +12}
    {3977388000 43200 0 +12}
    {4002789600 46800 1 +12}
    {4009442400 43200 0 +12}
    {4034239200 46800 1 +12}
    {4040892000 43200 0 +12}
    {4065688800 46800 1 +12}
    {4072341600 43200 0 +12}
    {4097138400 46800 1 +12}
}







|











|









|






156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    {3560680800 46800 1 +12}
    {3567333600 43200 0 +12}
    {3592735200 46800 1 +12}
    {3598783200 43200 0 +12}
    {3624184800 46800 1 +12}
    {3630232800 43200 0 +12}
    {3655634400 46800 1 +12}
    {3661682400 43200 0 +12}
    {3687084000 46800 1 +12}
    {3693736800 43200 0 +12}
    {3718533600 46800 1 +12}
    {3725186400 43200 0 +12}
    {3750588000 46800 1 +12}
    {3756636000 43200 0 +12}
    {3782037600 46800 1 +12}
    {3788085600 43200 0 +12}
    {3813487200 46800 1 +12}
    {3819535200 43200 0 +12}
    {3844936800 46800 1 +12}
    {3850984800 43200 0 +12}
    {3876386400 46800 1 +12}
    {3883039200 43200 0 +12}
    {3907836000 46800 1 +12}
    {3914488800 43200 0 +12}
    {3939890400 46800 1 +12}
    {3945938400 43200 0 +12}
    {3971340000 46800 1 +12}
    {3977388000 43200 0 +12}
    {4002789600 46800 1 +12}
    {4008837600 43200 0 +12}
    {4034239200 46800 1 +12}
    {4040892000 43200 0 +12}
    {4065688800 46800 1 +12}
    {4072341600 43200 0 +12}
    {4097138400 46800 1 +12}
}
Changes to macosx/Tcl.xcode/project.pbxproj.
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
			isa = PBXGroup;
			children = (
				F96D3F3908F272A8004A47F5 /* auto.tcl */,
				F96D3F3A08F272A8004A47F5 /* clock.tcl */,
				F96D3F3B08F272A8004A47F5 /* dde */,
				F96D3F8C08F272A8004A47F5 /* history.tcl */,
				F96D3F8D08F272A8004A47F5 /* http */,
				F96D3F9008F272A8004A47F5 /* http1.0 */,
				F96D3F9308F272A8004A47F5 /* init.tcl */,
				F96D3F9408F272A8004A47F5 /* msgcat */,
				F96D401708F272AA004A47F5 /* opt */,
				F96D401A08F272AA004A47F5 /* package.tcl */,
				F96D401B08F272AA004A47F5 /* parray.tcl */,
				F9ECB1110B26521500A28025 /* platform */,
				F96D401C08F272AA004A47F5 /* reg */,







<







1333
1334
1335
1336
1337
1338
1339

1340
1341
1342
1343
1344
1345
1346
			isa = PBXGroup;
			children = (
				F96D3F3908F272A8004A47F5 /* auto.tcl */,
				F96D3F3A08F272A8004A47F5 /* clock.tcl */,
				F96D3F3B08F272A8004A47F5 /* dde */,
				F96D3F8C08F272A8004A47F5 /* history.tcl */,
				F96D3F8D08F272A8004A47F5 /* http */,

				F96D3F9308F272A8004A47F5 /* init.tcl */,
				F96D3F9408F272A8004A47F5 /* msgcat */,
				F96D401708F272AA004A47F5 /* opt */,
				F96D401A08F272AA004A47F5 /* package.tcl */,
				F96D401B08F272AA004A47F5 /* parray.tcl */,
				F9ECB1110B26521500A28025 /* platform */,
				F96D401C08F272AA004A47F5 /* reg */,
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
		F96D3F8D08F272A8004A47F5 /* http */ = {
			isa = PBXGroup;
			children = (
				F96D3F8E08F272A8004A47F5 /* http.tcl */,
				F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http;
			sourceTree = "<group>";
		};
		F96D3F9008F272A8004A47F5 /* http1.0 */ = {
			isa = PBXGroup;
			children = (
				F96D3F9108F272A8004A47F5 /* http.tcl */,
				F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http1.0;
			sourceTree = "<group>";
		};
		F96D3F9408F272A8004A47F5 /* msgcat */ = {
			isa = PBXGroup;
			children = (
				F96D3F9508F272A8004A47F5 /* msgcat.tcl */,
				F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */,







<
<
<
<
<
<
<
<
<







1364
1365
1366
1367
1368
1369
1370









1371
1372
1373
1374
1375
1376
1377
		F96D3F8D08F272A8004A47F5 /* http */ = {
			isa = PBXGroup;
			children = (
				F96D3F8E08F272A8004A47F5 /* http.tcl */,
				F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http;









			sourceTree = "<group>";
		};
		F96D3F9408F272A8004A47F5 /* msgcat */ = {
			isa = PBXGroup;
			children = (
				F96D3F9508F272A8004A47F5 /* msgcat.tcl */,
				F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */,
Changes to macosx/Tcl.xcodeproj/project.pbxproj.
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
			isa = PBXGroup;
			children = (
				F96D3F3908F272A8004A47F5 /* auto.tcl */,
				F96D3F3A08F272A8004A47F5 /* clock.tcl */,
				F96D3F3B08F272A8004A47F5 /* dde */,
				F96D3F8C08F272A8004A47F5 /* history.tcl */,
				F96D3F8D08F272A8004A47F5 /* http */,
				F96D3F9008F272A8004A47F5 /* http1.0 */,
				F96D3F9308F272A8004A47F5 /* init.tcl */,
				F96D3F9408F272A8004A47F5 /* msgcat */,
				F96D401708F272AA004A47F5 /* opt */,
				F96D401A08F272AA004A47F5 /* package.tcl */,
				F96D401B08F272AA004A47F5 /* parray.tcl */,
				F9ECB1110B26521500A28025 /* platform */,
				F96D401C08F272AA004A47F5 /* reg */,







<







1334
1335
1336
1337
1338
1339
1340

1341
1342
1343
1344
1345
1346
1347
			isa = PBXGroup;
			children = (
				F96D3F3908F272A8004A47F5 /* auto.tcl */,
				F96D3F3A08F272A8004A47F5 /* clock.tcl */,
				F96D3F3B08F272A8004A47F5 /* dde */,
				F96D3F8C08F272A8004A47F5 /* history.tcl */,
				F96D3F8D08F272A8004A47F5 /* http */,

				F96D3F9308F272A8004A47F5 /* init.tcl */,
				F96D3F9408F272A8004A47F5 /* msgcat */,
				F96D401708F272AA004A47F5 /* opt */,
				F96D401A08F272AA004A47F5 /* package.tcl */,
				F96D401B08F272AA004A47F5 /* parray.tcl */,
				F9ECB1110B26521500A28025 /* platform */,
				F96D401C08F272AA004A47F5 /* reg */,
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
		F96D3F8D08F272A8004A47F5 /* http */ = {
			isa = PBXGroup;
			children = (
				F96D3F8E08F272A8004A47F5 /* http.tcl */,
				F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http;
			sourceTree = "<group>";
		};
		F96D3F9008F272A8004A47F5 /* http1.0 */ = {
			isa = PBXGroup;
			children = (
				F96D3F9108F272A8004A47F5 /* http.tcl */,
				F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http1.0;
			sourceTree = "<group>";
		};
		F96D3F9408F272A8004A47F5 /* msgcat */ = {
			isa = PBXGroup;
			children = (
				F96D3F9508F272A8004A47F5 /* msgcat.tcl */,
				F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */,







<
<
<
<
<
<
<
<
<







1365
1366
1367
1368
1369
1370
1371









1372
1373
1374
1375
1376
1377
1378
		F96D3F8D08F272A8004A47F5 /* http */ = {
			isa = PBXGroup;
			children = (
				F96D3F8E08F272A8004A47F5 /* http.tcl */,
				F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http;









			sourceTree = "<group>";
		};
		F96D3F9408F272A8004A47F5 /* msgcat */ = {
			isa = PBXGroup;
			children = (
				F96D3F9508F272A8004A47F5 /* msgcat.tcl */,
				F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */,
Changes to macosx/tclMacOSXBundle.c.
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
 */

int
Tcl_MacOSXOpenBundleResources(
    Tcl_Interp *interp,
    const char *bundleName,
    int hasResourceFile,
    int maxPathLen,
    char *libraryPath)
{
    return Tcl_MacOSXOpenVersionedBundleResources(interp, bundleName, NULL,
	    hasResourceFile, maxPathLen, libraryPath);
}

/*







|







163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
 */

int
Tcl_MacOSXOpenBundleResources(
    Tcl_Interp *interp,
    const char *bundleName,
    int hasResourceFile,
    size_t maxPathLen,
    char *libraryPath)
{
    return Tcl_MacOSXOpenVersionedBundleResources(interp, bundleName, NULL,
	    hasResourceFile, maxPathLen, libraryPath);
}

/*
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

int
Tcl_MacOSXOpenVersionedBundleResources(
    Tcl_Interp *interp,
    const char *bundleName,
    const char *bundleVersion,
    int hasResourceFile,
    int maxPathLen,
    char *libraryPath)
{
#ifdef HAVE_COREFOUNDATION
    CFBundleRef bundleRef, versionedBundleRef = NULL;
    CFStringRef bundleNameRef;
    CFURLRef libURL;








|







197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

int
Tcl_MacOSXOpenVersionedBundleResources(
    Tcl_Interp *interp,
    const char *bundleName,
    const char *bundleVersion,
    int hasResourceFile,
    size_t maxPathLen,
    char *libraryPath)
{
#ifdef HAVE_COREFOUNDATION
    CFBundleRef bundleRef, versionedBundleRef = NULL;
    CFStringRef bundleNameRef;
    CFURLRef libURL;

Changes to macosx/tclMacOSXFCmd.c.
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL);
	}
	result = TCL_ERROR;
    } else {
	OSType osType;
	char bytes[4] = {'\0','\0','\0','\0'};

	memcpy(bytes, Tcl_DStringValue(&ds), (size_t)Tcl_DStringLength(&ds));
	osType = (OSType) bytes[0] << 24 |
		 (OSType) bytes[1] << 16 |
		 (OSType) bytes[2] <<  8 |
		 (OSType) bytes[3];
	TclFreeIntRep(objPtr);
	objPtr->internalRep.longValue = (long) osType;
	objPtr->typePtr = &tclOSTypeType;







|







650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL);
	}
	result = TCL_ERROR;
    } else {
	OSType osType;
	char bytes[4] = {'\0','\0','\0','\0'};

	memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
	osType = (OSType) bytes[0] << 24 |
		 (OSType) bytes[1] << 16 |
		 (OSType) bytes[2] <<  8 |
		 (OSType) bytes[3];
	TclFreeIntRep(objPtr);
	objPtr->internalRep.longValue = (long) osType;
	objPtr->typePtr = &tclOSTypeType;
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
    string[0] = (char) (osType >> 24);
    string[1] = (char) (osType >> 16);
    string[2] = (char) (osType >>  8);
    string[3] = (char) (osType);
    string[4] = '\0';
    Tcl_ExternalToUtfDString(encoding, string, -1, &ds);
    len = (unsigned) Tcl_DStringLength(&ds) + 1;
    objPtr->bytes = ckalloc(len);
    memcpy(objPtr->bytes, Tcl_DStringValue(&ds), len);
    objPtr->length = Tcl_DStringLength(&ds);
    Tcl_DStringFree(&ds);
    Tcl_FreeEncoding(encoding);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|













701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
    string[0] = (char) (osType >> 24);
    string[1] = (char) (osType >> 16);
    string[2] = (char) (osType >>  8);
    string[3] = (char) (osType);
    string[4] = '\0';
    Tcl_ExternalToUtfDString(encoding, string, -1, &ds);
    len = (unsigned) Tcl_DStringLength(&ds) + 1;
    objPtr->bytes = Tcl_Alloc(len);
    memcpy(objPtr->bytes, Tcl_DStringValue(&ds), len);
    objPtr->length = Tcl_DStringLength(&ds);
    Tcl_DStringFree(&ds);
    Tcl_FreeEncoding(encoding);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to macosx/tclMacOSXNotify.c.
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
    for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	filePtr = ckalloc(sizeof(FileHandler));
	filePtr->fd = fd;
	filePtr->readyMask = 0;
	filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	tsdPtr->firstFileHandlerPtr = filePtr;
    }
    filePtr->proc = proc;
    filePtr->clientData = clientData;







|







962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
    for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	filePtr = Tcl_Alloc(sizeof(FileHandler));
	filePtr->fd = fd;
	filePtr->readyMask = 0;
	filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	tsdPtr->firstFileHandlerPtr = filePtr;
    }
    filePtr->proc = proc;
    filePtr->clientData = clientData;
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
     */

    if (prevPtr == NULL) {
	tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
    } else {
	prevPtr->nextPtr = filePtr->nextPtr;
    }
    ckfree(filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileHandlerEventProc --
 *







|







1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
     */

    if (prevPtr == NULL) {
	tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
    } else {
	prevPtr->nextPtr = filePtr->nextPtr;
    }
    Tcl_Free(filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileHandlerEventProc --
 *
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359

	/*
	 * Don't bother to queue an event if the mask was previously non-zero
	 * since an event must still be on the queue.
	 */

	if (filePtr->readyMask == 0) {
	    FileHandlerEvent *fileEvPtr = ckalloc(sizeof(FileHandlerEvent));

	    fileEvPtr->header.proc = FileHandlerEventProc;
	    fileEvPtr->fd = filePtr->fd;
	    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	}
	filePtr->readyMask = mask;
    }







|







1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359

	/*
	 * Don't bother to queue an event if the mask was previously non-zero
	 * since an event must still be on the queue.
	 */

	if (filePtr->readyMask == 0) {
	    FileHandlerEvent *fileEvPtr = Tcl_Alloc(sizeof(FileHandlerEvent));

	    fileEvPtr->header.proc = FileHandlerEventProc;
	    fileEvPtr->fd = filePtr->fd;
	    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	}
	filePtr->readyMask = mask;
    }
Changes to tests/binary.test.
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685

























1686
1687
1688
1689
1690
1691
1692
test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} {
    binary format w 7810179016327718216
} HelloTcl
test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} {
    binary format W 7810179016327718216
} lcTolleH

test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan HelloTcl W x
    set x
} 5216694956358656876
test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan lcTolleH w x
    set x
} 5216694956358656876
test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format w [expr {wide(3) << 31}]] w x
    set x
} 6442450944
test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format W [expr {wide(3) << 31}]] W x
    set x
} 6442450944
test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
    unset -nocomplain arg1
    list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
} {1 -9223372036854775808}
test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1
    list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1
    list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1 arg2
    list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}
test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1 arg2
    list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}


























test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sws 16450 -1 19521] c* x
    set x
} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76}
test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sWs 16450 0x7fffffff 19521] c* x







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1643
1644
1645
1646
1647
1648
1649
















1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} {
    binary format w 7810179016327718216
} HelloTcl
test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} {
    binary format W 7810179016327718216
} lcTolleH

















test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
    unset -nocomplain arg1
    list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
} {1 -9223372036854775808}
test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1
    list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1
    list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1 arg2
    list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}
test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1 arg2
    list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}

test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan HelloTcl W x
    set x
} 5216694956358656876
test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan lcTolleH w x
    set x
} 5216694956358656876
test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format w [expr {wide(3) << 31}]] w x
    set x
} 6442450944
test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format W [expr {wide(3) << 31}]] W x
    set x
} 6442450944
test binary-44.5 {Tcl_BinaryObjCmd: scan wide int with bit 31 and 64 set} {} {
    binary scan [binary format w [expr {(wide(3) << 31) + (wide(3) << 64)}]] w x
    set x
} 6442450944
test binary-44.6 {Tcl_BinaryObjCmd: scan wide int with bit 31 and 64 set} {} {
    binary scan [binary format W [expr {(wide(3) << 31) + (wide(3) << 64)}]] W x
    set x
} 6442450944

test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sws 16450 -1 19521] c* x
    set x
} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76}
test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sWs 16450 0x7fffffff 19521] c* x
Changes to tests/cmdAH.test.
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testchmod       [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype  [llength [info commands testvolumetype]]
testConstraint linkDirectory [expr {
    ![testConstraint win] ||
    ([string index $tcl_platform(osVersion) 0] >= 5
     && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]

global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}








|







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testchmod       [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype  [llength [info commands testvolumetype]]
testConstraint linkDirectory [expr {
    ![testConstraint win] ||
    ($::tcl_platform(osVersion) >= 5.0
     && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]

global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}

Changes to tests/compExpr-old.test.
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
	default {
	    return 0
	}
    }
}
testConstraint ieeeFloatingPoint [testIEEE]

testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]

# procedures used below

proc put_hello_char {c} {
    global a
    append a [format %c $c]
    return $c







|
|







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
	default {
	    return 0
	}
    }
}
testConstraint ieeeFloatingPoint [testIEEE]

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

# procedures used below

proc put_hello_char {c} {
    global a
    append a [format %c $c]
    return $c
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
} -returnCodes error -match glob -result *


test compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test compExpr-old-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test compExpr-old-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8

# The following test is different for 32-bit versus 64-bit
# architectures because LONG_MIN is different

test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
    expr {int(1<<63)}
} -9223372036854775808
test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
    expr {int(1<<31)}
} -2147483648

test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test compExpr-old-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test compExpr-old-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} -body {







|
<
<
<
<

|
<
<
<







326
327
328
329
330
331
332
333




334
335



336
337
338
339
340
341
342
} -returnCodes error -match glob -result *


test compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test compExpr-old-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test compExpr-old-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
test compExpr-old-9.5 {CompileRelationalExpr: large shift expr} {




    expr {int(1<<63)}
} 9223372036854775808




test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test compExpr-old-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test compExpr-old-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
Changes to tests/config.test.
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test pkgconfig-1.1 {query keys} {
    lsort [::tcl::pkgconfig list]
} {64bit bindir,install bindir,runtime compile_debug compile_stats debug docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded}
test pkgconfig-1.2 {query keys multiple times} {
    string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
} 0
test pkgconfig-1.3 {query value multiple times} {
    string compare \
	    [::tcl::pkgconfig get bindir,install] \
	    [::tcl::pkgconfig get bindir,install]







|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test pkgconfig-1.1 {query keys} {
    lsort [::tcl::pkgconfig list]
} {64bit bindir,install bindir,runtime compile_debug compile_stats debug dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded zipfile,runtime}
test pkgconfig-1.2 {query keys multiple times} {
    string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
} 0
test pkgconfig-1.3 {query value multiple times} {
    string compare \
	    [::tcl::pkgconfig get bindir,install] \
	    [::tcl::pkgconfig get bindir,install]
Changes to tests/env.test.
12
13
14
15
16
17
18


19
20
21
22
23
24
25
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}



package require tcltests

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out







>
>







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out
Changes to tests/exec.test.
13
14
15
16
17
18
19


20
21
22
23
24
25
26

# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.

package require tcltest 2
namespace import -force ::tcltest::*



package require tcltests

# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
unset -nocomplain path








>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.

package require tcltest 2
namespace import -force ::tcltest::*

loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
unset -nocomplain path

Changes to tests/execute.test.
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

testConstraint testobj [expr {
    [llength [info commands testobj]]
    && [llength [info commands testdoubleobj]]
    && [llength [info commands teststringobj]]
}]

testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint testexprlongobj [llength [info commands testexprlongobj]]

# Tests for the omnibus TclExecuteByteCode function:

# INST_DONE not tested
# INST_PUSH1 not tested
# INST_PUSH4 not tested







|







30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

testConstraint testobj [expr {
    [llength [info commands testobj]]
    && [llength [info commands testdoubleobj]]
    && [llength [info commands teststringobj]]
}]

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint testexprlongobj [llength [info commands testexprlongobj]]

# Tests for the omnibus TclExecuteByteCode function:

# INST_DONE not tested
# INST_PUSH1 not tested
# INST_PUSH4 not tested
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
} 1
# wide ints have more bits of precision than doubles, but we convert anyway
test execute-7.7 {Wide int handling in INST_EQ and [incr]} {
    set x [expr {wide(1)<<62}]
    set y [expr {$x+1}]
    expr {double($x) == double($y)}
} 1
test execute-7.8 {Wide int conversions can change sign} longIs32bit {
    set x 0x80000000
    expr {int($x) < wide($x)}
} 1
test execute-7.9 {Wide int handling in INST_MOD} {
    expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
} 316659348800185
test execute-7.10 {Wide int handling in INST_MOD} {
    expr {((wide(1)<<60)-1) % 0x400000000}
} 17179869183







|
|
|







797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
} 1
# wide ints have more bits of precision than doubles, but we convert anyway
test execute-7.7 {Wide int handling in INST_EQ and [incr]} {
    set x [expr {wide(1)<<62}]
    set y [expr {$x+1}]
    expr {double($x) == double($y)}
} 1
test execute-7.8 {Wide int conversions can change sign} {
    set x 0x8000000000000000
    expr {wide($x) < 0}
} 1
test execute-7.9 {Wide int handling in INST_MOD} {
    expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
} 316659348800185
test execute-7.10 {Wide int handling in INST_MOD} {
    expr {((wide(1)<<60)-1) % 0x400000000}
} 17179869183
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
} 1
test execute-7.31 {Wide int handling in abs()} {
    set x 0xa23456871234568
    incr x
    set y 0x123456871234568
    concat [expr {abs($x)}] [expr {abs($y)}]
} {730503879441204585 81985533099853160}
test execute-7.32 {Wide int handling} longIs32bit {
    expr {int(1024 * 1024 * 1024 * 1024)}
} 0
test execute-7.33 {Wide int handling} longIs32bit {
    expr {int(0x1 * 1024 * 1024 * 1024 * 1024)}
} 0
test execute-7.34 {Wide int handling} {
    expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
} 1099511627776

test execute-8.1 {Stack protection} -setup {
    # If [Bug #804681] has not been properly taken care of, this should
    # segfault







|

|
|

|







879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
} 1
test execute-7.31 {Wide int handling in abs()} {
    set x 0xa23456871234568
    incr x
    set y 0x123456871234568
    concat [expr {abs($x)}] [expr {abs($y)}]
} {730503879441204585 81985533099853160}
test execute-7.32 {Wide int handling} {
    expr {int(1024 * 1024 * 1024 * 1024)}
} 1099511627776
test execute-7.33 {Wide int handling} {
    expr {int(0x1 * 1024 * 1024 * 1024 * 1024)}
} 1099511627776
test execute-7.34 {Wide int handling} {
    expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
} 1099511627776

test execute-8.1 {Stack protection} -setup {
    # If [Bug #804681] has not been properly taken care of, this should
    # segfault
Changes to tests/expr-old.test.
18
19
20
21
22
23
24
25

26
27
28
29
30
31
32

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testexprlong   [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit    [expr {int(0x80000000) < 0}]


# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {







|
>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testexprlong   [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
    expr int(-1.4)
} {-1}
test expr-old-32.32 {math functions in expressions} {
    expr int(-1.6)
} {-1}
test expr-old-32.33 {math functions in expressions} {
    expr int(1e60)
} 0
test expr-old-32.34 {math functions in expressions} {
    expr int(-1e60)
} 0
test expr-old-32.35 {math functions in expressions} {
    expr round(1.49)
} {1}
test expr-old-32.36 {math functions in expressions} {
    expr round(1.51)
} {2}
test expr-old-32.37 {math functions in expressions} {







|


|







810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
    expr int(-1.4)
} {-1}
test expr-old-32.32 {math functions in expressions} {
    expr int(-1.6)
} {-1}
test expr-old-32.33 {math functions in expressions} {
    expr int(1e60)
} 999999999999999949387135297074018866963645011013410073083904
test expr-old-32.34 {math functions in expressions} {
    expr int(-1e60)
} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.35 {math functions in expressions} {
    expr round(1.49)
} {1}
test expr-old-32.36 {math functions in expressions} {
    expr round(1.51)
} {2}
test expr-old-32.37 {math functions in expressions} {
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
	list [catch {testexprlong 0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-old-37.8 {Tcl_ExprLong handles overflows} testexprlong {
    testexprlong -0x80000000
} {This is a result: -2147483648}
test expr-old-37.9 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
    testexprlong -0xffffffff
} {This is a result: 1}
test expr-old-37.10 {Tcl_ExprLong handles overflows} \
    -constraints {testexprlong longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlong -0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}







|
|







1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
	list [catch {testexprlong 0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-old-37.8 {Tcl_ExprLong handles overflows} testexprlong {
    testexprlong -0x80000000
} {This is a result: -2147483648}
test expr-old-37.9 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
    testexprlong -0x7fffffff
} {This is a result: -2147483647}
test expr-old-37.10 {Tcl_ExprLong handles overflows} \
    -constraints {testexprlong longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlong -0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
1057
1058
1059
1060
1061
1062
1063
1064
1065




1066
1067
1068
1069
1070
1071
1072
1073
    -body {
	list [catch {testexprlong 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong {
    testexprlong -2147483648.
} {This is a result: -2147483648}
test expr-old-37.15 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
    testexprlong -4294967295.




} {This is a result: 1}
test expr-old-37.16 {Tcl_ExprLong handles overflows} \
    -constraints {testexprlong longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlong 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}







|
|
>
>
>
>
|







1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
    -body {
	list [catch {testexprlong 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong {
    testexprlong -2147483648.
} {This is a result: -2147483648}
test expr-old-37.15 {Tcl_ExprLong handles overflows} \
    -constraints {testexprlong longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlong -2147483649.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-old-37.16 {Tcl_ExprLong handles overflows} \
    -constraints {testexprlong longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlong 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
Changes to tests/expr.test.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
}

::tcltest::loadTestedCommands

# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.

testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint wideIs64bit \
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {







|
|
|
<







16
17
18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
}

::tcltest::loadTestedCommands

# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]


# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
    expr {1ea}
} -returnCodes error -match glob -result *

test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
    expr {int(1<<63)}
} -9223372036854775808
test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
    expr {int(1<<31)}
} -2147483648
test expr-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test expr-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test expr-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test expr-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
    expr 2***3>6







|

|
<
<
<







411
412
413
414
415
416
417
418
419
420



421
422
423
424
425
426
427
    expr {1ea}
} -returnCodes error -match glob -result *

test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {
    expr {int(1<<63)}
} 9223372036854775808



test expr-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test expr-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test expr-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test expr-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
    expr 2***3>6
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415


# Some compilers get this wrong; ensure that we work around it correctly
test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0
test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0
test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480
test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0

test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000

# List membership tests







|
|







1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411


# Some compilers get this wrong; ensure that we work around it correctly
test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
test expr-24.5 {expr edge cases; shifting} {expr int(5<<32)} 21474836480
test expr-24.6 {expr edge cases; shifting} {expr int(5<<63)} 46116860184273879040
test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480
test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0

test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000

# List membership tests
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
test expr-32.8 {bignum regression} {
    expr {0%-(1<<63)}
} 0
test expr-32.9 {bignum regression} {
    expr {0%-(1+(1<<63))}
} 0

test expr-33.1 {parse largest long value} longIs32bit {
    set max_long_str 2147483647
    set max_long_hex "0x7FFFFFFF "

    # Convert to integer (long, not wide) internal rep
    set max_long 2147483647
    string is integer $max_long

    list \
        [expr {" $max_long_str "}] \
        [expr {$max_long_str + 0}] \
        [expr {$max_long + 0}] \
        [expr {2147483647 + 0}] \
        [expr {$max_long == $max_long_hex}] \
        [expr {int(2147483647 + 1) < 0}] \

} {2147483647 2147483647 2147483647 2147483647 1 1}
test expr-33.2 {parse smallest long value} longIs32bit {
    set min_long_str -2147483648
    set min_long_hex "-0x80000000 "

    set min_long -2147483648
    # This will convert to integer (not wide) internal rep
    string is integer $min_long

    # Note: If the final expression returns 0 then the
    # expression literal is being promoted to a wide type
    # when it should be parsed as a long type.
    list \
        [expr {" $min_long_str "}] \
        [expr {$min_long_str + 0}] \
        [expr {$min_long + 0}] \
        [expr {-2147483648 + 0}] \
        [expr {$min_long == $min_long_hex}] \
        [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \

} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
test expr-33.3 {parse largest wide value} wideIs64bit {
    set max_wide_str 9223372036854775807
    set max_wide_hex "0x7FFFFFFFFFFFFFFF "

    # Convert to wide integer







|













|



















|







5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
test expr-32.8 {bignum regression} {
    expr {0%-(1<<63)}
} 0
test expr-32.9 {bignum regression} {
    expr {0%-(1+(1<<63))}
} 0

test expr-33.1 {parse largest long value} {
    set max_long_str 2147483647
    set max_long_hex "0x7FFFFFFF "

    # Convert to integer (long, not wide) internal rep
    set max_long 2147483647
    string is integer $max_long

    list \
        [expr {" $max_long_str "}] \
        [expr {$max_long_str + 0}] \
        [expr {$max_long + 0}] \
        [expr {2147483647 + 0}] \
        [expr {$max_long == $max_long_hex}] \
        [expr {int(2147483647 + 1) > 0}] \

} {2147483647 2147483647 2147483647 2147483647 1 1}
test expr-33.2 {parse smallest long value} longIs32bit {
    set min_long_str -2147483648
    set min_long_hex "-0x80000000 "

    set min_long -2147483648
    # This will convert to integer (not wide) internal rep
    string is integer $min_long

    # Note: If the final expression returns 0 then the
    # expression literal is being promoted to a wide type
    # when it should be parsed as a long type.
    list \
        [expr {" $min_long_str "}] \
        [expr {$min_long_str + 0}] \
        [expr {$min_long + 0}] \
        [expr {-2147483648 + 0}] \
        [expr {$min_long == $min_long_hex}] \
        [expr {int(-2147483648 - 1) == -0x80000001}] \

} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
test expr-33.3 {parse largest wide value} wideIs64bit {
    set max_wide_str 9223372036854775807
    set max_wide_hex "0x7FFFFFFFFFFFFFFF "

    # Convert to wide integer
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
} {-2}
test expr-34.11 {expr edge cases} {
    expr {$min / -2}
} {1073741824}
test expr-34.12 {expr edge cases} {
    expr {$min % -2}
} {0}
test expr-34.13 {expr edge cases} longIs32bit {
    expr {int($min / -1)}
} {-2147483648}
test expr-34.14 {expr edge cases} {
    expr {$min % -1}
} {0}
test expr-34.15 {expr edge cases} longIs32bit {
    expr {int($min * -1)}
} $min
test expr-34.16 {expr edge cases} longIs32bit {
    expr {int(-$min)}
} $min
test expr-34.17 {expr edge cases} {
    expr {$min / 1}
} $min
test expr-34.18 {expr edge cases} {
    expr {$min % 1}
} {0}







|

|



|
|

|
|







5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
} {-2}
test expr-34.11 {expr edge cases} {
    expr {$min / -2}
} {1073741824}
test expr-34.12 {expr edge cases} {
    expr {$min % -2}
} {0}
test expr-34.13 {expr edge cases} {
    expr {int($min / -1)}
} {2147483648}
test expr-34.14 {expr edge cases} {
    expr {$min % -1}
} {0}
test expr-34.15 {expr edge cases} {
    expr {-int($min * -1)}
} $min
test expr-34.16 {expr edge cases} {
    expr {-int(-$min)}
} $min
test expr-34.17 {expr edge cases} {
    expr {$min / 1}
} $min
test expr-34.18 {expr edge cases} {
    expr {$min % 1}
} {0}
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
	list [catch {testexprlongobj 0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -0x80000000
} {This is a result: -2147483648}
test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -0xffffffff
} {This is a result: 1}
test expr-39.10 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj -0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}







|
|







6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
	list [catch {testexprlongobj 0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -0x80000000
} {This is a result: -2147483648}
test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -0x7fffffff
} {This is a result: -2147483647}
test expr-39.10 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj -0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -4294967295.
} {This is a result: 1}
test expr-39.16 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}







|
|







6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.16 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
Changes to tests/fCmd.test.
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
    if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
	testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
    }
}

# Also used in winFCmd...
if {[testConstraint win]} {
    set major [string index $tcl_platform(osVersion) 0]
    if {$major > 5} {
	testConstraint winVista 1
    } else {
	testConstraint winXP 1
    }
}

testConstraint darwin9 [expr {
    [testConstraint unix]
    && $tcl_platform(os) eq "Darwin"
    && [package vsatisfies 1.$tcl_platform(osVersion) 1.9]
}]
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]

testConstraint fileSharing 0
testConstraint notFileSharing 1
testConstraint linkFile 1
testConstraint linkDirectory 1







|
<









|







61
62
63
64
65
66
67
68

69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
    if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
	testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
    }
}

# Also used in winFCmd...
if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) >= 5.0} {

	testConstraint winVista 1
    } else {
	testConstraint winXP 1
    }
}

testConstraint darwin9 [expr {
    [testConstraint unix]
    && $tcl_platform(os) eq "Darwin"
    && [package vsatisfies 1.$::tcl_platform(osVersion) 1.9]
}]
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]

testConstraint fileSharing 0
testConstraint notFileSharing 1
testConstraint linkFile 1
testConstraint linkDirectory 1
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
    file attributes foo.tmp {*}[lrange $attrs 0 3]
} -cleanup {
    file delete -force -- foo.tmp
} -result {}

if {
    [testConstraint win] &&
    ([string index $tcl_platform(osVersion) 0] < 5
     || [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
} then {
    testConstraint linkDirectory 0
    testConstraint linkFile 0
}

test fCmd-28.1 {file link} -returnCodes error -body {







|







2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
    file attributes foo.tmp {*}[lrange $attrs 0 3]
} -cleanup {
    file delete -force -- foo.tmp
} -result {}

if {
    [testConstraint win] &&
    ($::tcl_platform(osVersion) < 5.0
     || [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
} then {
    testConstraint linkDirectory 0
    testConstraint linkFile 0
}

test fCmd-28.1 {file link} -returnCodes error -body {
Changes to tests/fileName.test.
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
testConstraint linkDirectory 1
testConstraint symbolicLinkFile 1
if {[testConstraint win]} {
    if {[string index $tcl_platform(osVersion) 0] < 5 \
	    || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
	testConstraint linkDirectory 0
    }
    testConstraint symbolicLinkFile 0
    testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
}
# This match compares the first two words of the result. If the wanted result







|







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
testConstraint linkDirectory 1
testConstraint symbolicLinkFile 1
if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) < 5.0 \
	    || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
	testConstraint linkDirectory 0
    }
    testConstraint symbolicLinkFile 0
    testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
}
# This match compares the first two words of the result. If the wanted result
Changes to tests/format.test.
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# %u output depends on word length, so this test is not portable.
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint wideIs64bit \
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]

test format-1.1 {integer formatting} {
    format "%*d %d %d %d" 6 34 16923 -12 -1
} {    34 16923 -12 -1}
test format-1.2 {integer formatting} {
    format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12







|
|
|
<
<







12
13
14
15
16
17
18
19
20
21


22
23
24
25
26
27
28

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# %u output depends on word length, so this test is not portable.
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]


testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]

test format-1.1 {integer formatting} {
    format "%*d %d %d %d" 6 34 16923 -12 -1
} {    34 16923 -12 -1}
test format-1.2 {integer formatting} {
    format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
for {set i 290} {$i < 400} {incr i} {
    test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
        format {%s} $b
    } $b
    append b "x"
}

test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} {
    format %d 7810179016327718216
} 1819043144
test format-17.2 {testing %ld with wide} {wideIs64bit} {
    format %ld 7810179016327718216
} 7810179016327718216
test format-17.3 {testing %ld with non-wide} {wideIs64bit} {
    format %ld 42







|







541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
for {set i 290} {$i < 400} {incr i} {
    test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
        format {%s} $b
    } $b
    append b "x"
}

test format-17.1 {testing %d with wide} {longIs32bit wideIs64bit} {
    format %d 7810179016327718216
} 1819043144
test format-17.2 {testing %ld with wide} {wideIs64bit} {
    format %ld 7810179016327718216
} 7810179016327718216
test format-17.3 {testing %ld with non-wide} {wideIs64bit} {
    format %ld 42
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
    lappend result [expr {$a == $b}]
    set b 0xaaaa
    append b aaaa
    lappend result [expr {$a == $b}]
    format %08x $b
    lappend result [expr {$a == $b}]
} {1 1 1 1}
test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} {
    set a [expr {0xaaaaaaaaaa + 1}]
    set b 0xaaaaaaaaab
    list [format %08x $a] [expr {$a == $b}]
} {aaaaaaab 1}

test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body {
    set x 0x8fedc654







|







574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
    lappend result [expr {$a == $b}]
    set b 0xaaaa
    append b aaaa
    lappend result [expr {$a == $b}]
    format %08x $b
    lappend result [expr {$a == $b}]
} {1 1 1 1}
test format-18.2 {do not demote existing numeric values} {longIs32bit wideIs64bit} {
    set a [expr {0xaaaaaaaaaa + 1}]
    set b 0xaaaaaaaaab
    list [format %08x $a] [expr {$a == $b}]
} {aaaaaaab 1}

test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body {
    set x 0x8fedc654
Changes to tests/get.test.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testgetint [llength [info commands testgetint]]
testConstraint testdoubleobj [llength [info commands testdoubleobj]]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]

test get-1.1 {Tcl_GetInt procedure} testgetint {
    testgetint 44 { 	  22}
} {66}
test get-1.2 {Tcl_GetInt procedure} testgetint {
    testgetint 44 -3
} {41}







|
|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testgetint [llength [info commands testgetint]]
testConstraint testdoubleobj [llength [info commands testdoubleobj]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

test get-1.1 {Tcl_GetInt procedure} testgetint {
    testgetint 44 { 	  22}
} {66}
test get-1.2 {Tcl_GetInt procedure} testgetint {
    testgetint 44 -3
} {41}
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
test get-1.6 {Tcl_GetInt procedure} testgetint {
    list [catch {testgetint 44 {16	 x}} msg] $msg
} {1 {expected integer but got "16	 x"}}
test get-1.7 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint 44 18446744073709551616} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.8 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint 18446744073709551614} msg] $msg
} {0 -2}
test get-1.9 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint +18446744073709551614} msg] $msg
} {0 -2}
test get-1.10 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint -18446744073709551614} msg] $msg
} {0 2}
test get-1.11 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint 44 4294967296} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.12 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint 4294967294} msg] $msg
} {0 -2}
test get-1.13 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint +4294967294} msg] $msg
} {0 -2}
test get-1.14 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint -4294967294} msg] $msg
} {0 2}

test get-2.1 {Tcl_GetInt procedure} {
    format %g 1.23
} {1.23}
test get-2.2 {Tcl_GetInt procedure} {
    format %g { 	 1.23 	}
} {1.23}







|
|

|
|

|
|











|







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
test get-1.6 {Tcl_GetInt procedure} testgetint {
    list [catch {testgetint 44 {16	 x}} msg] $msg
} {1 {expected integer but got "16	 x"}}
test get-1.7 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint 44 18446744073709551616} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.8 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    testgetint 18446744073709551614
} {-2}
test get-1.9 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    testgetint +18446744073709551614
} {-2}
test get-1.10 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint -18446744073709551614} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.11 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint 44 4294967296} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.12 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint 4294967294} msg] $msg
} {0 -2}
test get-1.13 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint +4294967294} msg] $msg
} {0 -2}
test get-1.14 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint -4294967294} msg] $msg
} {1 {integer value too large to represent}}

test get-2.1 {Tcl_GetInt procedure} {
    format %g 1.23
} {1.23}
test get-2.2 {Tcl_GetInt procedure} {
    format %g { 	 1.23 	}
} {1.23}
Changes to tests/http.test.
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
	return
    }
}

test http-1.1 {http::config} {
    http::config -useragent UserAgent
    http::config
} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"]
test http-1.2 {http::config} {
    http::config -proxyfilter
} http::ProxyRequired
test http-1.3 {http::config} {
    catch {http::config -junk}
} 1
test http-1.4 {http::config} {
    set savedconf [http::config]
    http::config -proxyhost nowhere.come -proxyport 8080 \
	-proxyfilter myFilter -useragent "Tcl Test Suite" \
	-urlencoding iso8859-1
    set x [http::config]
    http::config {*}$savedconf
    set x
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
test http-1.5 {http::config} -returnCodes error -body {
    http::config -proxyhost {} -junk 8080
} -result {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}
test http-1.6 {http::config} -setup {
    set oldenc [http::config -urlencoding]
} -body {
    set enc [list [http::config -urlencoding]]
    http::config -urlencoding iso8859-1
    lappend enc [http::config -urlencoding]
} -cleanup {







|














|


|







78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
	return
    }
}

test http-1.1 {http::config} {
    http::config -useragent UserAgent
    http::config
} [list -accept */* -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1]
test http-1.2 {http::config} {
    http::config -proxyfilter
} http::ProxyRequired
test http-1.3 {http::config} {
    catch {http::config -junk}
} 1
test http-1.4 {http::config} {
    set savedconf [http::config]
    http::config -proxyhost nowhere.come -proxyport 8080 \
	-proxyfilter myFilter -useragent "Tcl Test Suite" \
	-urlencoding iso8859-1
    set x [http::config]
    http::config {*}$savedconf
    set x
} {-accept */* -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1}
test http-1.5 {http::config} -returnCodes error -body {
    http::config -proxyhost {} -junk 8080
} -result {Unknown option -junk, must be: -accept, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip}
test http-1.6 {http::config} -setup {
    set oldenc [http::config -urlencoding]
} -body {
    set enc [list [http::config -urlencoding]]
    http::config -urlencoding iso8859-1
    lappend enc [http::config -urlencoding]
} -cleanup {
Changes to tests/http11.test.
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
# returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1

proc handler {var sock token} {
    upvar #0 $var data
    set chunk [read $sock]
    append data $chunk
    #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
    if {[eof $sock]} {
        #::http::Log "handler eof $sock"
	chan event $sock readable {}
    }
}

test http11-3.0 "-handler,close,identity" -setup {
    variable httpd [create_httpd]
    set testdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \







|
<
<
<







511
512
513
514
515
516
517
518



519
520
521
522
523
524
525
# returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1

proc handler {var sock token} {
    upvar #0 $var data
    set chunk [read $sock]
    append data $chunk
    #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
    return [string length $chunk]



}

test http11-3.0 "-handler,close,identity" -setup {
    variable httpd [create_httpd]
    set testdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
Added tests/httpPipeline.test.




































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
# httpPipeline.test
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2
namespace import -force ::tcltest::*

package require http 2.8

set sourcedir [file normalize [file dirname [info script]]]
source [file join $sourcedir httpTest.tcl]
source [file join $sourcedir httpTestScript.tcl]

# ------------------------------------------------------------------------------
# (1) Define the test scripts that will be used to generate logs for analysis -
#     and also define the "correct" results.
# ------------------------------------------------------------------------------

proc ReturnTestScriptAndResult {ca cb delay te} {

    switch -- $ca {
	1     {set start {
	    START
	    KEEPALIVE 0
	    PIPELINE  0
	}}

	2     {set start {
	    START
	    KEEPALIVE 0
	    PIPELINE  1
	}}

	3     {set start {
	    START
	    KEEPALIVE 1
	    PIPELINE  0
	}}

	4     {set start {
	    START
	    KEEPALIVE 1
	    PIPELINE  1
	}}

	default {
	    return -code error {no matching script}
	}
    }

    set middle "
	    [list DELAY $delay]
    "

    switch -- $cb {
	1     {set end {
	    GET a
	    GET b
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 ? ? ?}
	    set resLong  {1 2 3 4}
	}

	2     {set end {
	    GET a
	    HEAD b
	    GET c
	    HEAD a
	    HEAD c
	    STOP
	    }
	    set resShort {1 ? ? ? ?}
	    set resLong  {1 2 3 4 5}
	}

	3     {set end {
	    HEAD a
	    GET b
	    HEAD c
	    HEAD b
	    GET a
	    GET b
	    STOP
	    }
	    set resShort {1 ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6}
	}

	4     {set end {
	    GET a
	    GET b
	    GET c
	    GET a
	    POST b address=home code=brief paid=yes
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? ? ? 5 ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	5     {set end {
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 3 4 5 6 7 8 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	6     {set end {
	    POST a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    GET a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 ? 3 ? ? 6 7 ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	7     {set end {
	    GET b address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    GET a address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 ? 4 ? ? 7 8 ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	8     {set end {
	    # Telling the server to close the connection.
	    GET a
	    GET b close=y
	    GET c
	    GET a
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? 3 ? ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	9     {set end {
	    # Telling the server to close the connection.
	    GET a
	    POST b close=y address=home code=brief paid=yes
	    GET c
	    GET a
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 2 3 ? ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	10     {set end {
	    # Telling the server to close the connection.
	    GET a
	    GET b close=y
	    POST c address=home code=brief paid=yes
	    GET a
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? 3 ? ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	11    {set end {
	    # Telling the server to close the connection twice.
	    GET a
	    GET b close=y
	    GET c
	    GET a
	    GET b close=y
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? 3 ? ? 6 ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	12    {set end {
	    # Telling the server to delay before sending the response.
	    GET a
	    GET b delay=1
	    GET c
	    GET a
	    GET b
	    STOP
	    }
	    set resShort {1 ? ? ? ?}
	    set resLong  {1 2 3 4 5}
	}

	13    {set end {
	    # Making the server close the connection (time out).
	    GET a
	    WAIT 2000
	    GET b
	    GET c
	    GET a
	    GET b
	    STOP
	    }
	    set resShort {1 2 ? ? ?}
	    set resLong  {1 2 3 4 5}
	}

	14    {set end {
	    # Making the server close the connection (time out) twice.
	    GET a
	    WAIT 2000
	    GET b
	    GET c
	    GET a
	    WAIT 2000
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 2 ? ? 5 ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	15    {set end {
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes close=y delay=1
	    POST c address=home code=brief paid=yes delay=1
	    POST a address=home code=brief paid=yes close=y
	    WAIT 2000
	    POST b address=home code=brief paid=yes delay=1
	    POST c address=home code=brief paid=yes close=y
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes close=y
	    POST c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 3 4 5 6 7 8 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	16    {set end {
	    POST a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes close=y
	    GET a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes close=y
	    POST c address=home code=brief paid=yes
	    WAIT 2000
	    POST a address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes close=y
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 ? 3 4 ? 6 7 ? 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	17    {set end {
	    GET b address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    GET a address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes close=y
	    GET b address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes close=y
	    POST c address=home code=brief paid=yes
	    WAIT 2000
	    POST a address=home code=brief paid=yes
	    WAIT 2000
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 3 4 5 ? 7 8 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}


	18    {set end {
	    REPOST 0
	    GET a
	    WAIT 2000
	    POST b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 2 ? ?}
	    set resLong  {1 2 3 4}
	    # resShort is overwritten below for the case ($te == 1).
	}


	19    {set end {
	    REPOST 0
	    GET a
	    WAIT 2000
	    GET b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 2 ? ?}
	    set resLong  {1 2 3 4}
	}


	20    {set end {
	    POSTFRESH 1
	    GET a
	    WAIT 2000
	    POST b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 3 ?}
	    set resLong  {1 3 4}
	}


	21    {set end {
	    POSTFRESH 1
	    GET a
	    WAIT 2000
	    GET b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 2 ? ?}
	    set resLong  {1 2 3 4}
	}

	22    {set end {
	    GET a
	    WAIT 2000
	    KEEPALIVE 0
	    POST b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 3 ?}
	    set resLong  {1 3 4}
	}


	23    {set end {
	    GET a
	    WAIT 2000
	    KEEPALIVE 0
	    GET b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 3 ?}
	    set resLong  {1 3 4}
	}

	24    {set end {
	    GET a
	    KEEPALIVE 0
	    POST b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 ? ?}
	    set resLong  {1 3 4}
	}


	25    {set end {
	    GET a
	    KEEPALIVE 0
	    GET b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 ? ?}
	    set resLong  {1 3 4}
	}

	default {
	    return -code error {no matching script}
	}
    }


    if {$ca < 3} {
	# Not Keep-Alive.
        set result "Passed all sanity checks."

    } elseif {$ca == 3} {
        # Keep-Alive, not pipelined.
        set result {}
        append result "Passed all sanity checks.\n"
        append result "Have overlaps including response body:\n"

    } else {
        # Keep-Alive, pipelined: ($ca == 4)
        set result {}
        append result "Passed all sanity checks.\n"
        append result "Overlap-free without response body:\n"
        append result "$resShort"
    }

    # - The special case of test *.18*-testEof needs test results to be
    #   individually written.
    # - These test -repost 0 when there is a POST to apply it to, and the server
    #   timeout has not been detected.
    if {($cb == 18) && ($te == 1)} {
        if {$ca < 3} {
	    # Not Keep-Alive.
	    set result "Passed all sanity checks."

	} elseif {$ca == 3 && $delay == 0} {
	    # Keep-Alive, not pipelined.
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|Wrong sequence for token ::http::3 - {A X X}
		|- and error(s) X
		|Wrong sequence for token ::http::4 - {A X X X}
		|- and error(s) X
		|
		|Have overlaps including response body:
		|
	    }]

	} elseif {$ca == 3} {
	    # Keep-Alive, not pipelined.
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|
		|Have overlaps including response body:
		|
	    }]

	} elseif {$delay == 0} {
	    # Keep-Alive, pipelined: ($ca == 4)
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|Wrong sequence for token ::http::3 - {A X X}
		|- and error(s) X
		|Wrong sequence for token ::http::4 - {A X X X}
		|- and error(s) X
		|
		|Overlap-free without response body:
		|
	    }]

	} else {
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|
		|Overlap-free without response body:
		|
	    }]

        }
    }

    return [list "$start$middle$end" $result]
}

# ------------------------------------------------------------------------------
#  Proc MakeMessage
# ------------------------------------------------------------------------------
# WHD's one-line command to generate multi-line strings from readable code.
#
# Example:
#   set blurb [MakeMessage {
#            |This command allows multi-line strings to be created with readable
#            |code, and without breaking the rules for indentation.
#            |
#            |The command shifts the entire block of text to the left, omitting
#            |the pipe character and the spaces to its left.
#   }]
# ------------------------------------------------------------------------------

proc MakeMessage {in} {
    regsub -all -line {^\s*\|} [string trim $in] {}
    # N.B. Implicit Return.
}


proc ReturnTestScript {ca cb delay te} {
    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
    return $script
}

proc ReturnTestResult {ca cb delay te} {
    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
    return $result
}


# ------------------------------------------------------------------------------
# (2) Command to run a test script and use httpTest to analyse the logs.
# ------------------------------------------------------------------------------

namespace import httpTestScript::runHttpTestScript
namespace import httpTestScript::cleanupHttpTestScript
namespace import httpTest::cleanupHttpTest
namespace import httpTest::logAnalyse
namespace import httpTest::setHttpTestOptions

proc RunTest {header footer delay te} {
    set num [runHttpTestScript [ReturnTestScript $header $footer $delay $te]]
    set skipOverlaps 0
    set notPiped    {}
    set notIncluded {}

    # --------------------------------------------------------------------------
    # Custom code for specific tests
    # --------------------------------------------------------------------------
    if {$header < 3} {
        set skipOverlaps 1
        for {set i 1} {$i <= $num} {incr i} {
	    lappend notPiped $i
        }
    } elseif {$header > 2 && $footer == 18 && $te == 1} {
        set skipOverlaps 1
        if {$delay == 0} {
	    # Transaction 1 is conventional.
	    # Check that transactions 2,3,4 are cancelled.
	    set notPiped {1}
	    set notIncluded $notPiped
        } else {
	    # Transaction 1 is conventional.
	    # Check that transaction 2 is cancelled.
	    # The timing of transactions 3 and 4 is uncertain.
	    set notPiped {1 3 4}
	    set notIncluded $notPiped
	}
    } elseif {$footer in {20 22 23 24 25}} {
	# Transaction 2 uses its own socket.
	set notPiped    2
	set notIncluded $notPiped
    } else {
    }
    # --------------------------------------------------------------------------
    # End of custom code for specific tests
    # --------------------------------------------------------------------------


    set Results [logAnalyse $num $skipOverlaps $notIncluded $notPiped]
    lassign $Results msg cleanE cleanF dirtyE dirtyF
    if {$msg eq {}} {
        set msg "Passed all sanity checks."
    } else {
        set msg "Problems with sanity checks:\n$msg"
    }

    if 0 {
        puts $msg
        puts "Overlap-free including response body:\n$cleanF"
        puts "Have overlaps including response body:\n$dirtyF"
        puts "Overlap-free without response body:\n$cleanE"
        puts "Have overlaps without response body:\n$dirtyE"
    }

    if {$header < 3} {
        # No ordering, just check that transactions all finish
        set result $msg
    } elseif {$header == 3} {
        # Not pipelined - check overlaps with response body.
        set result "$msg\nHave overlaps including response body:\n$dirtyF"
    } else {
        # Pipelined - check overlaps without response body.  Check that the
        # first request, the first requests after replay, and POSTs are clean.
        set result "$msg\nOverlap-free without response body:\n$cleanE"
    }
    set ::nTokens $num
    return $result
}


# ------------------------------------------------------------------------------
# (3) VERBOSITY CONTROL
# ------------------------------------------------------------------------------
# If tests fail, run an individual test with -verbose 1 or 2 for diagnosis.
# If still obscure, uncomment #Log and ##Log lines in the http package.
# ------------------------------------------------------------------------------

setHttpTestOptions -verbose 0

# ------------------------------------------------------------------------------
# (4) Define the base URLs used for testing.  Each must have a query string.
# ------------------------------------------------------------------------------
# - A HTTP/1.1 server is required.  It should be configured to provide
#   persistent connections when requested to do so, and to close these
#   connections if they are idle for one second.
# - The resource must be served with status 200 in response to a valid GET or
#   POST.
# - The value of "page" is always specified in the query-string. Different
#   resources for the three values of "page" allow testing of both chunked and
#   unchunked transfer encoding.
# - The variables "close" and "delay" may be specified in the query-string (for
#   a GET) or the request body (for a POST).
#   - "delay" is a numerical value in seconds, and causes the server to delay
#     the response, including headers.
#   - "close", if it has the value "y", instructs the server to close the
#     connection ater the current request.
# - Any other variables should be ignored.
# ------------------------------------------------------------------------------

namespace eval ::httpTestScript {
    variable URL
    array set URL {
        a  http://test-tcl-http.kerlin.org/index.html?page=privacy
        b  http://test-tcl-http.kerlin.org/index.html?page=conditions
        c  http://test-tcl-http.kerlin.org/index.html?page=welcome
    }
}


# ------------------------------------------------------------------------------
# (5) Define the tests
# ------------------------------------------------------------------------------
# Constraints:
# - serverNeeded - the URLs defined at (4) must be available, and must have the
#                  properties specified there.
# - duplicate    - the value of -pipeline does not matter if -keepalive 0
# - timeout1s    - tests that work correctly only if the server closes
#                  persistent connections after one second.
#
# Server timeout of persistent connections should be 1s.  Delays of 2s are
# intended to cause timeout.
# Servers are usually configured to use a longer timeout: this will cause the
# tests to fail.  The "2000" could be replaced with a larger number, but the
# tests will then be inconveniently slow.
# ------------------------------------------------------------------------------

#testConstraint serverNeeded 1
#testConstraint timeout1s 1
#testConstraint duplicate 1

# ------------------------------------------------------------------------------
#  Proc SetTestEof - to edit the command ::http::KeepSocket
# ------------------------------------------------------------------------------
# The usual line in command ::http::KeepSocket is "    set TEST_EOF 0".
# Whether the value set in the file is 0 or 1, change it here to the value
# specified by the argument.
#
# It is worth doing all tests for both values of the argument.
#
# test 0  - ::http::KeepSocket is unchanged, detects server eof where possible
#           and closes the connection.
# test 1  - ::http::KeepSocket is edited, does not detect server eof, so the
#           reaction to finding server eof can be tested without the difficulty
#           of testing in the few milliseconds of an asynchronous close event.
# ------------------------------------------------------------------------------

proc SetTestEof {test} {
    set body [info body ::http::KeepSocket]
    set subs "    set TEST_EOF $test"
    set count [regsub -line -all -- {^\s*set TEST_EOF .*$} $body $subs newBody]
    if {$count != 1} {
        return -code error {proc ::http::KeepSocket has unexpected form}
    }
    proc ::http::KeepSocket {token} $newBody
    return
}

for {set header 1} {$header <= 4} {incr header} {
    if {$header == 4} {
	setHttpTestOptions -dotted 1
	set match glob
    } else {
	setHttpTestOptions -dotted 0
	set match exact
    }

    if {$header == 2} {
        set cons0 {serverNeeded duplicate}
    } else {
        set cons0 serverNeeded
    }

    for {set footer 1} {$footer <= 25} {incr footer} {
        foreach {delay label} {
	       0 a
	       1 b
	       2 c
	       3 d
	       5 e
	       8 f
	      12 g
	     100 h
	     500 i
	    2000 j
	} {
	  foreach te {0 1} {
	    if {$te} {
	        set tag testEof
	    } else {
	        set tag normal
	    }
	    set suffix {}
	    set cons $cons0

	    # ------------------------------------------------------------------
	    # Custom code for individual tests
	    # ------------------------------------------------------------------
	    if {$footer in {18}} {
		# Custom code:
		if {($label eq "j") && ($te == 1)} {
		    continue
		}
		if {$te == 1} {
		    # The test (of REPOST 0) is useful if tag is "testEof"
		    # (server timeout without client reaction).  The same test
		    # has a different result if tag is "normal".

		    set suffix " - extra test for -repost 0 - ::http::2 must be"
		    append suffix " cancelled"
		    if {($delay == 0)} {
			append suffix ", along with  ::http::3  ::http::4 if"
			append suffix " the test creates these before ::http::2"
			append suffix " is cancelled"
		    }
		} else {
		}
	    } elseif {$footer in {19}} {
		set suffix " - extra test for -repost 0"
	    } elseif {$footer in {20 21}} {
		set suffix " - extra test for -postfresh 1"
		if {($footer == 20)} {
		    append suffix " - ::http::2 uses a separate socket"
		    append suffix ", other requests use a persistent connection"
		}
	    } elseif {$footer in {22 23 24 25}} {
		append suffix " - ::http::2 uses a separate socket"
		append suffix ", other requests use a persistent connection"
	    } else {
	    }

	    if {($footer >= 13 && $footer <= 23)} {
		# Test use WAIT and depend on server timeout before this time.
		lappend cons timeout1s
	    }
	    # ------------------------------------------------------------------
	    # End of custom code.
	    # ------------------------------------------------------------------

            set name "pipeline test header $header footer $footer delay $delay $tag$suffix"


	    # Here's the test:
            test httpPipeline-${header}.${footer}${label}-${tag} $name \
            -constraints $cons \
            -setup [string map [list TE $te] {
		# Restore default values for tests:
		http::config -pipeline 1 -postfresh 0 -repost 1
                http::init
                set http::http(uid) 0
		SetTestEof {TE}
	    }] -body [list RunTest $header $footer $delay $te] -cleanup {
		# Restore default values for tests:
		http::config -pipeline 1 -postfresh 0 -repost 1
		cleanupHttpTestScript
		SetTestEof 0
		cleanupHttpTest
		after 2000
		# Wait for persistent sockets on the server to time out.
	    } -result [ReturnTestResult $header $footer $delay $te] -match $match


	  }

	}
    }
}

# ------------------------------------------------------------------------------
# (*) Notes on tests *.18*-testEof, *.19*-testEof - these test -repost 0
# ------------------------------------------------------------------------------
# These tests are a bit awkward because the main test kit analyses whether all
# requests are satisfied, with retries if necessary, and it has result analysis
# for processing retry logs.
# - *.18*-testEof tests that certain requests are NOT satisfied, so the analysis
#   is a one-off.
# - Tests *.18a-testEof depend on client/server timing - the test needs to call
#   http::geturl for all requests before the POST (request 2) is cancelled.
#   We test that requests 2, 3, 4 are all cancelled.
# - Other tests *.18*-testEof may not request 3 and 4 in time for the to be
#   added to the write queue before request 2 is completed. We simply check that
#   request 2 is cancelled.
# - The behaviour is different if all connections are allowed to time out
#   (label "j").  This case is not needed to test -repost 0, and is omitted.
# - Tests *.18*-normal and *.19* are conventional (-repost 0 should have no
#   effect).
# ------------------------------------------------------------------------------


unset header footer delay label suffix match cons name te
namespace delete ::httpTest
namespace delete ::httpTestScript

::tcltest::cleanupTests
Added tests/httpTest.tcl.


















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
# httpTest.tcl
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------------
# "Package" httpTest for analysis of Log output of http requests.
# ------------------------------------------------------------------------------
# This is a specialised test kit for examining the presence, ordering, and
# overlap of multiple HTTP transactions over a persistent ("Keep-Alive")
# connection; and also for testing reconnection in accordance with RFC 7230 when
# the connection is lost.
#
# This kit is probably not useful for other purposes.  It depends on the
# presence of specific Log commands in the http library, and it interprets the
# logs that these commands create.
# ------------------------------------------------------------------------------

package require http

namespace eval ::http {
    variable TestStartTimeInMs [clock milliseconds]
#    catch {puts stdout "Start time (zero ms) is $TestStartTimeInMs"}
}

namespace eval ::httpTest {
    variable testResults {}
    variable testOptions
    array set testOptions {
        -verbose 0
        -dotted  1
    }
    # -verbose - 0 quiet 1 write to stdout 2 write more
    # -dotted  - (boolean) use dots for absences in lists of transactions
}

proc httpTest::Puts {txt} {
    variable testOptions
    if {$testOptions(-verbose) > 0} {
        puts stdout $txt
        flush stdout
    }
    return
}

# http::Log
#
# A special-purpose logger used for running tests.
# - Processes Log calls that have "^" in their arguments, and records them in
#   variable ::httpTest::testResults.
# - Also writes them to stdout (using Puts) if ($testOptions(-verbose) > 0).
# - Also writes Log calls that do not have "^", if ($testOptions(-verbose) > 1).

proc http::Log {args} {
    variable TestStartTimeInMs
    set time [expr {[clock milliseconds] - $TestStartTimeInMs}]
    set txt [list $time {*}$args]
    if {[string first ^ $txt] != -1} {
        ::httpTest::LogRecord $txt
        ::httpTest::Puts $txt
    } elseif {$::httpTest::testOptions(-verbose) > 1} {
        ::httpTest::Puts $txt
    }
    return
}


# Called by http::Log (the "testing" version) to record logs for later analysis.

proc httpTest::LogRecord {txt} {
    variable testResults

    set pos [string first ^ $txt]
    set len [string length  $txt]
    if {$pos > $len - 3} {
        puts stdout "Logging Error: $txt"
        puts stdout "Fix this call to Log in http-*.tm so it has ^ then\
		a letter then a numeral."
        flush stdout
    } elseif {$pos == -1} {
        # Called by mistake.
    } else {
        set letter [string index $txt [incr pos]]
        set number [string index $txt [incr pos]]
        # Max 9 requests!
        lappend testResults [list $letter $number]
    }

    return
}


# ------------------------------------------------------------------------------
# Commands for analysing the logs recorded when calling http::geturl.
# ------------------------------------------------------------------------------

# httpTest::TestOverlaps --
#
# The main test for correct behaviour of pipelined and sequential
# (non-pipelined) transactions.  Other tests should be run first to detect
# any inconsistencies in the data (e.g. absence of the elements that are
# examined here).
#
# Examine the sequence $someResults for each transaction from 1 to $n,
# ignoring any that are listed in $badTrans.
# Determine whether the elements "B" to $term for one transaction overlap
# elements "B" to $term for the previous and following transactions.
#
# Transactions in the list $badTrans are not included in "clean" or
# "dirty", but their possible overlap with other transactions is noted.
# Transactions in the list $notPiped are a subset of $badTrans, and
# their possible overlap with other transactions is NOT noted.
#
# Arguments:
# someResults - list of results, each of the form {letter numeral}
# n           - number of HTTP transactions
# term        - letter that indicated end of search range. "E" for testing
#               overlaps from start of request to end of response headers.
#               "F" to extend to the end of the response body.
# msg         - the cumulative message from sanity checks.  Append to it only
#               to report a test failure.
# badTrans    - list of transaction numbers not to be assessed as "clean" or
#               "dirty"
# notPiped    - subset of badTrans.  List of transaction numbers that cannot
#               taint another transaction by overlapping with it, because it
#               used a different socket.
#
# Return value: [list $msg $clean $dirty]
# msg   - warning messages: nothing will be appended to argument $msg if there
#         is an error with the test.
# clean - list of transactions that have no overlap with other transactions
# dirty - list of transactions that have YES overlap with other transactions

proc httpTest::TestOverlaps {someResults n term msg badTrans notPiped} {
    variable testOptions

    # Check whether transactions overlap:
    set clean {}
    set dirty {}
    for {set i 1} {$i <= $n} {incr i} {
        if {$i in $badTrans} {
            continue
        }
        set myStart   [lsearch -exact $someResults [list B $i]]
        set myEnd     [lsearch -exact $someResults [list $term $i]]

        if {($myStart == -1 || $myEnd == -1)} {
            set res "Cannot find positions of transaction $i"
	    append msg $res \n
	    Puts $res
        }

	set overlaps {}
	for {set j $myStart} {$j <= $myEnd} {incr j} {
	    lassign [lindex $someResults $j] letter number
	    if {$number != $i && $letter ne "A" && $number ni $notPiped} {
		lappend overlaps $number
	    }
	}

        if {[llength $overlaps] == 0} {
	    set res "Transaction $i has no overlaps"
	    Puts $res
	    lappend clean $i
	    if {$testOptions(-dotted)} {
		# N.B. results from different segments are concatenated.
		lappend dirty .
	    } else {
	    }
        } else {
	    set res "Transaction $i overlaps with [join $overlaps { }]"
	    Puts $res
	    lappend dirty $i
	    if {$testOptions(-dotted)} {
		# N.B. results from different segments are concatenated.
		lappend clean .
	    } else {
	    }
        }
    }
    return [list $msg $clean $dirty]
}

# httpTest::PipelineNext --
#
# Test whether prevPair, pair are valid as consecutive elements of a pipelined
# sequence (Start 1), (End 1), (Start 2), (End 2) ...
# Numbers are integers increasing (by 1 if argument "any" is false), and need
# not begin with 1.
# The first element of the sequence has prevPair {} and is always passed as
# valid.
#
# Arguments;
# Start        - string that labels the start of a segment
# End          - string that labels the end of a segment
# prevPair     - previous "pair" (list of string and number) element of a
#                sequence, or {} if argument "pair" is the first in the
#                sequence.
# pair         - current "pair" (list of string and number) element of a
#                sequence
# any          - (boolean) iff true, accept any increasing sequence of integers.
#                If false, integers must increase by 1.
#
# Return value - boolean, true iff the two pairs are valid consecutive elements.

proc httpTest::PipelineNext {Start End prevPair pair any} {
    if {$prevPair eq {}} {
        return 1
    }

    lassign $prevPair letter number
    lassign $pair newLetter newNumber
    if {$letter eq $Start} {
	return [expr {($newLetter eq $End) && ($newNumber == $number)}]
    } elseif {$any} {
        set nxt [list $Start [expr {$number + 1}]]
	return [expr {($newLetter eq $Start) && ($newNumber > $number)}]
    } else {
        set nxt [list $Start [expr {$number + 1}]]
	return [expr {($newLetter eq $Start) && ($newNumber == $number + 1)}]
    }
}

# httpTest::TestPipeline --
#
# Given a sequence of "pair" elements, check that the elements whose string is
# $Start or $End form a valid pipeline. Ignore other elements.
#
# Return value: {} if valid pipeline, otherwise a non-empty error message.

proc httpTest::TestPipeline {someResults n Start End msg desc badTrans} {
    set sequence {}
    set prevPair {}
    set ok 1
    set any [llength $badTrans]
    foreach pair $someResults {
        lassign $pair letter number
        if {($letter in [list $Start $End]) && ($number ni $badTrans)} {
            lappend sequence $pair
            if {![PipelineNext $Start $End $prevPair $pair $any]} {
		set ok 0
		break
            }
            set prevPair $pair
        }
    }

    if {!$ok} {
        set res "$desc are not pipelined: {$sequence}"
        append msg $res \n
        Puts $res
    }
    return $msg
}

# httpTest::TestSequence --
#
# Examine each transaction from 1 to $n, ignoring any that are listed
# in $badTrans.
# Check that each transaction has elements A to F, in alphabetical order.

proc httpTest::TestSequence {someResults n msg badTrans} {
    variable testOptions

    for {set i 1} {$i <= $n} {incr i} {
        if {$i in $badTrans} {
	    continue
        }
        set sequence {}
        foreach pair $someResults {
            lassign $pair letter number
            if {$number == $i} {
                lappend sequence $letter
            }
        }
        if {$sequence eq {A B C D E F}} {
        } else {
            set res "Wrong sequence for token ::http::$i - {$sequence}"
	    append msg $res \n
	    Puts $res
            if {"X" in $sequence} {
                set res "- and error(s) X"
		append msg $res \n
		Puts $res
            }
            if {"Y" in $sequence} {
                set res "- and warnings(s) Y"
		append msg $res \n
		Puts $res
            }
        }
    }
    return $msg
}

#
# Arguments:
# someResults  - list of elements, each a list of a letter and a number
# n            - (positive integer) the number of HTTP requests
# msg          - accumulated warning messages
# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
# badTrans     - list of transaction numbers not to be assessed as "clean" or
#                "dirty" by their overlaps
#   for 1/2 includes all transactions
#   for 3/4 includes an increasing (with recursion) set that will not be included in the list because they are already handled.
# notPiped     - subset of badTrans.  List of transaction numbers that cannot
#                taint another transaction by overlapping with it, because it
#                used a different socket.
#
# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
# msg    - warning messages: nothing will be appended to argument $msg if there
#          is no error with the test.
# cleanE - list of transactions that have no overlap with other transactions
#          (not considering response body)
# dirtyE - list of transactions that have YES overlap with other transactions
#          (not considering response body)
# cleanF - list of transactions that have no overlap with other transactions
#          (including response body)
# dirtyF - list of transactions that have YES overlap with other transactions
#          (including response body)

proc httpTest::MostAnalysis {someResults n msg skipOverlaps badTrans notPiped} {
    variable testOptions

    # Check that stages for "good" transactions are all present and correct:
    set msg [TestSequence $someResults $n $msg $badTrans]

    # Check that requests are pipelined:
    set msg [TestPipeline $someResults $n B C $msg Requests $notPiped]

    # Check that responses are pipelined:
    set msg [TestPipeline $someResults $n D F $msg Responses $notPiped]

    if {$skipOverlaps} {
	set cleanE {}
	set dirtyE {}
	set cleanF {}
	set dirtyF {}
    } else {
	Puts "Overlaps including response body (test for non-pipelined case)"
	lassign [TestOverlaps $someResults $n F $msg $badTrans $notPiped] msg cleanF dirtyF

	Puts "Overlaps without response body (test for pipelined case)"
	lassign [TestOverlaps $someResults $n E $msg $badTrans $notPiped] msg cleanE dirtyE
    }

    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
}

# httpTest::ProcessRetries --
#
# Command to examine results for socket-changing records [PQR],
# divide the results into segments for each connection, and analyse each segment
# individually.
# (Could add $sock to the logging to simplify this, but never mind.)
#
# In each segment, identify any transactions that are not included, and
# any that are aborted, to assist subsequent testing.
#
# Prepend A records (socket-independent) to each segment for transactions that
# were scheduled (by A) but not completed (by F).  Pass each segment to
# MostAnalysis for processing.

proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPiped} {
    variable testOptions

    set nextRetry [lsearch -glob -index 0 $someResults {[PQR]}]
    if {$nextRetry == -1} {
        return [MostAnalysis $someResults $n $msg $skipOverlaps $notIncluded $notPiped]
    }
    set badTrans $notIncluded
    set tryCount 0
    set try $nextRetry
    incr tryCount
    lassign [lindex $someResults $try] letter number
    Puts "Processing retry [lindex $someResults $try]"
    set beforeTry [lrange $someResults 0 $try-1]
    Puts [join $beforeTry \n]
    set afterTry [lrange $someResults $try+1 end]

    set dummyTry   {}
    for {set i 1} {$i <= $n} {incr i} {
        set first [lsearch -exact $beforeTry [list A $i]]
        set last  [lsearch -exact $beforeTry [list F $i]]
        if {$first == -1} {
	    set res "Transaction $i was not started in connection number $tryCount"
	    # So lappend it to badTrans and don't include it in the call below of MostAnalysis.
	    # append msg $res \n
	    Puts $res
	    if {$i ni $badTrans} {
		lappend badTrans $i
	    } else {
	    }
        } elseif {$last == -1} {
	    set res "Transaction $i was started but unfinished in connection number $tryCount"
	    # So lappend it to badTrans and don't include it in the call below of MostAnalysis.
	    # append msg $res \n
	    Puts $res
	    lappend badTrans $i
	    lappend dummyTry [list A $i]
        } else {
	    set res "Transaction $i was started and finished in connection number $tryCount"
	    # So include it in the call below of MostAnalysis.
	    # So lappend it to notIncluded and don't include it in the recursive call of
	    # ProcessRetries which handles the later connections.
	    # append msg $res \n
	    Puts $res
	    lappend notIncluded $i
        }
    }

    # Analyse the part of the results before the first replay:
    set HeadResults [MostAnalysis $beforeTry $n $msg $skipOverlaps $badTrans $notPiped]
    lassign $HeadResults msg cleanE1 cleanF1 dirtyE1 dirtyF1

    # Pass the rest of the results to be processed recursively.
    set afterTry [concat $dummyTry $afterTry]
    set TailResults [ProcessRetries $afterTry $n $msg $skipOverlaps $notIncluded $notPiped]
    lassign $TailResults msg cleanE2 cleanF2 dirtyE2 dirtyF2

    set cleanE [concat $cleanE1 $cleanE2]
    set cleanF [concat $cleanF1 $cleanF2]
    set dirtyE [concat $dirtyE1 $dirtyE2]
    set dirtyF [concat $dirtyF1 $dirtyF2]
    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
}

# httpTest::logAnalyse --
#
#	The main command called to analyse logs for a single test.
#
# Arguments:
# n            - (positive integer) the number of HTTP requests
# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
# notIncluded  - list of transaction numbers not to be assessed as "clean" or
#                "dirty" by their overlaps
# notPiped     - subset of notIncluded.  List of transaction numbers that cannot
#                taint another transaction by overlapping with it, because it
#                used a different socket.
#
# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
# msg    - warning messages: {} if there is no error with the test.
# cleanE - list of transactions that have no overlap with other transactions
#          (not considering response body)
# dirtyE - list of transactions that have YES overlap with other transactions
#          (not considering response body)
# cleanF - list of transactions that have no overlap with other transactions
#          (including response body)
# dirtyF - list of transactions that have YES overlap with other transactions
#          (including response body)

proc httpTest::logAnalyse {n skipOverlaps notIncluded notPiped} {
    variable testResults
    variable testOptions

    # Check that each data item has the correct form {letter numeral}.
    set ii 0
    set ok 1
    foreach pair $testResults {
	lassign $pair letter number
	if {    [string match {[A-Z]} $letter]
	     && [string match {[0-9]} $number]
	} {
	    # OK
	} else {
	    set ok 0
	    set res "Error: testResults has bad element {$pair} at position $ii"
	    append msg $res \n
	    Puts $res
	}
	incr ii
    }

    if {!$ok} {
	return $msg
    }
    set msg {}

    Puts [join $testResults \n]
    ProcessRetries $testResults $n $msg $skipOverlaps $notIncluded $notPiped
    # N.B. Implicit Return.
}

proc httpTest::cleanupHttpTest {} {
    variable testResults
    set testResults {}
    return
}

proc httpTest::setHttpTestOptions {key args} {
    variable testOptions
    if {$key ni {-dotted -verbose}} {
        return -code error {valid options are -dotted, -verbose}
    }
    set testOptions($key) {*}$args
}

namespace eval httpTest {
    namespace export cleanupHttpTest logAnalyse setHttpTestOptions
}
Added tests/httpTestScript.tcl.


























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
# httpTestScript.tcl
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------------
# "Package" httpTestScript for executing test scripts written in a convenient
# shorthand.
# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
# Documentation for "package" httpTestScript.
# ------------------------------------------------------------------------------
# To use the package:
# (a) define URLs as the values of elements in the array ::httpTestScript
# (b) define a script in terms of the commands
#         START STOP DELAY KEEPALIVE WAIT PIPELINE GET HEAD POST
#     referring to URLs by the name of the corresponding array element.  The
#     script can include any other Tcl commands, and evaluates in the
#     httpTestScript namespace.
# (c) Use the command httpTestScript::runHttpTestScript to evaluate the script.
# (d) For tcltest tests, wrap the runHttpTestScript call in a suitable "test"
#     command.
# ------------------------------------------------------------------------------
# START
# Must be the first command of the script.
#
# STOP
# Must be present in the script to avoid waiting for client timeout.
# Usually the last command, but can be elsewhere to end a script prematurely.
# Subsequent httpTestScript commands will have no effect.
#
# DELAY ms
# If there are no WAIT commands, this sets the delay in ms between subsequent
# calls to http::geturl.  Default 500ms.
#
# KEEPALIVE
# Set the value passed to http::geturl for the -keepalive option.  The command
# applies to subsequent requests in the script. Default 1.
#
# WAIT ms
# Pause for a time in ms before sending subsequent requests.
#
# PIPELINE boolean
# Set the value of -pipeline using http::config.  The last PIPELINE command
# in the script applies to every request. Default 1.
#
# POSTFRESH boolean
# Set the value of -postfresh using http::config.  The last POSTFRESH command
# in the script applies to every request. Default 0.
#
# REPOST boolean
# Set the value of -repost using http::config.  The last REPOST command
# in the script applies to every request. Default 1 for httpTestScript.
# (Default value in http is 0).
#
# GET uriCode ?arg ...?
# Send a HTTP request using the GET method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will be joined by "&" and appended to the query
#           string with a preceding "&".
#
# HEAD uriCode ?arg ...?
# Send a HTTP request using the HEAD method.
# Arguments: as for GET
#
# POST uriCode ?arg ...?
# Send a HTTP request using the POST method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will be joined by "&" and used as the request body.
# ------------------------------------------------------------------------------

namespace eval ::httpTestScript {
    namespace export runHttpTestScript cleanupHttpTestScript
}

# httpTestScript::START --
# Initialise, and create a long-stop timeout.

proc httpTestScript::START {} {
    variable CountRequestedSoFar
    variable RequestsWhenStopped
    variable KeepAlive
    variable Delay
    variable TimeOutCode
    variable TimeOutDone
    variable StartDone
    variable StopDone
    variable CountFinishedSoFar
    variable RequestList
    variable RequestsMade
    variable ExtraTime
    variable ActualKeepAlive

    if {[info exists StartDone] && ($StartDone == 1)} {
        set msg {START has been called twice without an intervening STOP}
        return -code error $msg
    }

    set StartDone 1
    set StopDone 0
    set TimeOutDone 0
    set CountFinishedSoFar 0
    set CountRequestedSoFar 0
    set RequestList {}
    set RequestsMade {}
    set ExtraTime 0
    set ActualKeepAlive 1

    # Undefined until a STOP command:
    unset -nocomplain RequestsWhenStopped

    # Default values:
    set KeepAlive 1
    set Delay 500

    # Default values for tests:
    KEEPALIVE 1
    PIPELINE  1
    POSTFRESH 0
    REPOST    1

    set TimeOutCode [after 30000 httpTestScript::TimeOutNow]
#    set TimeOutCode [after 4000 httpTestScript::TimeOutNow]
    return
}

# httpTestScript::STOP --
# Do not process any more commands.  The commands will be executed but will
# silently do nothing.

proc httpTestScript::STOP {} {
    variable CountRequestedSoFar
    variable CountFinishedSoFar
    variable RequestsWhenStopped
    variable TimeOutCode
    variable StartDone
    variable StopDone
    variable RequestsMade

    if {$StopDone} {
        # Don't do anything on a second call.
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    set StopDone 1
    set StartDone 0
    set RequestsWhenStopped $CountRequestedSoFar
    unset -nocomplain StartDone

    if {$CountFinishedSoFar == $RequestsWhenStopped} {
        if {[info exists TimeOutCode]} {
            after cancel $TimeOutCode
        }
        set ::httpTestScript::FOREVER 0
    }
    return
}

# httpTestScript::DELAY --
# If there are no WAIT commands, this sets the delay in ms between subsequent
# calls to http::geturl.  Default 500ms.

proc httpTestScript::DELAY {t} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    variable Delay

    set Delay $t
    return
}

# httpTestScript::KEEPALIVE --
# Set the value passed to http::geturl for the -keepalive option.  Default 1.

proc httpTestScript::KEEPALIVE {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    variable KeepAlive
    set KeepAlive $b
    return
}

# httpTestScript::WAIT --
# Pause for a time in ms before processing any more commands.

proc httpTestScript::WAIT {t} {
    variable StartDone
    variable StopDone
    variable ExtraTime

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    if {(![string is integer -strict $t]) || $t < 0} {
        return -code error {argument to WAIT must be a non-negative integer}
    }

    incr ExtraTime $t

    return
}

# httpTestScript::PIPELINE --
# Pass a value to http::config -pipeline.

proc httpTestScript::PIPELINE {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    ::http::config -pipeline $b
    ##::http::Log http(-pipeline) is now [::http::config -pipeline]
    return
}

# httpTestScript::POSTFRESH --
# Pass a value to http::config -postfresh.

proc httpTestScript::POSTFRESH {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    ::http::config -postfresh $b
    ##::http::Log http(-postfresh) is now [::http::config -postfresh]
    return
}

# httpTestScript::REPOST --
# Pass a value to http::config -repost.

proc httpTestScript::REPOST {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    ::http::config -repost $b
    ##::http::Log http(-repost) is now [::http::config -repost]
    return
}

# httpTestScript::GET --
# Send a HTTP request using the GET method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will each be preceded by "&" and appended to the query
#           string.

proc httpTestScript::GET {uriCode args} {
    variable RequestList
    lappend RequestList GET
    RequestAfter $uriCode 0 {} {*}$args
    return
}

# httpTestScript::HEAD --
# Send a HTTP request using the HEAD method.
# Arguments: as for GET

proc httpTestScript::HEAD {uriCode args} {
    variable RequestList
    lappend RequestList HEAD
    RequestAfter $uriCode 1 {} {*}$args
    return
}

# httpTestScript::POST --
# Send a HTTP request using the POST method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will be joined by "&" and used as the request body.

proc httpTestScript::POST {uriCode args} {
    variable RequestList
    lappend RequestList POST
    RequestAfter $uriCode 0 {use} {*}$args
    return
}


proc httpTestScript::RequestAfter {uriCode validate query args} {
    variable CountRequestedSoFar
    variable Delay
    variable ExtraTime
    variable StartDone
    variable StopDone
    variable KeepAlive

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    incr CountRequestedSoFar
    set idelay [expr {($CountRequestedSoFar - 1) * $Delay + 10 + $ExtraTime}]

    # Could pass values of -pipeline, -postfresh, -repost if it were
    # useful to change these mid-script.
    after $idelay [list httpTestScript::Requester $uriCode $KeepAlive $validate $query {*}$args]
    return
}

proc httpTestScript::Requester {uriCode keepAlive validate query args} {
    variable URL

    ::http::config -accept {*/*}

    set absUrl $URL($uriCode)
    if {$query eq {}} {
	if {$args ne {}} {
	    append absUrl & [join $args &]
	}
	set queryArgs {}
    } elseif {$validate} {
        return -code error {cannot have both -validate (HEAD) and -query (POST)}
    } else {
	set queryArgs [list -query [join $args &]]
    }

    if {[catch {
        ::http::geturl     $absUrl        \
                -validate  $validate      \
                -timeout   10000          \
                {*}$queryArgs             \
                -keepalive $keepAlive     \
                -command   ::httpTestScript::WhenFinished
    } token]} {
        set msg $token
        catch {puts stdout "Error: $msg"}
        return
    } else {
        # Request will begin.
    }

    return

}

proc httpTestScript::TimeOutNow {} {
    variable TimeOutDone

    set TimeOutDone 1
    set ::httpTestScript::FOREVER 0
    return
}

proc httpTestScript::WhenFinished {hToken} {
    variable CountFinishedSoFar
    variable RequestsWhenStopped
    variable TimeOutCode
    variable StopDone
    variable RequestList
    variable RequestsMade
    variable ActualKeepAlive

    upvar #0 $hToken state

    if {[catch {
	if {    [info exists state(transfer)]
	     && ($state(transfer) eq "chunked")
	} {
	    set Trans chunked
	} else {
	    set Trans unchunked
	}

	if {    [info exists ::httpTest::testOptions(-verbose)]
	     && ($::httpTest::testOptions(-verbose) > 0)
	} {
	    puts "Token    $hToken
Response $state(http)
Status   $state(status)
Method   $state(method)
Transfer $Trans
Size     $state(currentsize)
URL      $state(url)
"
	}

	if {!$state(-keepalive)} {
	    set ActualKeepAlive 0
	}

	if {[info exists state(method)]} {
	    lappend RequestsMade $state(method)
	} else {
	    lappend RequestsMade UNKNOWN
	}
	set tk [namespace tail $hToken]

	if {    ($state(http) != {HTTP/1.1 200 OK})
	     || ($state(status) != {ok})
	     || (($state(currentsize) == 0) && ($state(method) ne "HEAD"))
	} {
	    ::http::Log ^X$tk unexpected result Response $state(http) Status $state(status) Size $state(currentsize) - token $hToken
	}
    } err]} {
	::http::Log ^X$tk httpTestScript::WhenFinished failed with error status: $err - token $hToken
    }

    incr CountFinishedSoFar
    if {$StopDone && ($CountFinishedSoFar == $RequestsWhenStopped)} {
        if {[info exists TimeOutCode]} {
            after cancel $TimeOutCode
        }
        if {$RequestsMade ne $RequestList && $ActualKeepAlive} {
	    ::http::Log ^X$tk unexpected result - Script asked for "{$RequestList}" but got "{$RequestsMade}" - token $hToken
        }
        set ::httpTestScript::FOREVER 0
    }

    return
}


proc httpTestScript::runHttpTestScript {scr} {
    variable TimeOutDone
    variable RequestsWhenStopped

    after idle [list namespace eval ::httpTestScript $scr]
    vwait ::httpTestScript::FOREVER
    # N.B. does not automatically execute in this namespace, unlike some other events.
    # Release when all requests have been served or have timed out.

    if {$TimeOutDone} {
        return -code error {test script timed out}
    }

    return $RequestsWhenStopped
}


proc httpTestScript::cleanupHttpTestScript {} {
    variable TimeOutDone
    variable RequestsWhenStopped

    if {![info exists RequestsWhenStopped]} {
	return -code error {Cleanup Failed: RequestsWhenStopped is undefined}
    }

    for {set i 1} {$i <= $RequestsWhenStopped} {incr i} {
        http::cleanup ::http::$i
    }

    return
}
Changes to tests/info.test.
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#
# DO NOT DELETE THIS LINE

if {{::tcltest} ni [namespace children]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]


# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.

catch {namespace delete test_ns_info1 test_ns_info2}

namespace eval test_ns_info1 {
    namespace export *
    proc p {x} {return "x=$x"}
    proc q {{y 27} {z {}}} {return "y=$y"}
}

test info-1.1 {info args option} {
    proc t1 {a bbb c} {return foo}
    info args t1
} {a bbb c}
test info-1.2 {info args option} {
    proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
    info a t1







<


>











|







15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#
# DO NOT DELETE THIS LINE

if {{::tcltest} ni [namespace children]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint zlib [llength [info commands zlib]]

# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.

catch {namespace delete test_ns_info1 test_ns_info2}

namespace eval test_ns_info1 {
    namespace export *
    proc p {x} {return "x=$x"}
    proc q {{y 27} {z {}}} {return "y=$y"}
}

test info-1.1 {info args option} {
    proc t1 {a bbb c} {return foo}
    info args t1
} {a bbb c}
test info-1.2 {info args option} {
    proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
    info a t1
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
    list [string bytelength [info body foo]] \
	    [foo; string bytelength [info body foo]]
} {9 9}

proc testinfocmdcount {} {
    set x [info cmdcount]
    set y 12345
    set z [info cm]
    expr {$z-$x}
}
test info-3.1 {info cmdcount compiled} {
    testinfocmdcount
} 4
test info-3.2 {info cmdcount evaled} -body {
    set x [info cmdcount]
    set y 12345
    set z [info cm]
    expr {$z-$x}
} -cleanup {unset x y z} -result 4
test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 4
test info-3.4 {info cmdcount option} -body {
    info cmdcount 1
} -returnCodes error -result {wrong # args: should be "info cmdcount"}








|








|







106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
    list [string bytelength [info body foo]] \
	    [foo; string bytelength [info body foo]]
} {9 9}

proc testinfocmdcount {} {
    set x [info cmdcount]
    set y 12345
    set z [info cmdc]
    expr {$z-$x}
}
test info-3.1 {info cmdcount compiled} {
    testinfocmdcount
} 4
test info-3.2 {info cmdcount evaled} -body {
    set x [info cmdcount]
    set y 12345
    set z [info cmdc]
    expr {$z-$x}
} -cleanup {unset x y z} -result 4
test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 4
test info-3.4 {info cmdcount option} -body {
    info cmdcount 1
} -returnCodes error -result {wrong # args: should be "info cmdcount"}

674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
unset functions msg

test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
    info
} -result {wrong # args: should be "info subcommand ?arg ...?"}
test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
    info gorp
} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
    info c
} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
    info l
} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
    info s
} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}

##
# ### ### ### ######### ######### #########
## info frame

## Helper
# For the more complex results we cut the file name down to remove path







|


|


|


|







674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
unset functions msg

test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
    info
} -result {wrong # args: should be "info subcommand ?arg ...?"}
test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
    info gorp
} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
    info c
} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
    info l
} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
    info s
} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}

##
# ### ### ### ######### ######### #########
## info frame

## Helper
# For the more complex results we cut the file name down to remove path
2391
2392
2393
2394
2395
2396
2397








































































































































































2398
2399
2400
2401
2402
2403
2404
}
test info-33.35 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}









































































































































































# -------------------------------------------------------------------------
unset -nocomplain res

test info-39.2 {Bug 4b61afd660} -setup {
    proc probe {} {
	return [dict get [info frame -1] line]
    }







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
}
test info-33.35 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval ::testinfocmdtype {
    apply {cmds {
	foreach c $cmds {rename $c {}}
    } ::testinfocmdtype} [info commands ::testinfocmdtype::*]
}
test info-40.1 {info cmdtype: syntax} -body {
    info cmdtype
} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
test info-40.2 {info cmdtype: syntax} -body {
    info cmdtype foo bar
} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
test info-40.3 {info cmdtype: no such command} -body {
    info cmdtype ::testinfocmdtype::foo
} -returnCodes error -result {unknown command "::testinfocmdtype::foo"}
test info-40.4 {info cmdtype: native commands} -body {
    info cmdtype ::if
} -result native
test info-40.5 {info cmdtype: native commands} -body {
    info cmdtype ::puts
} -result native
test info-40.6 {info cmdtype: native commands} -body {
    info cmdtype ::yield
} -result native
test info-40.7 {info cmdtype: procedures} -setup {
    proc ::testinfocmdtype::someproc {} {}
} -body {
    info cmdtype ::testinfocmdtype::someproc
} -cleanup {
    rename ::testinfocmdtype::someproc {}
} -result proc
test info-40.8 {info cmdtype: aliases} -setup {
    interp alias {} ::testinfocmdtype::somealias {} ::puts
} -body {
    info cmdtype ::testinfocmdtype::somealias
} -cleanup {
    rename ::testinfocmdtype::somealias {}
} -result alias
test info-40.9 {info cmdtype: imports} -setup {
    namespace eval ::testinfocmdtype {
	namespace eval foo {
	    proc bar {} {}
	    namespace export bar
	}
	namespace import foo::bar
    }
} -body {
    info cmdtype ::testinfocmdtype::bar
} -cleanup {
    rename ::testinfocmdtype::bar {}
    namespace delete ::testinfocmdtype::foo
} -result import
test info-40.10 {info cmdtype: slaves} -setup {
    apply {i {
	rename $i ::testinfocmdtype::slave
	variable ::testinfocmdtype::slave $i
    }} [interp create]
} -body {
    info cmdtype ::testinfocmdtype::slave
} -cleanup {
    interp delete $::testinfocmdtype::slave
} -result slave
test info-40.11 {info cmdtype: objects} -setup {
    apply {{} {
	oo::object create obj
    } ::testinfocmdtype}
} -body {
    info cmdtype ::testinfocmdtype::obj
} -cleanup {
    ::testinfocmdtype::obj destroy
} -result object
test info-40.12 {info cmdtype: objects} -setup {
    apply {{} {
	oo::object create obj
    } ::testinfocmdtype}
} -body {
    info cmdtype [info object namespace ::testinfocmdtype::obj]::my
} -cleanup {
    ::testinfocmdtype::obj destroy
} -result privateObject
test info-40.13 {info cmdtype: ensembles} -setup {
    namespace eval ::testinfocmdtype {
	namespace eval ensmbl {
	    proc bar {} {}
	    namespace export *
	    namespace ensemble create
	}
    }
} -body {
    info cmdtype ::testinfocmdtype::ensmbl
} -cleanup {
    namespace delete ::testinfocmdtype::ensmbl
} -result ensemble
test info-40.14 {info cmdtype: zlib streams} -constraints zlib -setup {
    namespace eval ::testinfocmdtype {
	rename [zlib stream gzip] zstream
    }
} -body {
    info cmdtype ::testinfocmdtype::zstream
} -cleanup {
    ::testinfocmdtype::zstream close
} -result zlibStream
test info-40.15 {info cmdtype: coroutines} -setup {
    coroutine ::testinfocmdtype::coro eval yield
} -body {
    info cmdtype ::testinfocmdtype::coro
} -cleanup {
    ::testinfocmdtype::coro
} -result coroutine
test info-40.16 {info cmdtype: dynamic behavior} -setup {
    proc ::testinfocmdtype::foo {} {}
} -body {
    namespace eval ::testinfocmdtype {
	list [catch {info cmdtype foo}] [catch {info cmdtype bar}] \
	    [namespace which foo] [rename foo bar] [namespace which bar] \
	    [catch {info cmdtype foo}] [catch {info cmdtype bar}]
    }
} -cleanup {
    namespace eval ::testinfocmdtype {
	catch {rename foo {}}
	catch {rename bar {}}
    }
} -result {0 1 ::testinfocmdtype::foo {} ::testinfocmdtype::bar 1 0}
test info-40.17 {info cmdtype: aliases in slave interpreters} -setup {
    set i [interp create]
} -body {
    $i alias foo gorp
    $i eval {
	info cmdtype foo
    }
} -cleanup {
    interp delete $i
} -result alias
test info-40.18 {info cmdtype: aliases in slave interpreters} -setup {
    set safe [interp create -safe]
} -body {
    $safe alias foo gorp
    $safe eval {
	info cmdtype foo
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
test info-40.19 {info cmdtype: aliases in slave interpreters} -setup {
    set safe [interp create -safe]
} -body {
    set inner [interp create [list $safe bar]]
    interp alias $inner foo $safe gorp
    $safe eval {
	bar eval {
	    info cmdtype foo
	}
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
test info-40.20 {info cmdtype: aliases in slave interpreters} -setup {
    set safe [interp create -safe]
} -body {
    $safe eval {
	interp alias {} foo {} gorp
	info cmdtype foo
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
namespace delete ::testinfocmdtype

# -------------------------------------------------------------------------
unset -nocomplain res

test info-39.2 {Bug 4b61afd660} -setup {
    proc probe {} {
	return [dict get [info frame -1] line]
    }
Changes to tests/interp.test.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]

set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload}

foreach i [interp slaves] {
  interp delete $i
}

# Part 0: Check out options for interp command
test interp-1.1 {options for interp command} -returnCodes error -body {







|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]

set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}

foreach i [interp slaves] {
  interp delete $i
}

# Part 0: Check out options for interp command
test interp-1.1 {options for interp command} -returnCodes error -body {
Changes to tests/lreplace.test.
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
    set foo {a b}
    list [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]]
} {a {} {}}
test lreplace-1.27 {lreplace command} -body {
    lreplace x 1 1
} -returnCodes 1 -result {list doesn't contain element 1}
test lreplace-1.28 {lreplace command} -body {
    lreplace x 1 1 y
} -returnCodes 1 -result {list doesn't contain element 1}
test lreplace-1.29 {lreplace command} -body {
    lreplace x 1 1 [error foo]
} -returnCodes 1 -result {foo}
test lreplace-1.30 {lreplace command} -body {
    lreplace {not {}alist} 0 0 [error foo]
} -returnCodes 1 -result {foo}








|


|







96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
    set foo {a b}
    list [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]]
} {a {} {}}
test lreplace-1.27 {lreplace command} -body {
    lreplace x 1 1
} -result x
test lreplace-1.28 {lreplace command} -body {
    lreplace x 1 1 y
} -result {x y}
test lreplace-1.29 {lreplace command} -body {
    lreplace x 1 1 [error foo]
} -returnCodes 1 -result {foo}
test lreplace-1.30 {lreplace command} -body {
    lreplace {not {}alist} 0 0 [error foo]
} -returnCodes 1 -result {foo}

124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
    list [catch {lreplace x 10 x} msg] $msg
} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.5 {lreplace errors} {
    list [catch {lreplace x 10 1x} msg] $msg
} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.6 {lreplace errors} {
    list [catch {lreplace x 3 2} msg] $msg
} {1 {list doesn't contain element 3}}
test lreplace-2.7 {lreplace errors} {
    list [catch {lreplace x 2 2} msg] $msg
} {1 {list doesn't contain element 2}}

test lreplace-3.1 {lreplace won't modify shared argument objects} {
    proc p {} {
        lreplace "a b c" 1 1 "x y"
        return "a b c"
    }
    p







|


|







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
    list [catch {lreplace x 10 x} msg] $msg
} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.5 {lreplace errors} {
    list [catch {lreplace x 10 1x} msg] $msg
} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.6 {lreplace errors} {
    list [catch {lreplace x 3 2} msg] $msg
} {0 x}
test lreplace-2.7 {lreplace errors} {
    list [catch {lreplace x 2 2} msg] $msg
} {0 x}

test lreplace-3.1 {lreplace won't modify shared argument objects} {
    proc p {} {
        lreplace "a b c" 1 1 "x y"
        return "a b c"
    }
    p
Changes to tests/macOSXFCmd.test.
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} {
    catch {file delete -force -- foo.test}
    close [open foo.test w]
    list [catch {file attributes foo.test -hidden 1} msg] $msg \
	    [catch {file attributes foo.test -hidden} msg] $msg \
	    [file delete -force -- foo.test]
} {0 {} 0 1 {}}
test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot} {
    catch {file delete -force -- foo.test}
    close [open foo.test w]
    catch {
	set f [open foo.test/..namedfork/rsrc w]
	fconfigure $f -translation lf -eofchar {}
	puts -nonewline $f "foo"
	close $f







|







95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} {
    catch {file delete -force -- foo.test}
    close [open foo.test w]
    list [catch {file attributes foo.test -hidden 1} msg] $msg \
	    [catch {file attributes foo.test -hidden} msg] $msg \
	    [file delete -force -- foo.test]
} {0 {} 0 1 {}}
test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot nonPortable} {
    catch {file delete -force -- foo.test}
    close [open foo.test w]
    catch {
	set f [open foo.test/..namedfork/rsrc w]
	fconfigure $f -translation lf -eofchar {}
	puts -nonewline $f "foo"
	close $f
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
	file attributes baz.test -creator FOOC -type FOOT
	file attributes foo.test -creator FOOC
	file attributes inv.test -hidden 1
	file attributes inw.test -hidden 1 -type FOOT
	file attributes dir.test -hidden 1
    }
    set res [list \
	    [catch {glob *.test} msg] $msg \
	    [catch {glob -types FOOT *.test} msg] $msg \
	    [catch {glob -types {{macintosh type FOOT}} *.test} msg] $msg \
	    [catch {glob -types FOOTT *.test} msg] $msg \
	    [catch {glob -types {{macintosh type FOOTT}} *.test} msg] $msg \
	    [catch {glob -types {{macintosh type {}}} *.test} msg] $msg \
	    [catch {glob -types {{macintosh creator FOOC}} *.test} msg] $msg \
	    [catch {glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test} msg] $msg \
	    [catch {glob -types hidden *.test} msg] $msg \
	    [catch {glob -types {hidden FOOT} *.test} msg] $msg \
	]
    cd ..
    file delete -force globtest
    set res
} [list \
	0 {bar.test baz.test dir.test foo.test inv.test inw.test reg.test} \
	0 {bar.test baz.test inw.test} 0 {bar.test baz.test inw.test} \







|
|
|
|
|
|
|
|
|
|







147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
	file attributes baz.test -creator FOOC -type FOOT
	file attributes foo.test -creator FOOC
	file attributes inv.test -hidden 1
	file attributes inw.test -hidden 1 -type FOOT
	file attributes dir.test -hidden 1
    }
    set res [list \
	    [catch {lsort [glob *.test]} msg] $msg \
	    [catch {lsort [glob -types FOOT *.test]} msg] $msg \
	    [catch {lsort [glob -types {{macintosh type FOOT}} *.test]} msg] $msg \
	    [catch {lsort [glob -types FOOTT *.test]} msg] $msg \
	    [catch {lsort [glob -types {{macintosh type FOOTT}} *.test]} msg] $msg \
	    [catch {lsort [glob -types {{macintosh type {}}} *.test]} msg] $msg \
	    [catch {lsort [glob -types {{macintosh creator FOOC}} *.test]} msg] $msg \
	    [catch {lsort [glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test]} msg] $msg \
	    [catch {lsort [glob -types hidden *.test]} msg] $msg \
	    [catch {lsort [glob -types {hidden FOOT} *.test]} msg] $msg \
	]
    cd ..
    file delete -force globtest
    set res
} [list \
	0 {bar.test baz.test dir.test foo.test inv.test inw.test reg.test} \
	0 {bar.test baz.test inw.test} 0 {bar.test baz.test inw.test} \
Changes to tests/obj.test.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit	[expr {int(0x80000000) < 0}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]

test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
    set r 1
    foreach {t} {
	bytearray
	bytecode
	cmdName







|
|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]

test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
    set r 1
    foreach {t} {
	bytearray
	bytecode
	cmdName
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
    set x {}
    for {set i 0} {$i<100000} {incr i} {
	set x [list $x {}]
    }
    unset x
} {}

test obj-33.1 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x 0x8000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 2147483648}
test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x 0xffff; append x ffff
    list [string is integer $x] [expr { wide($x) }]
} {1 4294967295}
test obj-33.3 {integer overflow on input} {
    set x 0x10000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {0 4294967296}
test obj-33.4 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x -0x8000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 -2147483648}
test obj-33.5 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x -0x8000; append x 0001
    list [string is integer $x] [expr { wide($x) }]
} {1 -2147483649}
test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x -0xffff; append x ffff
    list [string is integer $x] [expr { wide($x) }]
} {1 -4294967295}
test obj-33.7 {integer overflow on input} {
    set x -0x10000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {0 -4294967296}

test obj-34.1 {mp_iseven} testobj {
    set result ""
    lappend result [testbignumobj set 1 0]
    lappend result [testbignumobj iseven 1]    ;
    lappend result [testobj type 1]
} {0 1 int}







|



|






|
|



|



|






|







545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
    set x {}
    for {set i 0} {$i<100000} {incr i} {
	set x [list $x {}]
    }
    unset x
} {}

test obj-33.1 {integer overflow on input} {longIs32bit wideIs64bit} {
    set x 0x8000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 2147483648}
test obj-33.2 {integer overflow on input} {longIs32bit wideIs64bit} {
    set x 0xffff; append x ffff
    list [string is integer $x] [expr { wide($x) }]
} {1 4294967295}
test obj-33.3 {integer overflow on input} {
    set x 0x10000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 4294967296}
test obj-33.4 {integer overflow on input} {longIs32bit wideIs64bit} {
    set x -0x8000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 -2147483648}
test obj-33.5 {integer overflow on input} {longIs32bit wideIs64bit} {
    set x -0x8000; append x 0001
    list [string is integer $x] [expr { wide($x) }]
} {1 -2147483649}
test obj-33.6 {integer overflow on input} {longIs32bit wideIs64bit} {
    set x -0xffff; append x ffff
    list [string is integer $x] [expr { wide($x) }]
} {1 -4294967295}
test obj-33.7 {integer overflow on input} {
    set x -0x10000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 -4294967296}

test obj-34.1 {mp_iseven} testobj {
    set result ""
    lappend result [testbignumobj set 1 0]
    lappend result [testbignumobj iseven 1]    ;
    lappend result [testobj type 1]
} {0 1 int}
Changes to tests/oo.test.
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

package require TclOO 1.0.3
package require tcltest 2
if {"::tcltest" in [namespace children]} {
    namespace import -force ::tcltest::*
}


# The foundational objects oo::object and oo::class are sensitive to reference
# counting errors and are deallocated only when an interp is deleted, so in
# this test suite, interp creation and interp deletion are often used in
# leaktests in order to leverage this sensitivity.


testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }







<




<







9
10
11
12
13
14
15

16
17
18
19

20
21
22
23
24
25
26

package require TclOO 1.0.3
package require tcltest 2
if {"::tcltest" in [namespace children]} {
    namespace import -force ::tcltest::*
}


# The foundational objects oo::object and oo::class are sensitive to reference
# counting errors and are deallocated only when an interp is deleted, so in
# this test suite, interp creation and interp deletion are often used in
# leaktests in order to leverage this sensitivity.


testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
		lappend x [info class $cmd ::oo::$initial]
	    }
	}
	foreach initial {object class Slot} {
	    lappend x [info object class ::oo::$initial]
	}
	return $x
    }] {lsort $x}
} -cleanup {
    interp delete $fresh
} -result {{} {::oo::Slot ::oo::class ::oo::object} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}

test oo-2.1 {basic test of OO functionality: constructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as
    # we're modifying the root object class's constructor
    interp create subinterp
    subinterp eval {
	package require TclOO







|


|







334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
		lappend x [info class $cmd ::oo::$initial]
	    }
	}
	foreach initial {object class Slot} {
	    lappend x [info object class ::oo::$initial]
	}
	return $x
    }] {lsort [lmap y $x {if {[string match *::delegate $y]} continue; set y}]}
} -cleanup {
    interp delete $fresh
} -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::object ::oo::singleton} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {::oo::abstract ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}

test oo-2.1 {basic test of OO functionality: constructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as
    # we're modifying the root object class's constructor
    interp create subinterp
    subinterp eval {
	package require TclOO
1800
1801
1802
1803
1804
1805
1806




































































































1807
1808
1809
1810
1811
1812
1813
    }
    oo::class create bar
    [foo new] m
} -cleanup {
    foo destroy
    bar destroy
} -result {::foo ::foo ::foo ::bar}




































































































# todo: changing a class subtype (metaclass) to another class subtype

test oo-14.1 {OO: mixins} {
    oo::class create Aclass
    oo::define Aclass method bar {} {lappend ::result "[self object] in bar"}
    oo::class create Bclass
    oo::define Bclass method boo {} {lappend ::result "[self object] in boo"}







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
    }
    oo::class create bar
    [foo new] m
} -cleanup {
    foo destroy
    bar destroy
} -result {::foo ::foo ::foo ::bar}
test oo-13.5 {OO: changing an object's class: non-class to class} -setup {
    oo::object create fooObj
} -body {
    oo::objdefine fooObj {
	class oo::class
    }
    oo::define fooObj {
	method x {} {expr 1+2+3}
    }
    [fooObj new] x
} -cleanup {
    fooObj destroy
} -result 6
test oo-13.6 {OO: changing an object's class: class to non-class} -setup {
    oo::class create foo
    unset -nocomplain ::result
} -body {
    set result dangling
    oo::define foo {
	method x {} {expr 1+2+3}
    }
    oo::class create boo {
	superclass foo
	destructor {set ::result "ok"}
    }
    boo new
    foo create bar
    oo::objdefine foo {
	class oo::object
    }
    list $result [catch {bar x} msg] $msg
} -cleanup {
    catch {bar destroy}
    foo destroy
} -result {ok 1 {invalid command name "bar"}}
test oo-13.7 {OO: changing an object's class} -setup {
    oo::class create foo
    oo::class create bar
    unset -nocomplain result
} -body {
    oo::define bar method x {} {return ok}
    oo::define foo {
	method x {} {expr 1+2+3}
	self mixin foo
    }
    lappend result [foo x]
    oo::objdefine foo class bar
    lappend result [foo x]
} -cleanup {
    foo destroy
    bar destroy
} -result {6 ok}
test oo-13.8 {OO: changing an object's class to itself} -setup {
    oo::class create foo
} -body {
    oo::define foo {
	method x {} {expr 1+2+3}
    }
    oo::objdefine foo class foo
} -cleanup {
    foo destroy
} -returnCodes error -result {may not change classes into an instance of themselves}
test oo-13.9 {OO: changing an object's class: roots are special} -setup {
    set i [interp create]
} -body {
    $i eval {
	oo::objdefine oo::object {
	    class oo::class
	}
    }
} -cleanup {
    interp delete $i
} -returnCodes error -result {may not modify the class of the root object class}
test oo-13.10 {OO: changing an object's class: roots are special} -setup {
    set i [interp create]
} -body {
    $i eval {
	oo::objdefine oo::class {
	    class oo::object
	}
    }
} -cleanup {
    interp delete $i
} -returnCodes error -result {may not modify the class of the class of classes}
test oo-13.11 {OO: changing an object's class in a tricky place} -setup {
    oo::class create cls
    unset -nocomplain result
} -body {
    set result gorp
    list [catch {
	oo::define cls {
	    method x {} {return}
	    self class oo::object
	    ::set ::result ok
	    method y {} {return}; # I'm sorry, Dave. I'm afraid I can't do that.
	}
    } msg] $msg $result
} -cleanup {
    cls destroy
} -result {1 {attempt to misuse API} ok}
# todo: changing a class subtype (metaclass) to another class subtype

test oo-14.1 {OO: mixins} {
    oo::class create Aclass
    oo::define Aclass method bar {} {lappend ::result "[self object] in bar"}
    oo::class create Bclass
    oo::define Bclass method boo {} {lappend ::result "[self object] in boo"}
3834
3835
3836
3837
3838
3839
3840





3841
3842
3843
3844
3845
3846
3847
	    }
	    method Set {lst} {
		variable contents $lst
		variable ops
		lappend ops [info level] Set $lst
		return
	    }





	}
    }
    append script0 \n$script
}

proc SampleSlotCleanup script {
    set script0 {







>
>
>
>
>







3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
	    }
	    method Set {lst} {
		variable contents $lst
		variable ops
		lappend ops [info level] Set $lst
		return
	    }
	    method Resolve {lst} {
		variable ops
		lappend ops [info level] Resolve $lst
		return $lst
	    }
	}
    }
    append script0 \n$script
}

proc SampleSlotCleanup script {
    set script0 {
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
















3892
3893
3894
3895
3896
3897
3898
test oo-32.3 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -append g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {a b c g h i} {1 Get 1 Set {a b c g h i}}}
test oo-32.4 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -set d e f] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {d e f} {1 Set {d e f}}}
test oo-32.5 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -set d e f] [sampleSlot -append g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {} {d e f g h i} {1 Set {d e f} 1 Get 1 Set {d e f g h i}}}

















test oo-33.1 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
    set s [SampleSlot new]
}] -body {
    list [$s x y] [$s contents]
} -cleanup [SampleSlotCleanup {
    rename $s {}







|







|







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
test oo-32.3 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -append g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {a b c g h i} {1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {a b c g h i}}}
test oo-32.4 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -set d e f] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {d e f} {1 Resolve d 1 Resolve e 1 Resolve f 1 Set {d e f}}}
test oo-32.5 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -set d e f] [sampleSlot -append g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {} {d e f g h i} {1 Resolve d 1 Resolve e 1 Resolve f 1 Set {d e f} 1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {d e f g h i}}}
test oo-32.6 {TIP 516: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -prepend g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {g h i a b c} {1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {g h i a b c}}}
test oo-32.6 {TIP 516: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -remove c a] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} b {1 Resolve c 1 Resolve a 1 Get 1 Set b}}

test oo-33.1 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
    set s [SampleSlot new]
}] -body {
    list [$s x y] [$s contents]
} -cleanup [SampleSlotCleanup {
    rename $s {}
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
test oo-33.3 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
    set s [SampleSlot new]
}] -body {
    oo::objdefine $s forward --default-operation  my -set
    list [$s destroy; $s unknown] [$s contents] [$s ops]
} -cleanup [SampleSlotCleanup {
    rename $s {}
}] -result {{} unknown {1 Set destroy 1 Set unknown}}
test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup {
    set s [SampleSlot new]
}] -body {
    # Method names beginning with "-" are special to slots
    $s -grill q
} -returnCodes error -cleanup [SampleSlotCleanup {
    rename $s {}
}] -result \
    {unknown method "-grill": must be -append, -clear, -set, contents or ops}

test oo-34.1 {TIP 380: slots - presence} -setup {
    set obj [oo::object new]
    set result {}
} -body {
    oo::define oo::object {
	::lappend ::result [::info object class filter]







|








|







4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
test oo-33.3 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
    set s [SampleSlot new]
}] -body {
    oo::objdefine $s forward --default-operation  my -set
    list [$s destroy; $s unknown] [$s contents] [$s ops]
} -cleanup [SampleSlotCleanup {
    rename $s {}
}] -result {{} unknown {1 Resolve destroy 1 Set destroy 1 Resolve unknown 1 Set unknown}}
test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup {
    set s [SampleSlot new]
}] -body {
    # Method names beginning with "-" are special to slots
    $s -grill q
} -returnCodes error -cleanup [SampleSlotCleanup {
    rename $s {}
}] -result \
    {unknown method "-grill": must be -append, -clear, -prepend, -remove, -set, contents or ops}

test oo-34.1 {TIP 380: slots - presence} -setup {
    set obj [oo::object new]
    set result {}
} -body {
    oo::define oo::object {
	::lappend ::result [::info object class filter]
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971











































3972
3973
3974
3975
3976
3977
3978
} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable}
proc getMethods obj {
    list [lsort [info object methods $obj -all]] \
	[lsort [info object methods $obj -private]]
}
test oo-34.3 {TIP 380: slots - presence} {
    getMethods oo::define::filter
} {{-append -clear -set} {Get Set}}
test oo-34.4 {TIP 380: slots - presence} {
    getMethods oo::define::mixin
} {{-append -clear -set} {--default-operation Get Set}}
test oo-34.5 {TIP 380: slots - presence} {
    getMethods oo::define::superclass
} {{-append -clear -set} {--default-operation Get Set}}
test oo-34.6 {TIP 380: slots - presence} {
    getMethods oo::define::variable
} {{-append -clear -set} {Get Set}}
test oo-34.7 {TIP 380: slots - presence} {
    getMethods oo::objdefine::filter
} {{-append -clear -set} {Get Set}}
test oo-34.8 {TIP 380: slots - presence} {
    getMethods oo::objdefine::mixin
} {{-append -clear -set} {--default-operation Get Set}}
test oo-34.9 {TIP 380: slots - presence} {
    getMethods oo::objdefine::variable
} {{-append -clear -set} {Get Set}}












































test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
    oo::class create fruit {
	method eat {} {}
    }
    set result {}
} -body {







|


|


|


|


|


|


|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable}
proc getMethods obj {
    list [lsort [info object methods $obj -all]] \
	[lsort [info object methods $obj -private]]
}
test oo-34.3 {TIP 380: slots - presence} {
    getMethods oo::define::filter
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.4 {TIP 380: slots - presence} {
    getMethods oo::define::mixin
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.5 {TIP 380: slots - presence} {
    getMethods oo::define::superclass
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.6 {TIP 380: slots - presence} {
    getMethods oo::define::variable
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.7 {TIP 380: slots - presence} {
    getMethods oo::objdefine::filter
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.8 {TIP 380: slots - presence} {
    getMethods oo::objdefine::mixin
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.9 {TIP 380: slots - presence} {
    getMethods oo::objdefine::variable
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.10 {TIP 516: slots - resolution} -setup {
    oo::class create parent
    set result {}
    oo::class create 516a { superclass parent }
    oo::class create 516b { superclass parent }
    oo::class create 516c { superclass parent }
    namespace eval 516test {
	oo::class create 516a { superclass parent }
	oo::class create 516b { superclass parent }
	oo::class create 516c { superclass parent }
    }
} -body {
    # Must find the right classes when making the mixin
    namespace eval 516test {
	oo::define 516a {
	    mixin 516b 516c
	}
    }
    lappend result [info class mixin 516test::516a]
    # Must not remove class with just simple name match
    oo::define 516test::516a {
	mixin -remove 516b
    }
    lappend result [info class mixin 516test::516a]
    # Must remove class with resolved name match
    oo::define 516test::516a {
	mixin -remove 516test::516c
    }
    lappend result [info class mixin 516test::516a]
    # Must remove class with resolved name match even after renaming, but only
    # with the renamed name; it is a slot of classes, not strings!
    rename 516test::516b 516test::516d
    oo::define 516test::516a {
	mixin -remove 516test::516b
    }
    lappend result [info class mixin 516test::516a]
    oo::define 516test::516a {
	mixin -remove 516test::516d
    }
    lappend result [info class mixin 516test::516a]
} -cleanup {
    parent destroy
} -result {{::516test::516b ::516test::516c} {::516test::516b ::516test::516c} ::516test::516b ::516test::516d {}}

test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
    oo::class create fruit {
	method eat {} {}
    }
    set result {}
} -body {
4841
4842
4843
4844
4845
4846
4847
4848





































































4849
4850
4851
4852
4853
4854
	unexport foo
    }
    lappend result {*}[lmap s {public unexported private} {
	info class methods cls -scope $s}]
} -cleanup {
    cls destroy
} -result {{} {} foo {} foo {}}






































































cleanupTests
return

# Local Variables:
# mode: tcl
# End:







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
	unexport foo
    }
    lappend result {*}[lmap s {public unexported private} {
	info class methods cls -scope $s}]
} -cleanup {
    cls destroy
} -result {{} {} foo {} foo {}}

test oo-41.1 {TIP 478: myclass command, including class morphing} -setup {
    oo::class create parent
    set result {}
} -body {
    oo::class create cls1 {
	superclass parent
	self method count {} {
	    my variable c
	    incr c
	}
	method act {} {
	    myclass count
	}
    }
    cls1 create x
    lappend result [x act] [x act]
    cls1 create y
    lappend result [y act] [y act] [x act]
    oo::class create cls2 {
	superclass cls1
	self method count {} {
	    my variable d
	    expr {1.0 * [incr d]}
	}
    }
    oo::objdefine x {class cls2}
    lappend result [x act] [y act] [x act] [y act]
} -cleanup {
    parent destroy
} -result {1 2 3 4 5 1.0 6 2.0 7}
test oo-41.2 {TIP 478: myclass command cleanup} -setup {
    oo::class create parent
    set result {}
} -body {
    oo::class create cls1 {
	superclass parent
	self method hi {} {
	    return "this is [self]"
	}
	method hi {} {
	    return "this is [self]"
	}
    }
    cls1 create x
    rename [info object namespace x]::my foo
    rename [info object namespace x]::myclass bar
    lappend result [cls1 hi] [x hi] [foo hi] [bar hi]
    x destroy
    lappend result [catch {foo hi}] [catch {bar hi}]
} -cleanup {
    parent destroy
} -result {{this is ::cls1} {this is ::x} {this is ::x} {this is ::cls1} 1 1}
test oo-41.3 {TIP 478: myclass command calls unexported methods, via forward} -setup {
    oo::class create parent
    set result {}
} -body {
    oo::class create cls1 {
	superclass parent
	self method Hi {} {
	    return "this is [self]"
	}
	forward poke myclass Hi
    }
    cls1 create x
    lappend result [catch {cls1 Hi}] [x poke]
} -cleanup {
    parent destroy
} -result {1 {this is ::cls1}}

cleanupTests
return

# Local Variables:
# mode: tcl
# End:
Added tests/ooUtil.test.






































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
# This file contains a collection of tests for functionality originally
# sourced from the ooutil package in Tcllib. Sourcing this file into Tcl runs
# the tests and generates output for errors. No output means no errors were
# found.
#
# Copyright (c) 2014-2016 Andreas Kupries
# Copyright (c) 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 1.0.3
package require tcltest 2
if {"::tcltest" in [namespace children]} {
    namespace import -force ::tcltest::*
}

test ooUtil-1.1 {TIP 478: classmethod} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
        superclass ActiveRecord
    }
    Table find foo bar
} -cleanup {
    parent destroy
} -result {::Table called with arguments: foo bar}
test ooUtil-1.2 {TIP 478: classmethod in namespace} -setup {
    namespace eval ::testns {}
} -body {
    namespace eval ::testns {
	oo::class create ActiveRecord {
	    classmethod find args {
		return "[self] called with arguments: $args"
	    }
	}
	oo::class create Table {
	    superclass ActiveRecord
	}
    }
    testns::Table find foo bar
} -cleanup {
    namespace delete ::testns
} -result {::testns::Table called with arguments: foo bar}
test ooUtil-1.3 {TIP 478: classmethod must not interfere with constructor signatures} -setup {
    oo::class create parent
} -body {
    oo::class create TestClass {
        superclass oo::class parent
        self method create {name ignore body} {
            next $name $body
        }
    }
    TestClass create okay {} {}
} -cleanup {
    parent destroy
} -result {::okay}
test ooUtil-1.4 {TIP 478: classmethod with several inheritance levels} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
        superclass ActiveRecord
    }
    oo::class create SubTable {
        superclass Table
    }
    SubTable find foo bar
} -cleanup {
    parent destroy
} -result {::SubTable called with arguments: foo bar}
test ooUtil-1.5 {TIP 478: classmethod and instances} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
	superclass ActiveRecord
    }
    set t [Table new]
    $t find 1 2 3
} -cleanup {
    parent destroy
} -result {::Table called with arguments: 1 2 3}
test ooUtil-1.6 {TIP 478: classmethod and instances} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
	superclass ActiveRecord
	unexport find
    }
    set t [Table new]
    $t find 1 2 3
} -returnCodes error -cleanup {
    parent destroy
} -match glob -result {unknown method "find": must be *}
test ooUtil-1.7 {} -setup {
    oo::class create parent
} -body {
    oo::class create Foo {
	superclass parent
        classmethod bar {} {
            puts "This is in the class; self is [self]"
            my meee
        }
        classmethod meee {} {
            puts "This is meee"
        }
    }
    oo::class create Grill {
        superclass Foo
        classmethod meee {} {
            puts "This is meee 2"
        }
    }
    list [Foo bar] [Grill bar] [[Foo new] bar] [[Grill new] bar]
} -cleanup {
    parent destroy
} -result {{} {} {} {}} -output "This is in the class; self is ::Foo\nThis is meee\nThis is in the class; self is ::Grill\nThis is meee 2\nThis is in the class; self is ::Foo\nThis is meee\nThis is in the class; self is ::Grill\nThis is meee 2\n"
# Two tests to confirm that we correctly initialise the scripted part of TclOO
# in child interpreters. This is slightly tricky at the implementation level
# because we cannot count on either [source] or [open] being available.
test ooUtil-1.8 {TIP 478: classmethod in child interp} -setup {
    set childinterp [interp create]
} -body {
    $childinterp eval {
	oo::class create ActiveRecord {
	    classmethod find args {
		return "[self] called with arguments: $args"
	    }
	}
	oo::class create Table {
	    superclass ActiveRecord
	}
	# This is confirming that this is not the master interpreter
	list [Table find foo bar] [info globals childinterp]
    }
} -cleanup {
    interp delete $childinterp
} -result {{::Table called with arguments: foo bar} {}}
test ooUtil-1.9 {TIP 478: classmethod in safe child interp} -setup {
    set safeinterp [interp create -safe]
} -body {
    $safeinterp eval {
	oo::class create ActiveRecord {
	    classmethod find args {
		return "[self] called with arguments: $args"
	    }
	}
	oo::class create Table {
	    superclass ActiveRecord
	}
	# This is confirming that this is a (basic) safe interpreter
	list [Table find foo bar] [info commands source]
    }
} -cleanup {
    interp delete $safeinterp
} -result {{::Table called with arguments: foo bar} {}}

test ooUtil-2.1 {TIP 478: callback generation} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {} { return ok,[self] }
	method makeCall {} {
	    return [callback CallMe]
	}
    }
    c create ::context
    set cb [context makeCall]
    {*}$cb
} -cleanup {
    parent destroy
} -result {ok,::context}
test ooUtil-2.2 {TIP 478: callback generation} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {a b c} { return ok,[self],$a,$b,$c }
	method makeCall {b} {
	    return [callback CallMe 123 $b]
	}
    }
    c create ::context
    set cb [context makeCall "a b c"]
    {*}$cb PQR
} -cleanup {
    parent destroy
} -result {ok,::context,123,a b c,PQR}
test ooUtil-2.3 {TIP 478: callback generation, alternate name} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {} { return ok,[self] }
	method makeCall {} {
	    return [mymethod CallMe]
	}
    }
    c create ::context
    set cb [context makeCall]
    {*}$cb
} -cleanup {
    parent destroy
} -result {ok,::context}
test ooUtil-2.4 {TIP 478: callback generation, alternate name} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {a b c} { return ok,[self],$a,$b,$c }
	method makeCall {b} {
	    return [mymethod CallMe 123 $b]
	}
    }
    c create ::context
    set cb [context makeCall "a b c"]
    {*}$cb PQR
} -cleanup {
    parent destroy
} -result {ok,::context,123,a b c,PQR}
test ooUtil-2.5 {TIP 478: callbacks and method lifetime} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method makeCall {b} {
	    return [callback CallMe 123 $b]
	}
    }
    c create ::context
    set cb [context makeCall "a b c"]
    set result [list [catch {{*}$cb PQR} msg] $msg]
    oo::objdefine context {
	method CallMe {a b c} { return ok,[self],$a,$b,$c }
    }
    lappend result [{*}$cb PQR]
} -cleanup {
    parent destroy
} -result {1 {unknown method "CallMe": must be <cloned>, destroy, eval, makeCall, unknown, variable or varname} {ok,::context,123,a b c,PQR}}
test ooUtil-2.6 {TIP 478: callback use case} -setup {
    oo::class create parent
    unset -nocomplain x
} -body {
    oo::class create c {
	superclass parent
	variable count
	constructor {var} {
	    set count 0
	    upvar 1 $var v
	    trace add variable v write [callback TraceCallback]
	}
	method count {} {return $count}
	method TraceCallback {name1 name2 op} {
	    incr count
	}
    }
    set o [c new x]
    for {set x 0} {$x < 5} {incr x} {}
    $o count
} -cleanup {
    unset -nocomplain x
    parent destroy
} -result 6

test ooUtil-3.1 {TIP 478: class initialisation} -setup {
    oo::class create parent
    catch {rename ::foobar-3.1 {}}
} -body {
    oo::class create ::cls {
	superclass parent
	initialise {
	    proc foobar-3.1 {} {return ok}
	}
	method calls {} {
	    list [catch foobar-3.1 msg] $msg \
		[namespace eval [info object namespace [self class]] foobar-3.1]
	}
    }
    [cls new] calls
} -cleanup {
    parent destroy
} -result {1 {invalid command name "foobar-3.1"} ok}
test ooUtil-3.2 {TIP 478: class variables} -setup {
    oo::class create parent
    catch {rename ::foobar-3.1 {}}
} -body {
    oo::class create ::cls {
	superclass parent
	initialise {
	    variable x 123
	}
	method call {} {
	    classvariable x
	    incr x
	}
    }
    cls create a
    cls create b
    cls create c
    list [a call] [b call] [c call] [a call] [b call] [c call]
} -cleanup {
    parent destroy
} -result {124 125 126 127 128 129}
test ooUtil-3.3 {TIP 478: class initialisation} -setup {
    oo::class create parent
    catch {rename ::foobar-3.3 {}}
} -body {
    oo::class create ::cls {
	superclass parent
	initialize {
	    proc foobar-3.3 {} {return ok}
	}
	method calls {} {
	    list [catch foobar-3.3 msg] $msg \
		[namespace eval [info object namespace [self class]] foobar-3.3]
	}
    }
    [cls new] calls
} -cleanup {
    parent destroy
} -result {1 {invalid command name "foobar-3.3"} ok}
test ooUtil-3.4 {TIP 478: class initialisation} -setup {
    oo::class create parent
    catch {rename ::appendToResultVar {}}
    proc ::appendToResultVar args {
	lappend ::result {*}$args
    }
    set result {}
} -body {
    trace add execution oo::define::initialise enter appendToResultVar
    oo::class create ::cls {
	superclass parent
	initialize {proc xyzzy {} {}}
    }
    return $result
} -cleanup {
    catch {
	trace remove execution oo::define::initialise enter appendToResultVar
    }
    rename ::appendToResultVar {}
    parent destroy
} -result {{initialize {proc xyzzy {} {}}} enter}
test ooUtil-3.5 {TIP 478: class initialisation} -body {
    oo::define oo::object {
	::list [::namespace which initialise] [::namespace which initialize] \
	     [::namespace origin initialise] [::namespace origin initialize]
    }
} -result {::oo::define::initialise ::oo::define::initialize ::oo::define::initialise ::oo::define::initialise}

test ooUtil-4.1 {TIP 478: singleton} -setup {
    oo::class create parent
} -body {
    oo::singleton create xyz {
	superclass parent
    }
    set x [xyz new]
    set y [xyz new]
    set z [xyz new]
    set code [catch {$x destroy} msg]
    set p [xyz new]
    lappend code [catch {rename $x ""}]
    set q [xyz new]
    string map [list $x ONE $q TWO] [list {*}$code $x $y $z $p $q [xyz new]]
} -cleanup {
    parent destroy
} -result {1 0 ONE ONE ONE ONE TWO TWO}
test ooUtil-4.2 {TIP 478: singleton errors} -setup {
    oo::class create parent
} -body {
    oo::singleton create xyz {
	superclass parent
    }
    [xyz new] destroy
} -returnCodes error -cleanup {
    parent destroy
} -result {may not destroy a singleton object}
test ooUtil-4.3 {TIP 478: singleton errors} -setup {
    oo::class create parent
} -body {
    oo::singleton create xyz {
	superclass parent
    }
    oo::copy [xyz new]
} -returnCodes error -cleanup {
    parent destroy
} -result {may not clone a singleton object}


test ooUtil-5.1 {TIP 478: abstract} -setup {
    oo::class create parent
} -body {
    oo::abstract create xyz {
	superclass parent
	method foo {} {return 123}
    }
    oo::class create pqr {
	superclass xyz
	method bar {} {return 456}
    }
    set codes [list [catch {xyz new}] [catch {xyz create x}] [catch {xyz createWithNamespace x y}]]
    set x [pqr new]
    set y [pqr create ::y]
    lappend codes [$x foo] [$x bar] $y
} -cleanup {
    parent destroy
} -result {1 1 1 123 456 ::y}

test ooUtil-6.1 {TIP 478: classvarable} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	initialise {
	    variable x 1 y 2
	}
	method a {} {
	    classvariable x
	    incr x
	}
	method b {} {
	    classvariable y
	    incr y
	}
	method c {} {
	    classvariable x y
	    list $x $y
	}
    }
    set p [xyz new]
    set q [xyz new]
    set result [list [$p c] [$q c]]
    $p a
    $q b
    lappend result [[xyz new] c]
} -cleanup {
    parent destroy
} -result {{1 2} {1 2} {2 3}}
test ooUtil-6.2 {TIP 478: classvarable error case} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	method a {} {
	    classvariable x(1)
	    incr x(1)
	}
    }
    set p [xyz new]
    set q [xyz new]
    list [$p a] [$q a]
} -returnCodes error -cleanup {
    parent destroy
} -result {bad variable name "x(1)": can't create a scalar variable that looks like an array element}
test ooUtil-6.3 {TIP 478: classvarable error case} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	method a {} {
	    classvariable ::x
	    incr x
	}
    }
    set p [xyz new]
    set q [xyz new]
    list [$p a] [$q a]
} -returnCodes error -cleanup {
    parent destroy
} -result {bad variable name "::x": can't create a local variable with a namespace separator in it}

test ooUtil-7.1 {TIP 478: link calling pattern} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method foo {} {return "in foo of [self]"}
	method Bar {} {return "in bar of [self]"}
	method Grill {} {return "in grill of [self]"}
	export eval
	constructor {} {
	    link foo
	    link {bar Bar} {grill Grill}
	}
    }
    cls create o
    o eval {list [foo] [bar] [grill]}
} -cleanup {
    parent destroy
} -result {{in foo of ::o} {in bar of ::o} {in grill of ::o}}
test ooUtil-7.2 {TIP 478: link removed when [my] disappears} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method foo {} {return "in foo of [self]"}
	constructor {cmd} {
	    link [list ::$cmd foo]
	}
    }
    cls create o pqr
    list [o foo] [pqr] [rename [info object namespace o]::my {}] [catch pqr msg] $msg
} -cleanup {
    parent destroy
} -result {{in foo of ::o} {in foo of ::o} {} 1 {invalid command name "pqr"}}

# Tests that verify issues detected with the tcllib version of the code
test ooUtil-tcllib-ticket-b3577ed586 {test scoping of delegation in oo::class.Delegate } -setup {
    oo::class create animal {}
    namespace eval ::ooutiltest {
	oo::class create pet { superclass animal }
    }
} -body {
    namespace eval ::ooutiltest {
	oo::class create dog { superclass pet }
    }
} -cleanup {
    namespace delete ooutiltest
    rename animal {}
} -result {::ooutiltest::dog}
test ooUtil-tcllib-ticket-fe7a0e0a3a {classmethod must not interfere with constructor signatures} -setup {
    oo::class create TestClass {
        superclass oo::class
        self method create {name ignore body} {
            next $name $body
        }
    }
} -body {
    TestClass create okay {} {}
} -cleanup {
    rename TestClass {}
} -result {::okay}

cleanupTests
return

# Local Variables:
# fill-column: 78
# mode: tcl
# End:
Changes to tests/platform.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

26
27

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
# The file tests the tcl_platform variable and platform package.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1999 by Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2
package require tcltests

namespace eval ::tcl::test::platform {
    namespace import ::tcltest::testConstraint
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests

    # This is not how [variable] works. See TIP 276.
    #variable ::tcl_platform
    namespace upvar :: tcl_platform tcl_platform

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]


testConstraint testCPUID [llength [info commands testcpuid]]


test platform-1.0 {tcl_platform(engine)} {
  set tcl_platform(engine)
} {Tcl}

test platform-1.1 {TclpSetVariables: tcl_platform} {
    interp create i
    i eval {catch {unset tcl_platform(debug)}}
    i eval {catch {unset tcl_platform(threaded)}}
    set result [i eval {lsort [array names tcl_platform]}]
    interp delete i
    set result
} {byteOrder engine machine os osVersion pathSeparator platform pointerSize user wordSize}

# Test assumes twos-complement arithmetic, which is true of virtually
# everything these days.  Note that this does *not* use wide(), and
# this is intentional since that could make Tcl's numbers wider than
# the machine-integer on some platforms...
test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
    set result [expr {int(1 << (8 * $tcl_platform(wordSize) - 1))}]
    # Result must be the largest bit in a machine word, which this checks
    # without assuming how wide the word really is
    list [expr {$result < 0}] [expr {$result ^ int($result - 1)}]
} {1 -1}

# On Windows/UNIX, test that the CPU ID works

test platform-3.1 {CPU ID on Windows/UNIX} \
    -constraints testCPUID \
    -body {
	set cpudata [testcpuid 0]












<












>


>














<
<
<
<
|
|
<
<
<
|







1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42




43
44



45
46
47
48
49
50
51
52
# The file tests the tcl_platform variable and platform package.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1999 by Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2


namespace eval ::tcl::test::platform {
    namespace import ::tcltest::testConstraint
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests

    # This is not how [variable] works. See TIP 276.
    #variable ::tcl_platform
    namespace upvar :: tcl_platform tcl_platform

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

testConstraint testCPUID [llength [info commands testcpuid]]
testConstraint testlongsize [llength [info commands testlongsize]]

test platform-1.0 {tcl_platform(engine)} {
  set tcl_platform(engine)
} {Tcl}

test platform-1.1 {TclpSetVariables: tcl_platform} {
    interp create i
    i eval {catch {unset tcl_platform(debug)}}
    i eval {catch {unset tcl_platform(threaded)}}
    set result [i eval {lsort [array names tcl_platform]}]
    interp delete i
    set result
} {byteOrder engine machine os osVersion pathSeparator platform pointerSize user wordSize}





test platform-2.1 {tcl_platform(wordSize) indicates size of native word} testlongsize {
    expr {$tcl_platform(wordSize) == [testlongsize]}



} {1}

# On Windows/UNIX, test that the CPU ID works

test platform-3.1 {CPU ID on Windows/UNIX} \
    -constraints testCPUID \
    -body {
	set cpudata [testcpuid 0]
Changes to tests/proc.test.
106
107
108
109
110
111
112








113
114
115
116
117
118
119
} -result {formal parameter "a(1)" is an array element}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
    catch {rename p ""}
} -body {
    proc p {b:a b::a} {
    }
} -returnCodes error -result {formal parameter "b::a" is not a simple name}









test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename p ""}
} -body {
    proc p {} {return "p in [namespace current]"}
    info body p







>
>
>
>
>
>
>
>







106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
} -result {formal parameter "a(1)" is an array element}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
    catch {rename p ""}
} -body {
    proc p {b:a b::a} {
    }
} -returnCodes error -result {formal parameter "b::a" is not a simple name}
test proc-1.9 {Tcl_ProcObjCmd, arguments via canonical list (string-representation bug [631b4c45df])} -body {
    set v 2
    binary scan AB cc a b
    proc p [list [list a $a] [list b $b] [list v [expr {$v + 2}]]] {expr {$a + $b + $v}}
    p
} -result [expr {65+66+4}] -cleanup {
   rename p {}
}

test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename p ""}
} -body {
    proc p {} {return "p in [namespace current]"}
    info body p
379
380
381
382
383
384
385








386
387
388
389
390
391
392
393
394
395
396
    set lambda x
    lappend lambda {set a 1}
    interp create slave
    slave eval [list apply $lambda foo]
    interp delete slave
    unset lambda
} {}









# cleanup
catch {rename p ""}
catch {rename t ""}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:







>
>
>
>
>
>
>
>











387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
    set lambda x
    lappend lambda {set a 1}
    interp create slave
    slave eval [list apply $lambda foo]
    interp delete slave
    unset lambda
} {}

test proc-7.5 {[631b4c45df] Crash in argument processing} {
    binary scan A c val
    proc foo [list  [list from $val]] {}
    rename foo {}
    unset -nocomplain val
} {}


# cleanup
catch {rename p ""}
catch {rename t ""}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:
Changes to tests/safe.test.
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
test safe-3.2 {calling safe::interpCreate on trusted interp} -setup {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    lsort [a aliases]
} -cleanup {
    safe::interpDelete a
} -result {::tcl::file::atime ::tcl::file::attributes ::tcl::file::copy ::tcl::file::delete ::tcl::file::dirname ::tcl::file::executable ::tcl::file::exists ::tcl::file::extension ::tcl::file::isdirectory ::tcl::file::isfile ::tcl::file::link ::tcl::file::lstat ::tcl::file::mkdir ::tcl::file::mtime ::tcl::file::nativename ::tcl::file::normalize ::tcl::file::owned ::tcl::file::readable ::tcl::file::readlink ::tcl::file::rename ::tcl::file::rootname ::tcl::file::size ::tcl::file::stat ::tcl::file::tail ::tcl::file::tempfile ::tcl::file::type ::tcl::file::volumes ::tcl::file::writable ::tcl::info::nameofexecutable clock encoding exit glob load source}
test safe-3.3 {calling safe::interpCreate on trusted interp} -setup {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    interp eval a {source [file join $tcl_library init.tcl]}
} -cleanup {
    safe::interpDelete a







|







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
test safe-3.2 {calling safe::interpCreate on trusted interp} -setup {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    lsort [a aliases]
} -cleanup {
    safe::interpDelete a
} -result {::tcl::encoding::system ::tcl::file::dirname ::tcl::file::extension ::tcl::file::rootname ::tcl::file::tail ::tcl::info::nameofexecutable clock encoding exit file glob load source}
test safe-3.3 {calling safe::interpCreate on trusted interp} -setup {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    interp eval a {source [file join $tcl_library init.tcl]}
} -cleanup {
    safe::interpDelete a
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481

test safe-11.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding option ?arg ...?"}
test safe-11.1a {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding foobar
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -match glob -result {bad option "foobar": must be *}
test safe-11.2 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding system cp775
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding system"}







|






|







460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481

test safe-11.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding subcommand ?arg ...?"}
test safe-11.1a {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding foobar
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -match glob -result {unknown or ambiguous subcommand "foobar": must be *}
test safe-11.2 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding system cp775
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding system"}
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
} -returnCodes ok -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"
    while executing
"encoding convertfrom"
    invoked from within
"::interp invokehidden interp* encoding convertfrom"
    invoked from within
"encoding convertfrom"
    invoked from within
"interp eval $i encoding convertfrom"}
test safe-11.8 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertto







<
<







522
523
524
525
526
527
528


529
530
531
532
533
534
535
} -returnCodes ok -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"
    while executing
"encoding convertfrom"
    invoked from within


"encoding convertfrom"
    invoked from within
"interp eval $i encoding convertfrom"}
test safe-11.8 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertto
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
} -returnCodes ok -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?encoding? data"
    while executing
"encoding convertto"
    invoked from within
"::interp invokehidden interp* encoding convertto"
    invoked from within
"encoding convertto"
    invoked from within
"interp eval $i encoding convertto"}

test safe-12.1 {glob is restricted [Bug 2906841]} -setup {
    set i [safe::interpCreate]
} -body {







<
<







544
545
546
547
548
549
550


551
552
553
554
555
556
557
} -returnCodes ok -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?encoding? data"
    while executing
"encoding convertto"
    invoked from within


"encoding convertto"
    invoked from within
"interp eval $i encoding convertto"}

test safe-12.1 {glob is restricted [Bug 2906841]} -setup {
    set i [safe::interpCreate]
} -body {
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
    interp expose $i file
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
    lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg
} -cleanup {
    unset -nocomplain msg
    interp delete $i
} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}}
test safe-15.1.1 {safe file ensemble does not surprise code} -setup {
    set i [interp create -safe]
} -body {
    set result [expr {"file" in [interp hidden $i]}]
    lappend result [interp eval $i {tcl::file::split a/b/c}]
    lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
    lappend result [interp invokehidden $i file split a/b/c]
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg







|







757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
    interp expose $i file
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
    lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg
} -cleanup {
    unset -nocomplain msg
    interp delete $i
} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}}
test safe-15.2 {safe file ensemble does not surprise code} -setup {
    set i [interp create -safe]
} -body {
    set result [expr {"file" in [interp hidden $i]}]
    lappend result [interp eval $i {tcl::file::split a/b/c}]
    lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
    lappend result [interp invokehidden $i file split a/b/c]
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
Changes to tests/scan.test.
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# procedure that returns the range of integers

proc int_range {} {
    for { set MIN_INT 1 } { int($MIN_INT) > 0 } {} {
	set MIN_INT [expr { $MIN_INT << 1 }]
    }
    set MIN_INT [expr {int($MIN_INT)}]
    set MAX_INT [expr { ~ $MIN_INT }]
    return [list $MIN_INT $MAX_INT]
}

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues







<
|
<
|
<







15
16
17
18
19
20
21

22

23

24
25
26
27
28
29
30
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# procedure that returns the range of integers

proc int_range {} {

    set MAX_INT [expr {[format %u -2]/2}]

    set MIN_INT [expr { ~ $MAX_INT }]

    return [list $MIN_INT $MAX_INT]
}

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
	default {
	    return 0
	}
    }
}

testConstraint ieeeFloatingPoint [testIEEE]
testConstraint wideIs64bit \
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]

test scan-1.1 {BuildCharSet, CharInSet} {
    list [scan foo {%[^o]} x] $x
} {1 f}
test scan-1.2 {BuildCharSet, CharInSet} {
    list [scan \]foo {%[]f]} x] $x
} {1 \]f}







|
<







78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
	default {
	    return 0
	}
    }
}

testConstraint ieeeFloatingPoint [testIEEE]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]


test scan-1.1 {BuildCharSet, CharInSet} {
    list [scan foo {%[^o]} x] $x
} {1 f}
test scan-1.2 {BuildCharSet, CharInSet} {
    list [scan \]foo {%[]f]} x] $x
} {1 \]f}
Changes to tests/set-old.test.
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
    }
    foo
} {1 {"x" isn't an array}}
test set-old-8.6 {array command} {
    catch {unset a}
    set a(22) 3
    list [catch {array gorp a} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
test set-old-8.7 {array command, anymore option} {
    catch {unset a}
    list [catch {array anymore a x} msg] $msg
} {1 {"a" isn't an array}}
test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
    proc foo {x} {
        if {$x==1} {







|







336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
    }
    foo
} {1 {"x" isn't an array}}
test set-old-8.6 {array command} {
    catch {unset a}
    set a(22) 3
    list [catch {array gorp a} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be anymore, default, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
test set-old-8.7 {array command, anymore option} {
    catch {unset a}
    list [catch {array anymore a x} msg] $msg
} {1 {"a" isn't an array}}
test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
    proc foo {x} {
        if {$x==1} {
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
    }}} msg] $msg
} {1 {list must have an even number of elements}}

test set-old-9.1 {ids for array enumeration} {
    catch {unset a}
    set a(a) 1
    list [array star a] [array star a] [array done a s-1-a; array star a] \
	    [array done a s-2-a; array d a s-3-a; array start a]
} {s-1-a s-2-a s-3-a s-1-a}
test set-old-9.2 {array enumeration} {
    catch {unset a}
    set a(a) 1
    set a(b) 1
    set a(c) 1
    set x [array startsearch a]







|







696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
    }}} msg] $msg
} {1 {list must have an even number of elements}}

test set-old-9.1 {ids for array enumeration} {
    catch {unset a}
    set a(a) 1
    list [array star a] [array star a] [array done a s-1-a; array star a] \
	    [array done a s-2-a; array do a s-3-a; array start a]
} {s-1-a s-2-a s-3-a s-1-a}
test set-old-9.2 {array enumeration} {
    catch {unset a}
    set a(a) 1
    set a(b) 1
    set a(c) 1
    set x [array startsearch a]
Changes to tests/string.test.
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
} 1
test string-6.53.$noComp {string is integer, true with whitespace} {
    run {string is integer "  \n1234\v"}
} 1
test string-6.54.$noComp {string is integer, false} {
    list [run {string is integer -fail var 123abc}] $var
} {0 3}
test string-6.55.$noComp {string is integer, false on overflow} {
    list [run {string is integer -fail var +[largest_int]0}] $var
} {0 -1}
test string-6.56.$noComp {string is integer, false} {
    list [run {string is integer -fail var [expr double(1)]}] $var
} {0 1}
test string-6.57.$noComp {string is integer, false} {
    list [run {string is integer -fail var "    "}] $var
} {0 0}
test string-6.58.$noComp {string is integer, false on bad octal} {







|
|
|







670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
} 1
test string-6.53.$noComp {string is integer, true with whitespace} {
    run {string is integer "  \n1234\v"}
} 1
test string-6.54.$noComp {string is integer, false} {
    list [run {string is integer -fail var 123abc}] $var
} {0 3}
test string-6.55.$noComp {string is integer, no overflow possible} {
    run {string is integer +[largest_int]0}
} 1
test string-6.56.$noComp {string is integer, false} {
    list [run {string is integer -fail var [expr double(1)]}] $var
} {0 1}
test string-6.57.$noComp {string is integer, false} {
    list [run {string is integer -fail var "    "}] $var
} {0 0}
test string-6.58.$noComp {string is integer, false on bad octal} {
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
    set result ""
    set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
    foreach num $numbers {
	lappend result [run {string is double -strict $num}]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.92.$noComp {string is integer, 32-bit overflow} {
    # Bug 718878
    set x 0x100000000
    list [run {string is integer -failindex var $x}] $var
} {0 -1}
test string-6.93.$noComp {string is integer, 32-bit overflow} {
    # Bug 718878
    set x 0x100000000
    append x ""
    list [run {string is integer -failindex var $x}] $var
} {0 -1}
test string-6.94.$noComp {string is integer, 32-bit overflow} {
    # Bug 718878
    set x 0x100000000
    list [run {string is integer -failindex var [expr {$x}]}] $var
} {0 -1}
test string-6.95.$noComp {string is wideinteger, true} {
    run {string is wideinteger +1234567890}
} 1
test string-6.96.$noComp {string is wideinteger, true on type} {
    run {string is wideinteger [expr wide(50.0)]}
} 1
test string-6.97.$noComp {string is wideinteger, true} {







|

|
|
|
|

|

|
|
|

|
|
|







803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
    set result ""
    set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
    foreach num $numbers {
	lappend result [run {string is double -strict $num}]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.92.$noComp {string is integer, no 64-bit overflow} {
    # Bug 718878
    set x 0x10000000000000000
    run {string is integer $x}
} 1
test string-6.93.$noComp {string is integer, no 64-bit overflow} {
    # Bug 718878
    set x 0x10000000000000000
    append x ""
    run {string is integer $x}
} 1
test string-6.94.$noComp {string is integer, no 64-bit overflow} {
    # Bug 718878
    set x 0x10000000000000000
    run {string is integer [expr {$x}]}
} 1
test string-6.95.$noComp {string is wideinteger, true} {
    run {string is wideinteger +1234567890}
} 1
test string-6.96.$noComp {string is wideinteger, true on type} {
    run {string is wideinteger [expr wide(50.0)]}
} 1
test string-6.97.$noComp {string is wideinteger, true} {
Changes to tests/thread.test.
1
2
3
4
5
6
7
8
9
10
11
12
13




14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
# Commands covered:  (test)thread
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.






#  when thread::release is used, -wait is passed in order allow the thread to
#  be fully finalized, which avoids valgrind "still reachable" reports.

package require tcltests

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]


# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] ne {}}]


set threadSuperKillScript {













>
>
>
>




<
<


>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21


22
23
24
25
26
27
28
29
30
31
# Commands covered:  (test)thread
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

#  when thread::release is used, -wait is passed in order allow the thread to
#  be fully finalized, which avoids valgrind "still reachable" reports.



::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] ne {}}]


set threadSuperKillScript {
Changes to tests/uplevel.test.
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
} {}
test uplevel-4.15 {level parsing} {
    apply {{} {uplevel [expr 1] {}}}
} {}
test uplevel-4.16 {level parsing} {
    apply {{} {uplevel #[expr 1] {}}}
} {}
test uplevel-4.17 {level parsing} {
    apply {{} {uplevel -0xffffffff {}}}
} {}
test uplevel-4.18 {level parsing} {
    apply {{} {uplevel #-0xffffffff {}}}
} {}
test uplevel-4.19 {level parsing} {
    apply {{} {uplevel [expr -0xffffffff] {}}}
} {}
test uplevel-4.20 {level parsing} {
    apply {{} {uplevel #[expr -0xffffffff] {}}}
} {}
test uplevel-4.21 {level parsing} -body {
    apply {{} {uplevel -1 {}}}
} -returnCodes error -result {invalid command name "-1"}
test uplevel-4.22 {level parsing} -body {
    apply {{} {uplevel #-1 {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.23 {level parsing} -body {
    apply {{} {uplevel [expr -1] {}}}
} -returnCodes error -result {invalid command name "-1"}
test uplevel-4.24 {level parsing} -body {
    apply {{} {uplevel #[expr -1] {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.25 {level parsing} -body {
    apply {{} {uplevel 0xffffffff {}}}
} -returnCodes error -result {bad level "0xffffffff"}
test uplevel-4.26 {level parsing} -body {
    apply {{} {uplevel #0xffffffff {}}}
} -returnCodes error -result {bad level "#0xffffffff"}
test uplevel-4.27 {level parsing} -body {
    apply {{} {uplevel [expr 0xffffffff] {}}}
} -returnCodes error -result {bad level "4294967295"}
test uplevel-4.28 {level parsing} -body {
    apply {{} {uplevel #[expr 0xffffffff] {}}}
} -returnCodes error -result {bad level "#4294967295"}
test uplevel-4.29 {level parsing} -body {
    apply {{} {uplevel 0.2 {}}}
} -returnCodes error -result {bad level "0.2"}
test uplevel-4.30 {level parsing} -body {
    apply {{} {uplevel #0.2 {}}}
} -returnCodes error -result {bad level "#0.2"}
test uplevel-4.31 {level parsing} -body {
    apply {{} {uplevel [expr 0.2] {}}}
} -returnCodes error -result {bad level "0.2"}
test uplevel-4.32 {level parsing} -body {
    apply {{} {uplevel #[expr 0.2] {}}}
} -returnCodes error -result {bad level "#0.2"}
test uplevel-4.33 {level parsing} -body {
    apply {{} {uplevel .2 {}}}
} -returnCodes error -result {invalid command name ".2"}
test uplevel-4.34 {level parsing} -body {
    apply {{} {uplevel #.2 {}}}
} -returnCodes error -result {bad level "#.2"}
test uplevel-4.35 {level parsing} -body {
    apply {{} {uplevel [expr .2] {}}}
} -returnCodes error -result {bad level "0.2"}
test uplevel-4.36 {level parsing} -body {
    apply {{} {uplevel #[expr .2] {}}}
} -returnCodes error -result {bad level "#0.2"}











|

|
|

|
|

|
|

|


|





|

















|





|











|







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
} {}
test uplevel-4.15 {level parsing} {
    apply {{} {uplevel [expr 1] {}}}
} {}
test uplevel-4.16 {level parsing} {
    apply {{} {uplevel #[expr 1] {}}}
} {}
test uplevel-4.17 {level parsing} -returnCodes error -body {
    apply {{} {uplevel -0xffffffff {}}}
} -result {bad level "-0xffffffff"}
test uplevel-4.18 {level parsing} -returnCodes error -body {
    apply {{} {uplevel #-0xffffffff {}}}
} -result {bad level "#-0xffffffff"}
test uplevel-4.19 {level parsing} -returnCodes error -body {
    apply {{} {uplevel [expr -0xffffffff] {}}}
} -result {bad level "-4294967295"}
test uplevel-4.20 {level parsing} -returnCodes error -body {
    apply {{} {uplevel #[expr -0xffffffff] {}}}
} -result {bad level "#-4294967295"}
test uplevel-4.21 {level parsing} -body {
    apply {{} {uplevel -1 {}}}
} -returnCodes error -result {bad level "-1"}
test uplevel-4.22 {level parsing} -body {
    apply {{} {uplevel #-1 {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.23 {level parsing} -body {
    apply {{} {uplevel [expr -1] {}}}
} -returnCodes error -result {bad level "-1"}
test uplevel-4.24 {level parsing} -body {
    apply {{} {uplevel #[expr -1] {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.25 {level parsing} -body {
    apply {{} {uplevel 0xffffffff {}}}
} -returnCodes error -result {bad level "0xffffffff"}
test uplevel-4.26 {level parsing} -body {
    apply {{} {uplevel #0xffffffff {}}}
} -returnCodes error -result {bad level "#0xffffffff"}
test uplevel-4.27 {level parsing} -body {
    apply {{} {uplevel [expr 0xffffffff] {}}}
} -returnCodes error -result {bad level "4294967295"}
test uplevel-4.28 {level parsing} -body {
    apply {{} {uplevel #[expr 0xffffffff] {}}}
} -returnCodes error -result {bad level "#4294967295"}
test uplevel-4.29 {level parsing} -body {
    apply {{} {uplevel 0.2 {}}}
} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.30 {level parsing} -body {
    apply {{} {uplevel #0.2 {}}}
} -returnCodes error -result {bad level "#0.2"}
test uplevel-4.31 {level parsing} -body {
    apply {{} {uplevel [expr 0.2] {}}}
} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.32 {level parsing} -body {
    apply {{} {uplevel #[expr 0.2] {}}}
} -returnCodes error -result {bad level "#0.2"}
test uplevel-4.33 {level parsing} -body {
    apply {{} {uplevel .2 {}}}
} -returnCodes error -result {invalid command name ".2"}
test uplevel-4.34 {level parsing} -body {
    apply {{} {uplevel #.2 {}}}
} -returnCodes error -result {bad level "#.2"}
test uplevel-4.35 {level parsing} -body {
    apply {{} {uplevel [expr .2] {}}}
} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.36 {level parsing} -body {
    apply {{} {uplevel #[expr .2] {}}}
} -returnCodes error -result {bad level "#0.2"}




Changes to tests/util.test.
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
    string index a 0x
} -returnCodes error -match glob -result *
test util-9.31.1 {TclGetIntForIndex} -body {
    string index a 0d
} -returnCodes error -match glob -result *
test util-9.32 {TclGetIntForIndex} -body {
    string index a 0x1FFFFFFFF+0
} -returnCodes error -match glob -result *
test util-9.33 {TclGetIntForIndex} -body {
    string index a 100000000000+0
} -returnCodes error -match glob -result *
test util-9.33.1 {TclGetIntForIndex} -body {
    string index a 0d100000000000+0
} -returnCodes error -match glob -result *
test util-9.34 {TclGetIntForIndex} -body {
    string index a 1.0
} -returnCodes error -match glob -result *
test util-9.35 {TclGetIntForIndex} -body {
    string index a 1e23
} -returnCodes error -match glob -result *
test util-9.36 {TclGetIntForIndex} -body {







|


|


|







609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
    string index a 0x
} -returnCodes error -match glob -result *
test util-9.31.1 {TclGetIntForIndex} -body {
    string index a 0d
} -returnCodes error -match glob -result *
test util-9.32 {TclGetIntForIndex} -body {
    string index a 0x1FFFFFFFF+0
} -result {}
test util-9.33 {TclGetIntForIndex} -body {
    string index a 100000000000+0
} -result {}
test util-9.33.1 {TclGetIntForIndex} -body {
    string index a 0d100000000000+0
} -result {}
test util-9.34 {TclGetIntForIndex} -body {
    string index a 1.0
} -returnCodes error -match glob -result *
test util-9.35 {TclGetIntForIndex} -body {
    string index a 1e23
} -returnCodes error -match glob -result *
test util-9.36 {TclGetIntForIndex} -body {
648
649
650
651
652
653
654
655






656
657
658
659
660
661
662
    string index a 0+1e2
} -returnCodes error -match glob -result *
test util-9.43 {TclGetIntForIndex} -body {
    string index a 0+1.5e1
} -returnCodes error -match glob -result *
test util-9.44 {TclGetIntForIndex} -body {
    string index a 0+1000000000000
} -returnCodes error -match glob -result *







test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
    convertDouble 0x0000000000000000
} {0.0}
test util-10.2 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
    convertDouble 0x8000000000000000
} {-0.0}







|
>
>
>
>
>
>







648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
    string index a 0+1e2
} -returnCodes error -match glob -result *
test util-9.43 {TclGetIntForIndex} -body {
    string index a 0+1.5e1
} -returnCodes error -match glob -result *
test util-9.44 {TclGetIntForIndex} -body {
    string index a 0+1000000000000
} -result {}
test util-9.45 {TclGetIntForIndex} {
    string index abcd end+2305843009213693950
} {}
test util-9.46 {TclGetIntForIndex} {
    string index abcd end+4294967294
} {}

test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
    convertDouble 0x0000000000000000
} {0.0}
test util-10.2 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
    convertDouble 0x8000000000000000
} {-0.0}
Changes to tests/var.test.
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
} -result 0
test var-22.2 {leak in parsedVarName} -constraints memory -body {
    set i 0
    leaktest {lappend x($i)}
} -cleanup {
    unset -nocomplain i x
} -result 0

unset -nocomplain a k v
test var-23.1 {array command, for loop, too many args} -returnCodes error -body {
    array for {k v} c d e {}
} -result {wrong # args: should be "array for {key value} arrayName script"}
test var-23.2 {array command, for loop, not enough args} -returnCodes error -body {
    array for {k v} {}
} -result {wrong # args: should be "array for {key value} arrayName script"}







|







1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
} -result 0
test var-22.2 {leak in parsedVarName} -constraints memory -body {
    set i 0
    leaktest {lappend x($i)}
} -cleanup {
    unset -nocomplain i x
} -result 0

unset -nocomplain a k v
test var-23.1 {array command, for loop, too many args} -returnCodes error -body {
    array for {k v} c d e {}
} -result {wrong # args: should be "array for {key value} arrayName script"}
test var-23.2 {array command, for loop, not enough args} -returnCodes error -body {
    array for {k v} {}
} -result {wrong # args: should be "array for {key value} arrayName script"}
1199
1200
1201
1202
1203
1204
1205































































































































































































































































1206
1207
1208
1209
1210
1211
1212
    unset -nocomplain $vn
} -body {
    array set $vn {a 1 b 2 c 3}
    array for $vn $vn {}
} -cleanup {
    unset -nocomplain $vn vn
} -result {}
































































































































































































































































catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename getbytes ""}
catch {rename p ""}







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
    unset -nocomplain $vn
} -body {
    array set $vn {a 1 b 2 c 3}
    array for $vn $vn {}
} -cleanup {
    unset -nocomplain $vn vn
} -result {}

test var-24.1 {array default set and get: interpreted} -setup {
    unset -nocomplain ary
} -body {
    array set ary {a 3}
    array default set ary 7
    list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
	[array default get ary]
} -cleanup {
    unset -nocomplain ary
} -result {3 7 1 0 7}
test var-24.2 {array default set and get: compiled} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
	    [array default get ary]
    }}
} {3 7 1 0 7}
test var-24.3 {array default unset: interpreted} -setup {
    unset -nocomplain ary
} -body {
    array set ary {a 3}
    array default set ary 7
    list $ary(a) $ary(b) [array default unset ary] $ary(a) [catch {set ary(b)}]
} -cleanup {
    unset -nocomplain ary
} -result {3 7 {} 3 1}
test var-24.4 {array default unset: compiled} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	list $ary(a) $ary(b) [array default unset ary] $ary(a) \
	    [catch {set ary(b)}]
    }}
} {3 7 {} 3 1}
test var-24.5 {array default exists: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array set ary {a 3}
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default set ary 7
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default unset ary
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    unset ary
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default set ary 11
    lappend result [info exists ary],[array exists ary],[array default exists ary]
} -cleanup {
    unset -nocomplain ary result
} -result {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
test var-24.6 {array default exists: compiled} {
    apply {{} {
	array set ary {a 3}
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default set ary 7
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default unset ary
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	unset ary
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default set ary 11
	lappend result [info exists ary],[array exists ary],[array default exists ary]
    }}
} {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
test var-24.7 {array default and append: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary grill
    lappend result [array size ary] [info exist ary(x)]
    append ary(x) abc
    lappend result [array size ary] $ary(x)
    array default unset ary
    append ary(x) def
    append ary(y) ghi
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 grillabc 2 grillabcdef ghi}
test var-24.8 {array default and append: compiled} {
    apply {{} {
	array default set ary grill
	lappend result [array size ary] [info exist ary(x)]
	append ary(x) abc
	lappend result [array size ary] $ary(x)
	array default unset ary
	append ary(x) def
	append ary(y) ghi
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 grillabc 2 grillabcdef ghi}
test var-24.9 {array default and lappend: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary grill
    lappend result [array size ary] [info exist ary(x)]
    lappend ary(x) abc
    lappend result [array size ary] $ary(x)
    array default unset ary
    lappend ary(x) def
    lappend ary(y) ghi
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 {grill abc} 2 {grill abc def} ghi}
test var-24.10 {array default and lappend: compiled} {
    apply {{} {
	array default set ary grill
	lappend result [array size ary] [info exist ary(x)]
	lappend ary(x) abc
	lappend result [array size ary] $ary(x)
	array default unset ary
	lappend ary(x) def
	lappend ary(y) ghi
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 {grill abc} 2 {grill abc def} ghi}
test var-24.11 {array default and incr: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary 7
    lappend result [array size ary] [info exist ary(x)]
    incr ary(x) 11
    lappend result [array size ary] $ary(x)
    array default unset ary
    incr ary(x)
    incr ary(y)
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 18 2 19 1}
test var-24.12 {array default and incr: compiled} {
    apply {{} {
	array default set ary 7
	lappend result [array size ary] [info exist ary(x)]
	incr ary(x) 11
	lappend result [array size ary] $ary(x)
	array default unset ary
	incr ary(x)
	incr ary(y)
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 18 2 19 1}
test var-24.13 {array default and dict: interpreted} -setup {
    unset -nocomplain ary x y z
} -body {
    array default set ary {x y}
    dict lappend ary(p) x z
    dict update ary(q) x y {
	set y z
    }
    dict with ary(r) {
	set x 123
    }
    lsort -stride 2 -index 0 [array get ary]
} -cleanup {
    unset -nocomplain ary x y z
} -result {p {x {y z}} q {x z} r {x 123}}
test var-24.14 {array default and dict: compiled} {
    lsort -stride 2 -index 0 [apply {{} {
	array default set ary {x y}
	dict lappend ary(p) x z
	dict update ary(q) x y {
	    set y z
	}
	dict with ary(r) {
	    set x 123
	}
	array get ary
    }}]
} {p {x {y z}} q {x z} r {x 123}}
test var-24.15 {array default set and get: two-level} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	apply {{} {
	    upvar 1 ary ary ary(c) c
	    lappend result $ary(a) $ary(b) $c
	    lappend result [info exist ary(a)] [info exist ary(b)] [info exist c]
	    lappend result [array default get ary]
	}}
    }}
} {3 7 7 1 0 0 7}
test var-24.16 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default set ary 7
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {can't array default set "ary": variable isn't array}
test var-24.17 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    array default set ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.18 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    array default set ary x y
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.19 {array default get: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default get ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.20 {array default get: errors} -setup {
    unset -nocomplain ary
} -body {
    array default get ary x y
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.21 {array default exists: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default exists ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.22 {array default exists: errors} -setup {
    unset -nocomplain ary
} -body {
    array default exists ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.23 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default unset ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.24 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    array default unset ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob

catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename getbytes ""}
catch {rename p ""}
Changes to tests/winFCmd.test.
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
	if {$x != ""} {
	    catch {file delete -force -- {*}$x}
	}
    }
}

if {[testConstraint win]} {
    set major [string index $tcl_platform(osVersion) 0]
    if {$major > 5} {
	testConstraint winVista 1
    } elseif {$major == 5} {
	testConstraint winXP 1
    }
}

# find a CD-ROM so we can test read-only filesystems.

proc findfile {dir} {







|
<

|







52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
67
68
	if {$x != ""} {
	    catch {file delete -force -- {*}$x}
	}
    }
}

if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) >= 5.0} {

	testConstraint winVista 1
    } else {
	testConstraint winXP 1
    }
}

# find a CD-ROM so we can test read-only filesystems.

proc findfile {dir} {
Changes to tests/winPipe.test.
26
27
28
29
30
31
32

33
34
35
36
37
38
39
set cat32 [file join $bindir cat32.exe]

testConstraint exec         [llength [info commands exec]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole  [expr {![testConstraint AllocConsole]}]
testConstraint testexcept   [llength [info commands testexcept]]



set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
append big $big
append big $big
append big $big







>







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
set cat32 [file join $bindir cat32.exe]

testConstraint exec         [llength [info commands exec]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole  [expr {![testConstraint AllocConsole]}]
testConstraint testexcept   [llength [info commands testexcept]]
testConstraint slowTest     0


set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
append big $big
append big $big
append big $big
304
305
306
307
308
309
310



311
312
313










































314
315
316
317
318
319
320
    puts -nonewline $f $big$big$big$big
    flush $f
    after 100 { lappend x timeout }
    vwait x
    lappend x [catch {close $f} msg] $msg
} {writable timeout 0 {}}




set path(echoArgs.tcl) [makeFile {
    puts "[list $argv0 $argv]"
} echoArgs.tcl]











































### validate the raw output of BuildCommandLine().
###
test winpipe-7.1 {BuildCommandLine: null arguments} {win exec} {
    exec $env(COMSPEC) /c echo foo "" bar
} {foo "" bar}
test winpipe-7.2 {BuildCommandLine: null arguments} {win exec} {







>
>
>
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
    puts -nonewline $f $big$big$big$big
    flush $f
    after 100 { lappend x timeout }
    vwait x
    lappend x [catch {close $f} msg] $msg
} {writable timeout 0 {}}

proc _testExecArgs {single args} {
    variable path
    if {![info exists path(echoArgs.tcl)] || ![file exists $path(echoArgs.tcl)]} {
	set path(echoArgs.tcl) [makeFile {
	    puts "[list [file tail $argv0] {*}$argv]"
	} echoArgs.tcl]
    }
    if {![info exists path(echoArgs.bat)] || ![file exists $path(echoArgs.bat)]} {
	set path(echoArgs.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" "echoArgs.bat"]
    }
    set cmds [list [list [interpreter] $path(echoArgs.tcl)]]
    if {!($single & 2)} {
	lappend cmds [list $path(echoArgs.bat)]
    } else {
	if {![info exists path(echoArgs2.bat)] || ![file exists $path(echoArgs2.bat)]} {
	    set path(echoArgs2.bat) [makeFile \
		"@[file native [interpreter]] $path(echoArgs.tcl) %*" \
		"echo(Cmd)Test Args & Batch.bat" [makeDirectory test(Dir)Check]]
	}
	lappend cmds [list $path(echoArgs2.bat)]
    }
    set broken {}
    foreach args $args {
	if {$single & 1} {
	    # enclose single test-arg between 1st/3rd to be sure nothing is truncated
	    # (e. g. to cover unexpected trim by nts-zero case, and args don't recombined):
	    set args [list "1st" $args "3rd"]
	}
	set args [list {*}$args]; # normalized canonical list
	foreach cmd $cmds {
	    set e [linsert $args 0 [file tail $path(echoArgs.tcl)]]
	    tcltest::DebugPuts 4 "  ## test exec [file extension [lindex $cmd 0]] ($cmd) for\n  ##   $args"
	    if {[catch {
		exec {*}$cmd {*}$args
	    } r]} {
		set r "ERROR: $r"
	    }
	    if {$r ne $e} {
		append broken "\[ERROR\]: exec [file extension [lindex $cmd 0]] on $args\n  -- result:\n$r\n  -- expected:\n$e\n"
	    }
	    if {$single & 8} {
		# if test exe only:
		break
	    }
	}
    }
    return $broken
}

### validate the raw output of BuildCommandLine().
###
test winpipe-7.1 {BuildCommandLine: null arguments} {win exec} {
    exec $env(COMSPEC) /c echo foo "" bar
} {foo "" bar}
test winpipe-7.2 {BuildCommandLine: null arguments} {win exec} {
364
365
366
367
368
369
370


































































371
372
373
374


375
376
377
378
379
380
381
382
383

384











385
386
387


388
389
390
391
392
393
394
395
396


397
398

399





400
401




402
403
404
405
406
407

408











409
410

411



412
413
414
415
416
417
418
419
420

421
422



423





424
425
426

427

428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448


449
450
451
452
453
454
} {foo "\ \\\\\\\"" bar}
test winpipe-7.17 {BuildCommandLine: special chars #4} {win exec} {
    exec $env(COMSPEC) /c echo foo \{ bar
} "foo \{ bar"
test winpipe-7.18 {BuildCommandLine: special chars #5} {win exec} {
    exec $env(COMSPEC) /c echo foo \} bar
} "foo \} bar"



































































### validate the pass-thru from BuildCommandLine() to the crt's parse_cmdline().
###
test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {win exec} {


    exec [interpreter] $path(echoArgs.tcl) foo "" bar
} [list $path(echoArgs.tcl) [list foo {} bar]]
test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo {} bar
} [list $path(echoArgs.tcl) [list foo {} bar]]
test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #1} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo "\"" bar
} [list $path(echoArgs.tcl) [list foo "\"" bar]]
test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #2} {win exec} {

    exec [interpreter] $path(echoArgs.tcl) foo {""} bar











} [list $path(echoArgs.tcl) [list foo {""} bar]]
test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #3} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo "\" " bar


} [list $path(echoArgs.tcl) [list foo "\" " bar]]
test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #4} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo {a="b"} bar
} [list $path(echoArgs.tcl) [list foo {a="b"} bar]]
test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #5} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo {a = "b"} bar
} [list $path(echoArgs.tcl) [list foo {a = "b"} bar]]
test winpipe-8.8 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #6} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}


} [list $path(echoArgs.tcl) [list {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}]]
test winpipe-8.9 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #1} {win exec} {

    exec [interpreter] $path(echoArgs.tcl) foo \\ bar





} [list $path(echoArgs.tcl) [list foo \\ bar]]
test winpipe-8.10 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #2} {win exec} {




    exec [interpreter] $path(echoArgs.tcl) foo \\\\ bar
} [list $path(echoArgs.tcl) [list foo \\\\ bar]]
test winpipe-8.11 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #3} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\ bar
} [list $path(echoArgs.tcl) [list foo \\\ \\ bar]]
test winpipe-8.12 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #4} {win exec} {

    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\ bar











} [list $path(echoArgs.tcl) [list foo \\\ \\\\ bar]]
test winpipe-8.13 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #5} {win exec} {

    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\ bar



} [list $path(echoArgs.tcl) [list foo \\\ \\\\\\ bar]]
test winpipe-8.14 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #6} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\" bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\" bar]]
test winpipe-8.15 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #7} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\" bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\\\" bar]]
test winpipe-8.16 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #8} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\\" bar

} [list $path(echoArgs.tcl) [list foo \\\ \\\\\\\" bar]]
test winpipe-8.17 {BuildCommandLine/parse_cmdline pass-thru: special chars #1} {win exec} {



    exec [interpreter] $path(echoArgs.tcl) foo \{ bar





} [list $path(echoArgs.tcl) [list foo \{ bar]]
test winpipe-8.18 {BuildCommandLine/parse_cmdline pass-thru: special chars #2} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \} bar

} [list $path(echoArgs.tcl) [list foo \} bar]]

test winpipe-8.19 {ensure parse_cmdline isn't doing wildcard replacement} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo * makefile.?c bar
} [list $path(echoArgs.tcl) [list foo * makefile.?c bar]]

# restore old values for env(TMP) and env(TEMP)

if {[catch {set env(TMP) $env_tmp}]} {
    unset env(TMP)
}
if {[catch {set env(TEMP) $env_temp}]} {
    unset env(TEMP)
}

# cleanup
removeFile little
removeFile big
removeFile more
removeFile stdout
removeFile stderr
removeFile nothing
removeFile echoArgs.tcl


::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



|
>
>
|
|
<
|
|
<
|
|
|
>
|
>
>
>
>
>
>
>
>
>
>
>
|
|
|
>
>
|
|
<
<
|
|
|
|
|
>
>
|
|
>
|
>
>
>
>
>
|
|
>
>
>
>
|
|
|
|
|
<
>
|
>
>
>
>
>
>
>
>
>
>
>
|
<
>
|
>
>
>
|
<
<
|
|
|
|
|
|
>
|
|
>
>
>
|
>
>
>
>
>
|
|
|
>
|
>
|
|
|

















|
>
>






410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490

491
492

493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515


516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542

543
544
545
546
547
548
549
550
551
552
553
554
555
556

557
558
559
560
561
562


563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
} {foo "\ \\\\\\\"" bar}
test winpipe-7.17 {BuildCommandLine: special chars #4} {win exec} {
    exec $env(COMSPEC) /c echo foo \{ bar
} "foo \{ bar"
test winpipe-7.18 {BuildCommandLine: special chars #5} {win exec} {
    exec $env(COMSPEC) /c echo foo \} bar
} "foo \} bar"

set injectList {
    {test"whoami}     {test""whoami}
    {test"""whoami}   {test""""whoami}

    "test\"whoami\\"     "test\"\"whoami\\"
    "test\"\"\"whoami\\" "test\"\"\"\"whoami\\"

    {test\\&\\test}    {test"\\&\\test}
    {"test\\&\\test}   {"test"\\&\\"test"}
    {test\\"&"\\test}  {test"\\"&"\\test}
    {"test\\"&"\\test} {"test"\\"&"\\"test"}

    {test\"&whoami}    {test"\"&whoami}
    {test""\"&whoami}  {test"""\"&whoami}
    {test\"\&whoami}   {test"\"\&whoami}
    {test""\"\&whoami} {test"""\"\&whoami}

    {test&whoami}    {test|whoami}
    {"test&whoami}   {"test|whoami}
    {test"&whoami}   {test"|whoami}
    {"test"&whoami}  {"test"|whoami}
    {""test"&whoami} {""test"|whoami}

    {test&echo "}    {test|echo "}
    {"test&echo "}   {"test|echo "}
    {test"&echo "}   {test"|echo "}
    {"test"&echo "}  {"test"|echo "}
    {""test"&echo "} {""test"|echo "}

    {test&echo ""}    {test|echo ""}
    {"test&echo ""}   {"test|echo ""}
    {test"&echo ""}   {test"|echo ""}
    {"test"&echo ""}  {"test"|echo ""}
    {""test"&echo ""} {""test"|echo ""}

    {test>whoami}    {test<whoami}
    {"test>whoami}   {"test<whoami}
    {test">whoami}   {test"<whoami}
    {"test">whoami}  {"test"<whoami}
    {""test">whoami} {""test"<whoami}
    {test(whoami)}   {test(whoami)}
    {test"(whoami)}  {test"(whoami)}
    {test^whoami}    {test^^echo ^^^}
    {test"^whoami}   {test"^^echo ^^^}
    {test"^echo ^^^"} {test""^echo" ^^^"}

    {test%USERDOMAIN%\%USERNAME%}
    {test" %USERDOMAIN%\%USERNAME%}
    {test%USERDOMAIN%\\%USERNAME%}
    {test" %USERDOMAIN%\\%USERNAME%}
    {test%USERDOMAIN%&%USERNAME%}
    {test" %USERDOMAIN%&%USERNAME%}
    {test%USERDOMAIN%\&\%USERNAME%}
    {test" %USERDOMAIN%\&\%USERNAME%}

    {test%USERDOMAIN%\&\test}
    {test" %USERDOMAIN%\&\test}
    {test%USERDOMAIN%\\&\\test}
    {test" %USERDOMAIN%\\&\\test}

    {test%USERDOMAIN%\&\"test}
    {test" %USERDOMAIN%\&\"test}
    {test%USERDOMAIN%\\&\\"test}
    {test" %USERDOMAIN%\\&\\"test}
}

### validate the pass-thru from BuildCommandLine() to the crt's parse_cmdline().
###
test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: dumped arguments are equal original} \
-constraints {win exec} -body {
    _testExecArgs 0 \
	[list foo "" bar] \
	[list foo {} bar] \

	[list foo "\"" bar] \
	[list foo {""} bar] \

	[list foo "\" " bar] \
	[list foo {a="b"} bar] \
	[list foo {a = "b"} bar] \
	[list {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}] \
	[list foo \\ bar] \
	[list foo \\\\ bar] \
	[list foo \\\ \\ bar] \
	[list foo \\\ \\\\ bar] \
	[list foo \\\ \\\\\\ bar] \
	[list foo \\\ \\\" bar] \
	[list foo \\\ \\\\\" bar] \
	[list foo \\\ \\\\\\\" bar] \
	[list foo \{ bar] \
	[list foo \} bar] \
	[list foo * makefile.?c bar]
} -result {}

test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (particular)} \
-constraints {win exec slowTest} -body {
    _testExecArgs 1 {*}$injectList
} -result {}

test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (jointly)} \


-constraints {win exec} -body {
    _testExecArgs 0 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (command/jointly args)} \
-constraints {win exec} -body {
    _testExecArgs 2 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (random mix)} \
-constraints {win exec} -body {
    set lst {}
    set maps {
	{\&|^<>!()%}
	{\&|^<>!()% }
	{"\&|^<>!()%}
	{"\&|^<>!()% }
	{"""""\\\\\&|^<>!()%}
	{"""""\\\\\&|^<>!()% }

    }
    set i 0
    time {
	set args {[incr i].}
	time {
	    set map [lindex $maps [expr {int(rand()*[llength $maps])}]]
	    # be sure arg has some prefix (avoid special handling, like |& etc)
	    set a {x}
	    while {[string length $a] < 50} {
		append a [string index $map [expr {int(rand()*[string length $map])}]]
	    }
	    lappend args $a
	} 20
	lappend lst $args

    } 10
    _testExecArgs 0 {*}$lst
} -result {} -cleanup {
    unset -nocomplain lst args a map maps
}



set injectList {
    "test\"\nwhoami"     "test\"\"\nwhoami"
    "test\"\"\"\nwhoami" "test\"\"\"\"\nwhoami"
    "test;\n&echo \""    "\"test;\n&echo \""
    "test\";\n&echo \""  "\"test\";\n&echo \""
    "\"\"test\";\n&echo \""
}

test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args} \
-constraints {win exec} -body {
    # test exe only, because currently there is no proper way to escape a new-line char resp.
    # to supply a new-line to the batch-files within arguments (command line is truncated).
    _testExecArgs 8 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args (batch)} \
-constraints {win exec knownBug} -body {
    # this will fail if executed batch-file, because currently there is no proper way to escape a new-line char.
    _testExecArgs 0 $injectList
} -result {}


rename _testExecArgs {}

# restore old values for env(TMP) and env(TEMP)

if {[catch {set env(TMP) $env_tmp}]} {
    unset env(TMP)
}
if {[catch {set env(TEMP) $env_temp}]} {
    unset env(TEMP)
}

# cleanup
removeFile little
removeFile big
removeFile more
removeFile stdout
removeFile stderr
removeFile nothing
if {[info exists path(echoArgs.tcl)]} { removeFile echoArgs.tcl }
if {[info exists path(echoArgs.bat)]} { removeFile echoArgs.bat }
if {[info exists path(echoArgs2.bat)]} { removeDirectory test(Dir)Check }
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:
Added tests/zipfs.test.
























































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
# The file tests the tclZlib.c file.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

testConstraint zipfs [expr {
    [llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]
}]
testConstraint zipfslib 1

# Removed in tip430 - zipfs is no longer a static package
#test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
#    load {} zipfs
#} -result {}

set ziproot [zipfs root]
set CWD [pwd]
set tmpdir  [file join $CWD tmp]
file mkdir $tmpdir

test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
    package require zipfs
} -result {2.0}
test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
    expr {${ziproot} in [file volumes]}
} -result 1

if {![string match ${ziproot}* $tcl_library]} {
    ###
    # "make test" does not map tcl_library from the dynamic library on Unix
    #
    # Hack the environment to pretend we did pull tcl_library from a zip
    # archive
    ###
    set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]]
    testConstraint zipfslib [file exists $tclzip]
    if {[testConstraint zipfslib]} {
        zipfs mount /lib/tcl $tclzip
        set ::tcl_library ${ziproot}lib/tcl/tcl_library
    }
}

test zipfs-0.2 {zipfs basics} -constraints zipfslib -body {
    string match ${ziproot}* $tcl_library
} -result 1
test zipfs-0.3 {zipfs basics: glob} -constraints zipfslib -setup {
    set pwd [pwd]
} -body {
    cd $tcl_library
    lsort [glob -dir . http*]
} -cleanup {
    cd $pwd
} -result {./http}
test zipfs-0.4 {zipfs basics: glob} -constraints zipfslib -setup {
    set pwd [pwd]
} -body {
    cd $tcl_library
    lsort [glob -dir [pwd] http*]
} -cleanup {
    cd $pwd
} -result [list $tcl_library/http]
test zipfs-0.5 {zipfs basics: glob} -constraints zipfslib -body {
    lsort [glob -dir $tcl_library http*]
} -result [list $tcl_library/http]
test zipfs-0.6 {zipfs basics: glob} -constraints zipfslib -body {
    lsort [glob $tcl_library/http*]
} -result [list $tcl_library/http]
test zipfs-0.7 {zipfs basics: glob} -constraints zipfslib -body {
    lsort [glob -tails -dir $tcl_library http*]
} -result {http}
test zipfs-0.8 {zipfs basics: glob} -constraints zipfslib -body {
    lsort [glob -nocomplain -tails -types d -dir $tcl_library http*]
} -result {http}
test zipfs-0.9 {zipfs basics: glob} -constraints zipfslib -body {
    lsort [glob -nocomplain -tails -types f -dir $tcl_library http*]
} -result {}
test zipfs-0.10 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
    file join [zipfs root] bar baz
} -result "[zipfs root]bar/baz"
test zipfs-0.11 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
    file normalize [zipfs root]
} -result "[zipfs root]"
test zipfs-0.12 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
    file normalize [zipfs root]//bar/baz//qux/../
} -result "[zipfs root]bar/baz"

test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mount a b c d e f
} -result {wrong # args: should be "zipfs mount ?mountpoint? ?zipfile? ?password?"}
test zipfs-1.4 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs unmount a b c d e f
} -result {wrong # args: should be "zipfs unmount zipfile"}
test zipfs-1.5 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkkey a b c d e f
} -result {wrong # args: should be "zipfs mkkey password"}
test zipfs-1.6 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkimg a b c d e f
} -result {wrong # args: should be "zipfs mkimg outfile indir ?strip? ?password? ?infile?"}
test zipfs-1.7 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkzip a b c d e f
} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}
test zipfs-1.8 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs exists a b c d e f
} -result {wrong # args: should be "zipfs exists filename"}
test zipfs-1.9 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs info a b c d e f
} -result {wrong # args: should be "zipfs info filename"}
test zipfs-1.10 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs list a b c d e f
} -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"}

file mkdir tmp
test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body {
    zipfs mkzip [file join $tmpdir empty.zip] $tcl_library/xxxx
} -result {empty archive}
###
# The next series of tests operate within a zipfile created a temporary
# directory.
###
set zipfile [file join $tmpdir abc.zip]
if {[file exists $zipfile]} {
   file delete $zipfile
}
test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body {
    cd $tcl_library/encoding
    zipfs mkzip $zipfile .
    zipfs mount ${ziproot}abc $zipfile
    zipfs list -glob ${ziproot}abc/cp850.*
} -cleanup {
    cd $CWD
} -result "[zipfs root]abc/cp850.enc"
testConstraint zipfsenc [zipfs exists /abc/cp850.enc]
test zipfs-2.3 {zipfs info} -constraints {zipfs zipfsenc} -body {
    set r [zipfs info ${ziproot}abc/cp850.enc]
    lrange $r 0 2
} -result [list $zipfile 1090 527] ;# NOTE: Only the first 3 results are stable
test zipfs-2.4 {zipfs data} -constraints {zipfs zipfsenc} -body {
    set zipfd [open ${ziproot}/abc/cp850.enc]	;# FIXME: leave open - see later test
    read $zipfd
} -result {# Encoding file: cp850, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
2591259225932502252400C100C200C000A9256325512557255D00A200A52510
25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
} ;# FIXME: result depends on content of encodings dir
test zipfs-2.5 {zipfs exists} -constraints {zipfs zipfsenc} -body {
    zipfs exists /abc/cp850.enc
} -result 1
test zipfs-2.6 {zipfs unmount while busy} -constraints {zipfs zipfsenc} -body {
    zipfs unmount /abc
} -returnCodes error -result {filesystem is busy}
test zipfs-2.7 {zipfs unmount} -constraints {zipfs zipfsenc} -body {
    close $zipfd
    zipfs unmount /abc
    zipfs exists /abc/cp850.enc
} -result 0
###
# Repeat the tests for a buffer mounted archive
###
test zipfs-2.8 {zipfs mkzip} -constraints zipfs -body {
    cd $tcl_library/encoding
    zipfs mkzip $zipfile .
    set fin [open $zipfile r]
    fconfigure $fin -translation binary
    set dat [read $fin]
    close $fin
    zipfs mount_data def $dat
    zipfs list -glob ${ziproot}def/cp850.*
} -cleanup {
    cd $CWD
} -result "[zipfs root]def/cp850.enc"
testConstraint zipfsencbuf [zipfs exists /def/cp850.enc]
test zipfs-2.9 {zipfs info} -constraints {zipfs zipfsencbuf} -body {
    set r [zipfs info ${ziproot}def/cp850.enc]
    lrange $r 0 2
} -result [list {Memory Buffer} 1090 527] ;# NOTE: Only the first 3 results are stable
test zipfs-2.10 {zipfs data} -constraints {zipfs zipfsencbuf} -body {
    set zipfd [open ${ziproot}/def/cp850.enc]	;# FIXME: leave open - see later test
    read $zipfd
} -result {# Encoding file: cp850, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
2591259225932502252400C100C200C000A9256325512557255D00A200A52510
25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
} ;# FIXME: result depends on content of encodings dir
test zipfs-2.11 {zipfs exists} -constraints {zipfs zipfsencbuf} -body {
    zipfs exists /def/cp850.enc
} -result 1
test zipfs-2.12 {zipfs unmount while busy} -constraints {zipfs zipfsencbuf} -body {
    zipfs unmount /def
} -returnCodes error -result {filesystem is busy}
test zipfs-2.13 {zipfs unmount} -constraints {zipfs zipfsencbuf} -body {
    close $zipfd
    zipfs unmount /def
    zipfs exists /def/cp850.enc
} -result 0

catch {file delete -force $tmpdir}

test zipfs-3.1 {zipfs in child interpreters} -constraints zipfs -setup {
    set interp [interp create]
} -body {
    interp eval $interp {
	zipfs ?
    }
} -returnCodes error -cleanup {
    interp delete $interp
} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount}
test zipfs-3.2 {zipfs in child interpreters} -constraints zipfs -setup {
    set interp [interp create]
} -body {
    interp eval $interp {
	zipfs mkzip
    }
} -returnCodes error -cleanup {
    interp delete $interp
} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}
test zipfs-3.3 {zipfs in child interpreters} -constraints zipfs -setup {
    set safe [interp create -safe]
} -body {
    interp eval $safe {
	zipfs ?
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount}
test zipfs-3.4 {zipfs in child interpreters} -constraints zipfs -setup {
    set safe [interp create -safe]
} -body {
    interp eval $safe {
	zipfs mkzip
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand mkzip of zipfs}

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:
Changes to tools/genStubs.tcl.
194
195
196
197
198
199
200







201
202
203
204
205
206
207
    if {([lindex $platformList 0] eq "deprecated")} {
	set stubs($curName,deprecated,$index) [lindex $platformList 1]
	set stubs($curName,generic,$index) $decl
	if {![info exists stubs($curName,generic,lastNum)] \
		|| ($index > $stubs($curName,generic,lastNum))} {
	    set stubs($curName,generic,lastNum) $index
	}







    } else {
	foreach platform $platformList {
	    if {$decl ne ""} {
		set stubs($curName,$platform,$index) $decl
		    if {![info exists stubs($curName,$platform,lastNum)] \
			    || ($index > $stubs($curName,$platform,lastNum))} {
			set stubs($curName,$platform,lastNum) $index







>
>
>
>
>
>
>







194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
    if {([lindex $platformList 0] eq "deprecated")} {
	set stubs($curName,deprecated,$index) [lindex $platformList 1]
	set stubs($curName,generic,$index) $decl
	if {![info exists stubs($curName,generic,lastNum)] \
		|| ($index > $stubs($curName,generic,lastNum))} {
	    set stubs($curName,generic,lastNum) $index
	}
    } elseif {([lindex $platformList 0] eq "nostub")} {
	set stubs($curName,nostub,$index) [lindex $platformList 1]
	set stubs($curName,generic,$index) $decl
	if {![info exists stubs($curName,generic,lastNum)] \
		|| ($index > $stubs($curName,generic,lastNum))} {
	    set stubs($curName,generic,lastNum) $index
	}
    } else {
	foreach platform $platformList {
	    if {$decl ne ""} {
		set stubs($curName,$platform,$index) $decl
		    if {![info exists stubs($curName,$platform,lastNum)] \
			    || ($index > $stubs($curName,$platform,lastNum))} {
			set stubs($curName,$platform,lastNum) $index
589
590
591
592
593
594
595


596
597
598
599
600
601
602

    set lfname [string tolower [string index $fname 0]]
    append lfname [string range $fname 1 end]

    set text "    "
    if {[info exists stubs($name,deprecated,$index)]} {
	append text "TCL_DEPRECATED_API(\"$stubs($name,deprecated,$index)\") "


    }
    if {$args eq ""} {
	append text $rtype " *" $lfname "; /* $index */\n"
	return $text
    }
    if {[string range $rtype end-8 end] eq "__stdcall"} {
	append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "







>
>







596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611

    set lfname [string tolower [string index $fname 0]]
    append lfname [string range $fname 1 end]

    set text "    "
    if {[info exists stubs($name,deprecated,$index)]} {
	append text "TCL_DEPRECATED_API(\"$stubs($name,deprecated,$index)\") "
    } elseif {[info exists stubs($name,nostub,$index)]} {
	append text "TCL_DEPRECATED_API(\"$stubs($name,nostub,$index)\") "
    }
    if {$args eq ""} {
	append text $rtype " *" $lfname "; /* $index */\n"
	return $text
    }
    if {[string range $rtype end-8 end] eq "__stdcall"} {
	append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
701
702
703
704
705
706
707



708
709
710
711
712
713
714
	}
	for {set i 0} {$i <= $lastNum} {incr i} {
	    set slots [array names stubs $name,*,$i]
	    set emit 0
	    if {[info exists stubs($name,deprecated,$i)]} {
		append text [$slotProc $name $stubs($name,generic,$i) $i]
		set emit 1



	    } elseif {[info exists stubs($name,generic,$i)]} {
		if {[llength $slots] > 1} {
		    puts stderr "conflicting generic and platform entries:\
			    $name $i"
		}
		append text [$slotProc $name $stubs($name,generic,$i) $i]
		set emit 1







>
>
>







710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
	}
	for {set i 0} {$i <= $lastNum} {incr i} {
	    set slots [array names stubs $name,*,$i]
	    set emit 0
	    if {[info exists stubs($name,deprecated,$i)]} {
		append text [$slotProc $name $stubs($name,generic,$i) $i]
		set emit 1
	    } elseif {[info exists stubs($name,nostub,$i)]} {
		append text [$slotProc $name $stubs($name,generic,$i) $i]
		set emit 1
	    } elseif {[info exists stubs($name,generic,$i)]} {
		if {[llength $slots] > 1} {
		    puts stderr "conflicting generic and platform entries:\
			    $name $i"
		}
		append text [$slotProc $name $stubs($name,generic,$i) $i]
		set emit 1
Added tools/makeHeader.tcl.












































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
# makeHeader.tcl --
#
#	This script generates embeddable C source (in a .h file) from a .tcl
#	script.
#
# Copyright (c) 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6

namespace eval makeHeader {

    ####################################################################
    #
    # mapSpecial --
    #	Transform a single line so that it is able to be put in a C string.
    #
    proc mapSpecial {str} {
	# All Tcl metacharacters and key C backslash sequences
	set MAP {
	    \" \\\\\" \\ \\\\\\\\ $ \\$ [ \\[ ] \\] ' \\\\' ? \\\\?
	    \a \\\\a \b \\\\b \f \\\\f \n \\\\n \r \\\\r \t \\\\t \v \\\\v
	}
	set XFORM {[format \\\\\\\\u%04x {*}[scan & %c]]}

	subst [regsub -all {[^\u0020-\u007e]} [string map $MAP $str] $XFORM]
    }

    ####################################################################
    #
    # compactLeadingSpaces --
    #	Converts the leading whitespace on a line into a more compact form.
    #
    proc compactLeadingSpaces {line} {
	set line [string map {\t {        }} [string trimright $line]]
	if {[regexp {^[ ]+} $line spaces]} {
	    regsub -all {[ ]{4}} $spaces \t replace
	    set len [expr {[string length $spaces] - 1}]
	    set line [string replace $line 0 $len $replace]
	}
	return $line
    }

    ####################################################################
    #
    # processScript --
    #	Transform a whole sequence of lines with [mapSpecial].
    #
    proc processScript {scriptLines} {
	lmap line $scriptLines {
	    # Skip blank and comment lines; they're there in the original
	    # sources so we don't need to copy them over.
	    if {[regexp {^\s*(?:#|$)} $line]} continue
	    format {"%s"} [mapSpecial [compactLeadingSpaces $line]\n]
	}
    }

    ####################################################################
    #
    # updateTemplate --
    #	Rewrite a template to contain the content from the input script.
    #
    proc updateTemplate {dataVar scriptLines} {
	set BEGIN "*!BEGIN!: Do not edit below this line.*"
	set END "*!END!: Do not edit above this line.*"

	upvar 1 $dataVar data

	set from [lsearch -glob $data $BEGIN]
	set to [lsearch -glob $data $END]
	if {$from == -1 || $to == -1 || $from >= $to} {
	    throw BAD "not a template"
	}

	set data [lreplace $data $from+1 $to-1 {*}[processScript $scriptLines]]
    }

    ####################################################################
    #
    # stripSurround --
    #	Removes the header and footer comments from a (line-split list of
    #	lines of) Tcl script code.
    #
    proc stripSurround {lines} {
	set RE {^\s*$|^#}
	set state 0
	set lines [lmap line [lreverse $lines] {
	    if {!$state && [regexp $RE $line]} continue {
		set state 1
		set line
	    }
	}]
	return [lmap line [lreverse $lines] {
	    if {$state && [regexp $RE $line]} continue {
		set state 0
		set line
	    }
	}]
    }

    ####################################################################
    #
    # updateTemplateFile --
    #	Rewrites a template file with the lines of the given script.
    #
    proc updateTemplateFile {headerFile scriptLines} {
	set f [open $headerFile "r+"]
	try {
	    set content [split [chan read -nonewline $f] "\n"]
	    updateTemplate content [stripSurround $scriptLines]
	    chan seek $f 0
	    chan puts $f [join $content \n]
	    chan truncate $f
	} trap BAD msg {
	    # Add the filename to the message
	    throw BAD "${headerFile}: $msg"
	} finally {
	    chan close $f
	}
    }

    ####################################################################
    #
    # readScript --
    #	Read a script from a file and return its lines.
    #
    proc readScript {script} {
	set f [open $script]
	try {
	    chan configure $f -encoding utf-8
	    return [split [string trim [chan read $f]] "\n"]
	} finally {
	    chan close $f
	}
    }

    ####################################################################
    #
    # run --
    #	The main program of this script.
    #
    proc run {args} {
	try {
	    if {[llength $args] != 2} {
		throw ARGS "inputTclScript templateFile"
	    }
	    lassign $args inputTclScript templateFile

	    puts "Inserting $inputTclScript into $templateFile"
	    set scriptLines [readScript $inputTclScript]
	    updateTemplateFile $templateFile $scriptLines
	    exit 0
	} trap ARGS msg {
	    puts stderr "wrong # args: should be \"[file tail $::argv0] $msg\""
	    exit 2
	} trap BAD msg {
	    puts stderr $msg
	    exit 1
	} trap POSIX msg {
	    puts stderr $msg
	    exit 1
	} on error {- opts} {
	    puts stderr [dict get $opts -errorinfo]
	    exit 3
	}
    }
}

########################################################################
#
# Launch the main program
#
if {[info script] eq $::argv0} {
    makeHeader::run {*}$::argv
}

# Local-Variables:
# mode: tcl
# fill-column: 78
# End:
Added tools/mkVfs.tcl.






































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
proc cat fname {
    set fname [open $fname r]
    set data [read $fname]
    close $fname
    return $data
}

proc pkgIndexDir {root fout d1} {

    puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} \
	      [file tail $d1]]
    set idx [string length $root]
    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
        set f [file join $d1 $ftail]
        if {[file isdirectory $f] && [string compare CVS $ftail]} {
            pkgIndexDir $root $fout $f
        } elseif {[file tail $f] eq "pkgIndex.tcl"} {
      	    puts $fout "set dir \${VFSROOT}[string range $d1 $idx end]"
	          puts $fout [cat $f]
	      }
    }
}

###
# Script to build the VFS file system
###
proc copyDir {d1 d2} {

    puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \
	      [file tail $d2]]

    file delete -force -- $d2
    file mkdir $d2

    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
        set f [file join $d1 $ftail]
        if {[file isdirectory $f] && [string compare CVS $ftail]} {
            copyDir $f [file join $d2 $ftail]
        } elseif {[file isfile $f]} {
      	    file copy -force $f [file join $d2 $ftail]
	          if {$::tcl_platform(platform) eq {unix}} {
            		file attributes [file join $d2 $ftail] -permissions 0644
      	    } else {
            		file attributes [file join $d2 $ftail] -readonly 1
	          }
	      }
    }

    if {$::tcl_platform(platform) eq {unix}} {
      	file attributes $d2 -permissions 0755
    } else {
	      file attributes $d2 -readonly 1
    }
}

if {[llength $argv] < 3} {
    puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM"
    exit 1
}
set TCL_SCRIPT_DIR [lindex $argv 0]
set TCLSRC_ROOT    [lindex $argv 1]
set PLATFORM       [lindex $argv 2]
set TKDLL          [lindex $argv 3]
set TKVER          [lindex $argv 4]

puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM"
copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR}

if {$PLATFORM == "windows"} {
    set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll]
    puts "DDE DLL $ddedll"
    if {$ddedll != {}} {
      	file copy $ddedll ${TCL_SCRIPT_DIR}/dde
    }
    set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll]
    puts "REG DLL $ddedll"
    if {$regdll != {}} {
      	file copy $regdll ${TCL_SCRIPT_DIR}/reg
    }
} else {
    # Remove the dde and reg package paths
    file delete -force ${TCL_SCRIPT_DIR}/dde
    file delete -force ${TCL_SCRIPT_DIR}/reg
}

# For the following packages, cat their pkgIndex files to tclIndex
file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 0
set fout [open ${TCL_SCRIPT_DIR}/tclIndex a]
puts $fout {#
# MANIFEST OF INCLUDED PACKAGES
#
set VFSROOT $dir
}
if {$TKDLL ne {} && [file exists $TKDLL]} {
  file copy $TKDLL ${TCL_SCRIPT_DIR}
  puts $fout [list package ifneeded Tk $TKVER "load \$dir $TKDLL"]
}
pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR}
close $fout
Changes to unix/Makefile.in.
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
# Directory in which to install html documentation:
HTML_INSTALL_DIR	= $(INSTALL_ROOT)$(HTML_DIR)

# Directory in which to install the configuration file tclConfig.sh
CONFIG_INSTALL_DIR	= $(INSTALL_ROOT)$(libdir)

# Directory in which to install bundled packages:
PACKAGE_DIR             = @PACKAGE_DIR@

# Package search path.
TCL_PACKAGE_PATH	= @TCL_PACKAGE_PATH@

# Tcl Module default path roots (TIP189).
TCL_MODULE_PATH		= @TCL_MODULE_PATH@








|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
# Directory in which to install html documentation:
HTML_INSTALL_DIR	= $(INSTALL_ROOT)$(HTML_DIR)

# Directory in which to install the configuration file tclConfig.sh
CONFIG_INSTALL_DIR	= $(INSTALL_ROOT)$(libdir)

# Directory in which to install bundled packages:
PACKAGE_DIR		= @PACKAGE_DIR@

# Package search path.
TCL_PACKAGE_PATH	= @TCL_PACKAGE_PATH@

# Tcl Module default path roots (TIP189).
TCL_MODULE_PATH		= @TCL_MODULE_PATH@

121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
# that Tcl provides these procedures instead of your standard C library.

ENV_FLAGS =
#ENV_FLAGS = -DTclSetEnv=setenv -DTcl_PutEnv=putenv -DTclUnsetEnv=unsetenv

# To enable memory debugging, call configure with --enable-symbols=mem
# Warning: if you enable memory debugging, you must do it *everywhere*,
# including all the code that calls Tcl, and you must use ckalloc and ckfree
# everywhere instead of malloc and free.

TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
#TCL_STUB_LIB_FILE	= libtclstub.a

# Generic stub lib name used in rules that apply to tcl and tk
STUB_LIB_FILE		= ${TCL_STUB_LIB_FILE}







|







121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
# that Tcl provides these procedures instead of your standard C library.

ENV_FLAGS =
#ENV_FLAGS = -DTclSetEnv=setenv -DTcl_PutEnv=putenv -DTclUnsetEnv=unsetenv

# To enable memory debugging, call configure with --enable-symbols=mem
# Warning: if you enable memory debugging, you must do it *everywhere*,
# including all the code that calls Tcl, and you must use Tcl_Alloc and Tcl_Free
# everywhere instead of malloc and free.

TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
#TCL_STUB_LIB_FILE	= libtclstub.a

# Generic stub lib name used in rules that apply to tcl and tk
STUB_LIB_FILE		= ${TCL_STUB_LIB_FILE}
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
SHELL			= @MAKEFILE_SHELL@

# Tcl used to let the configure script choose which program to use for
# installing, but there are just too many different versions of "install"
# around; better to use the install-sh script that comes with the
# distribution, which is slower but guaranteed to work.

INSTALL_STRIP_PROGRAM   = -s
INSTALL_STRIP_LIBRARY   = -S -x

INSTALL			= $(SHELL) $(UNIX_DIR)/install-sh -c
INSTALL_PROGRAM		= ${INSTALL}
INSTALL_LIBRARY		= ${INSTALL}
INSTALL_DATA		= ${INSTALL} -m 644
INSTALL_DATA_DIR	= ${INSTALL} -d -m 755








|
|







147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
SHELL			= @MAKEFILE_SHELL@

# Tcl used to let the configure script choose which program to use for
# installing, but there are just too many different versions of "install"
# around; better to use the install-sh script that comes with the
# distribution, which is slower but guaranteed to work.

INSTALL_STRIP_PROGRAM	= -s
INSTALL_STRIP_LIBRARY	= -S -x

INSTALL			= $(SHELL) $(UNIX_DIR)/install-sh -c
INSTALL_PROGRAM		= ${INSTALL}
INSTALL_LIBRARY		= ${INSTALL}
INSTALL_DATA		= ${INSTALL} -m 644
INSTALL_DATA_DIR	= ${INSTALL} -d -m 755

238
239
240
241
242
243
244


245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261

262
263
264
265
266
267
268
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
# Must be absolute to so the corresponding tcltest's tcl_library is absolute.
TCL_BUILDTIME_LIBRARY	= @TCL_SRC_DIR@/library

ZLIB_DIR		= ${COMPAT_DIR}/zlib
ZLIB_INCLUDE		= @ZLIB_INCLUDE@

CC			= @CC@


#CC			= purify -best-effort @CC@ -DPURIFY

# Flags to be passed to installManPage to control how the manpages should be
# installed (symlinks, compression, package name suffix).
MAN_FLAGS               = @MAN_FLAGS@

# If non-empty, install the timezone files that are included with Tcl,
# otherwise use the ones that ship with the OS.
INSTALL_TZDATA		= @INSTALL_TZDATA@

#--------------------------------------------------------------------------
# The information below is usually usable as is. The configure script won't
# modify it and it only exists to make working around selected rare system
# configurations easier.
#--------------------------------------------------------------------------

GDB			= gdb

TRACE			= strace
TRACE_OPTS		=
VALGRIND		= valgrind
VALGRINDARGS		= --tool=memcheck --num-callers=24 \
    --leak-resolution=high --leak-check=yes --show-reachable=yes -v \
    --suppressions=$(TOOL_DIR)/valgrind_suppress

#--------------------------------------------------------------------------
# The information below should be usable as is. The configure script won't
# modify it and you shouldn't need to modify it either.
#--------------------------------------------------------------------------

STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
-I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@


CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS}

APP_CC_SWITCHES = $(CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@

LIBS		= @TCL_LIBS@

DEPEND_SWITCHES	= ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@

TCLSH_OBJS = tclAppInit.o

TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o

XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \







>
>




|












>




|
|







|
|
>








|







238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
# Must be absolute to so the corresponding tcltest's tcl_library is absolute.
TCL_BUILDTIME_LIBRARY	= @TCL_SRC_DIR@/library

ZLIB_DIR		= ${COMPAT_DIR}/zlib
ZLIB_INCLUDE		= @ZLIB_INCLUDE@

CC			= @CC@
OBJEXT			= @OBJEXT@

#CC			= purify -best-effort @CC@ -DPURIFY

# Flags to be passed to installManPage to control how the manpages should be
# installed (symlinks, compression, package name suffix).
MAN_FLAGS		= @MAN_FLAGS@

# If non-empty, install the timezone files that are included with Tcl,
# otherwise use the ones that ship with the OS.
INSTALL_TZDATA		= @INSTALL_TZDATA@

#--------------------------------------------------------------------------
# The information below is usually usable as is. The configure script won't
# modify it and it only exists to make working around selected rare system
# configurations easier.
#--------------------------------------------------------------------------

GDB			= gdb
LLDB			= lldb
TRACE			= strace
TRACE_OPTS		=
VALGRIND		= valgrind
VALGRINDARGS		= --tool=memcheck --num-callers=24 \
	--leak-resolution=high --leak-check=yes --show-reachable=yes -v \
	--suppressions=$(TOOL_DIR)/valgrind_suppress

#--------------------------------------------------------------------------
# The information below should be usable as is. The configure script won't
# modify it and you shouldn't need to modify it either.
#--------------------------------------------------------------------------

STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
	-I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
	${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \
	@EXTRA_CC_SWITCHES@

CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS}

APP_CC_SWITCHES = $(CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@

LIBS		= @TCL_LIBS@

DEPEND_SWITCHES	= ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
	${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@

TCLSH_OBJS = tclAppInit.o

TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o

XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325

326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
	tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \
	tclPkg.o tclPkgConfig.o tclPosixStr.o \
	tclPreserve.o tclProc.o tclProcess.o tclRegexp.o \
	tclResolve.o tclResult.o tclScan.o tclStringObj.o \
	tclStrToD.o tclThread.o \
	tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
	tclTomMathInterface.o

OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
	tclOOMethod.o tclOOStubInit.o

TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
	bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \
        bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
        bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
	bn_mp_cnt_lsb.o bn_mp_copy.o \
	bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \
	bn_mp_div_2d.o bn_mp_div_3.o \
        bn_mp_exch.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_get_int.o bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_init.o \

	bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
	bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_karatsuba_mul.o \
	bn_mp_karatsuba_sqr.o \
        bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
        bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
	bn_mp_radix_size.o bn_mp_radix_smap.o \
        bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
	bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \
	bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
        bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
	bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
	bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
        bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o

STUB_LIB_OBJS = tclStubLib.o \
	tclTomMathStubLib.o \
	${COMPAT_OBJS}

UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
	tclUnixFile.o tclUnixPipe.o tclUnixSock.o \







|






|
|



|
>



|
|

|


|


|







310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
	tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \
	tclPkg.o tclPkgConfig.o tclPosixStr.o \
	tclPreserve.o tclProc.o tclProcess.o tclRegexp.o \
	tclResolve.o tclResult.o tclScan.o tclStringObj.o \
	tclStrToD.o tclThread.o \
	tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
	tclTomMathInterface.o tclZipfs.o

OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
	tclOOMethod.o tclOOStubInit.o

TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
	bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \
	bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
	bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
	bn_mp_cnt_lsb.o bn_mp_copy.o \
	bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \
	bn_mp_div_2d.o bn_mp_div_3.o \
	bn_mp_exch.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_get_int.o \
	bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_init.o \
	bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
	bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_karatsuba_mul.o \
	bn_mp_karatsuba_sqr.o \
	bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
	bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
	bn_mp_radix_size.o bn_mp_radix_smap.o \
	bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
	bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \
	bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
	bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
	bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
	bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
	bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o

STUB_LIB_OBJS = tclStubLib.o \
	tclTomMathStubLib.o \
	${COMPAT_OBJS}

UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
	tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
461
462
463
464
465
466
467
468

469
470
471
472
473
474
475
	$(GENERIC_DIR)/tclThreadJoin.c \
	$(GENERIC_DIR)/tclThreadStorage.c \
	$(GENERIC_DIR)/tclTimer.c \
	$(GENERIC_DIR)/tclTrace.c \
	$(GENERIC_DIR)/tclUtil.c \
	$(GENERIC_DIR)/tclVar.c \
	$(GENERIC_DIR)/tclAssembly.c \
	$(GENERIC_DIR)/tclZlib.c


OO_SRCS = \
	$(GENERIC_DIR)/tclOO.c \
	$(GENERIC_DIR)/tclOOBasic.c \
	$(GENERIC_DIR)/tclOOCall.c \
	$(GENERIC_DIR)/tclOODefineCmds.c \
	$(GENERIC_DIR)/tclOOInfo.c \







|
>







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
	$(GENERIC_DIR)/tclThreadJoin.c \
	$(GENERIC_DIR)/tclThreadStorage.c \
	$(GENERIC_DIR)/tclTimer.c \
	$(GENERIC_DIR)/tclTrace.c \
	$(GENERIC_DIR)/tclUtil.c \
	$(GENERIC_DIR)/tclVar.c \
	$(GENERIC_DIR)/tclAssembly.c \
	$(GENERIC_DIR)/tclZlib.c \
	$(GENERIC_DIR)/tclZipfs.c

OO_SRCS = \
	$(GENERIC_DIR)/tclOO.c \
	$(GENERIC_DIR)/tclOOBasic.c \
	$(GENERIC_DIR)/tclOOCall.c \
	$(GENERIC_DIR)/tclOODefineCmds.c \
	$(GENERIC_DIR)/tclOOInfo.c \
613
614
615
616
617
618
619






































620
621
622
623
624
625
626
627
628
629
630
631









632
633
634
635
636




637
638
639
640
641
642
643
644
645
646
647
# Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those files
# won't compile on the current machine, and they will cause problems for
# things like "make depend".

SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \
	$(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@







































#--------------------------------------------------------------------------
# Start of rules
#--------------------------------------------------------------------------

all: binaries libraries doc packages

binaries: ${LIB_FILE} ${TCL_EXE}

libraries:

doc:










# The following target is configured by autoconf to generate either a shared
# library or non-shared library for Tcl.
${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS}
	rm -f $@
	@MAKE_LIB@





${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
	@if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \
	    (cd ${TOP_DIR}/win; ${MAKE} winextensions); \
	fi
	rm -f $@
	@MAKE_STUB_LIB@

# Make target which outputs the list of the .o contained in the Tcl lib useful
# to build a single big shared library containing Tcl and other extensions.
# Used for the Tcl Plugin.  -- dl







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>












>
>
>
>
>
>
>
>
>


|


>
>
>
>


|
|







619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
# Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those files
# won't compile on the current machine, and they will cause problems for
# things like "make depend".

SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \
	$(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@

###
# Tip 430 - ZipFS Modifications
###

TCL_ZIP_FILE		= @TCL_ZIP_FILE@
TCL_VFS_ROOT		= libtcl.vfs
TCL_VFS_PATH		= ${TCL_VFS_ROOT}/tcl_library

HOST_CC			= @CC_FOR_BUILD@
HOST_EXEEXT		= @EXEEXT_FOR_BUILD@
HOST_OBJEXT		= @OBJEXT_FOR_BUILD@
ZIPFS_BUILD		= @ZIPFS_BUILD@
NATIVE_ZIP		= @ZIP_PROG@
ZIP_PROG_OPTIONS	= @ZIP_PROG_OPTIONS@
ZIP_PROG_VFSSEARCH	= @ZIP_PROG_VFSSEARCH@
SHARED_BUILD		= @SHARED_BUILD@
INSTALL_LIBRARIES	= @INSTALL_LIBRARIES@
INSTALL_MSGS		= @INSTALL_MSGS@

# Minizip
MINIZIP_OBJS = \
	adler32.$(HOST_OBJEXT) \
	compress.$(HOST_OBJEXT) \
	crc32.$(HOST_OBJEXT) \
	deflate.$(HOST_OBJEXT) \
	infback.$(HOST_OBJEXT) \
	inffast.$(HOST_OBJEXT) \
	inflate.$(HOST_OBJEXT) \
	inftrees.$(HOST_OBJEXT) \
	ioapi.$(HOST_OBJEXT) \
	trees.$(HOST_OBJEXT) \
	uncompr.$(HOST_OBJEXT) \
	zip.$(HOST_OBJEXT) \
	zutil.$(HOST_OBJEXT) \
	minizip.$(HOST_OBJEXT)

ZIP_INSTALL_OBJS	= @ZIP_INSTALL_OBJS@

#--------------------------------------------------------------------------
# Start of rules
#--------------------------------------------------------------------------

all: binaries libraries doc packages

binaries: ${LIB_FILE} ${TCL_EXE}

libraries:

doc:

tclzipfile: ${TCL_ZIP_FILE}

${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS}
	@rm -rf ${TCL_VFS_ROOT}
	@mkdir -p ${TCL_VFS_PATH}
	cp -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}
	-find ${TCL_VFS_ROOT} -type d -empty -delete
	( cd ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH})

# The following target is configured by autoconf to generate either a shared
# library or non-shared library for Tcl.
${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} ${TCL_ZIP_FILE}
	rm -f $@
	@MAKE_LIB@
ifeq (${ZIPFS_BUILD},1)
	cat ${TCL_ZIP_FILE} >> ${LIB_FILE}
	${NATIVE_ZIP} -A ${LIB_FILE}
endif

${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
	@if [ "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll" ] ; then \
	    ( cd ${TOP_DIR}/win; ${MAKE} winextensions ); \
	fi
	rm -f $@
	@MAKE_STUB_LIB@

# Make target which outputs the list of the .o contained in the Tcl lib useful
# to build a single big shared library containing Tcl and other extensions.
# Used for the Tcl Plugin.  -- dl
663
664
665
666
667
668
669
670

671
672
673
674
675
676
677
678
679
680
681
682
683
Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
	$(SHELL) config.status
#tclConfig.h: $(UNIX_DIR)/tclConfig.h.in
#	$(SHELL) config.status

clean: clean-packages
	rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
		errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@

	cd dltest ; $(MAKE) clean

distclean: distclean-packages clean
	rm -rf Makefile config.status config.cache config.log tclConfig.sh \
		tclConfig.h *.plist Tcl.framework tcl.pc
	cd dltest ; $(MAKE) distclean

depend:
	makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)

#--------------------------------------------------------------------------
# The following target outputs the name of the top-level source directory for
# Tcl (it is used by Tk's configure script, for example). The .NO_PARALLEL







|
>
|




|







720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
	$(SHELL) config.status
#tclConfig.h: $(UNIX_DIR)/tclConfig.h.in
#	$(SHELL) config.status

clean: clean-packages
	rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
		errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \
		minizip${HOST_EXEEXT} *.${HOST_OBJEXT} *.zip *.vfs
	(cd dltest ; $(MAKE) clean)

distclean: distclean-packages clean
	rm -rf Makefile config.status config.cache config.log tclConfig.sh \
		tclConfig.h *.plist Tcl.framework tcl.pc
	(cd dltest ; $(MAKE) distclean)

depend:
	makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)

#--------------------------------------------------------------------------
# The following target outputs the name of the top-level source directory for
# Tcl (it is used by Tk's configure script, for example). The .NO_PARALLEL
724
725
726
727
728
729
730
731







732
733
734
735
736
737
738
	$(SHELL_ENV) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl $(TESTFLAGS)

gdb-test: ${TCLTEST_EXE}
	@echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run
	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
	@echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run
	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
	rm gdb.run








# Useful target to launch a built tcltest with the proper path,...
runtest: ${TCLTEST_EXE}
	$(SHELL_ENV) ./${TCLTEST_EXE}

# Useful target for running the test suite with an unwritable current
# directory...







|
>
>
>
>
>
>
>







782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
	$(SHELL_ENV) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl $(TESTFLAGS)

gdb-test: ${TCLTEST_EXE}
	@echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run
	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
	@echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run
	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
	@rm gdb.run

lldb-test: ${TCLTEST_EXE}
	@echo "settings set target.env-vars @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > lldb.run
	@echo "settings set target.env-vars TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> lldb.run
	$(LLDB) --source lldb.run ./${TCLTEST_EXE} -- $(TOP_DIR)/tests/all.tcl \
		$(TESTFLAGS) -singleproc 1
	@rm lldb.run

# Useful target to launch a built tcltest with the proper path,...
runtest: ${TCLTEST_EXE}
	$(SHELL_ENV) ./${TCLTEST_EXE}

# Useful target for running the test suite with an unwritable current
# directory...
758
759
760
761
762
763
764
765


766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825



826













827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848

849
850
851
852
853
854
855

856
857
858
859
860

861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
	$(SHELL_ENV) ./${TCL_EXE} $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: ${TCL_EXE}
	$(SHELL_ENV) $(GDB) ./${TCL_EXE}

valgrind: ${TCL_EXE} ${TCLTEST_EXE}
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind $(TESTFLAGS)



valgrindshell: ${TCL_EXE}
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT)

trace-shell: ${TCL_EXE}
	$(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCL_EXE} $(SCRIPT)

trace-test: ${TCLTEST_EXE}
	$(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl -singleproc 1 $(TESTFLAGS)

#--------------------------------------------------------------------------
# Installation rules
#--------------------------------------------------------------------------

INSTALL_BASE_TARGETS = install-binaries install-libraries install-msgs $(INSTALL_TZDATA)
INSTALL_DOC_TARGETS = install-doc
INSTALL_PACKAGE_TARGETS = install-packages
INSTALL_DEV_TARGETS = install-headers
INSTALL_EXTRA_TARGETS = @EXTRA_INSTALL@
INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \
		  $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS)

install: $(INSTALL_TARGETS)

install-strip:
	$(MAKE) $(INSTALL_TARGETS) \
		INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \
		INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}"

install-binaries: binaries
	@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" \
		"$(CONFIG_INSTALL_DIR)"; \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	@echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/"
	@@INSTALL_LIB@
	@chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)"
	@echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
	@$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
	@echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/"
	@$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh"
	@echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/"
	@$(INSTALL_DATA) $(UNIX_DIR)/tclooConfig.sh \
		"$(CONFIG_INSTALL_DIR)/tclooConfig.sh"
	@if test "$(STUB_LIB_FILE)" != "" ; then \
	    echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
	    @INSTALL_STUB_LIB@ ; \
	fi
	@EXTRA_INSTALL_BINARIES@
	@echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/"
	@$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig
	@$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc

install-libraries: libraries
	@for i in "$(SCRIPT_INSTALL_DIR)"; \



	    do \













	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	@for i in opt0.4 encoding ../tcl9 ../tcl9/9.0  ../tcl9/9.0/platform; \
	    do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/";
	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
		$(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package http 2.8.13 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/http-2.8.13.tm;

	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.7.0 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/msgcat-1.7.0.tm;

	@echo "Installing package tcltest 2.4.1 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/tcltest-2.4.1.tm;

	@echo "Installing package platform 1.0.14 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/platform-1.0.14.tm;

	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/platform/shell-1.1.4.tm;

	@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/";
	@for i in $(TOP_DIR)/library/encoding/*.enc ; do \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/encoding; \
	done;
	@if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ]; then \
	    echo "Customizing tcl module path"; \
	    echo "if {![interp issafe]} { ::tcl::tm::roots {$(TCL_MODULE_PATH)} }" >> \
	        "$(SCRIPT_INSTALL_DIR)"/tm.tcl; \
	fi

install-tzdata:
	@for i in tzdata; \
	    do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing time zone files to $(SCRIPT_INSTALL_DIR)/tzdata/"
	@for i in $(TOP_DIR)/library/tzdata/* ; do \
	    if [ -d $$i ] ; then \
		ii=`basename $$i`; \
		if [ ! -d "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii ] ; then \
		    $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii; \
		fi; \







|
>
>














|
















|
<



<
|
|



















|
|
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>



<
|
|
|
<



<
|
|
|

|
<

|
|
|
>
|
|
<

|
|
|
>
|
|
|
|
|
>
|
|
|
|


|
|






|
<



<
|
|







823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864

865
866
867

868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910

911
912
913

914
915
916

917
918
919
920
921

922
923
924
925
926
927
928

929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954

955
956
957

958
959
960
961
962
963
964
965
966
	$(SHELL_ENV) ./${TCL_EXE} $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: ${TCL_EXE}
	$(SHELL_ENV) $(GDB) ./${TCL_EXE}

valgrind: ${TCL_EXE} ${TCLTEST_EXE}
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \
		$(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \
		$(TESTFLAGS)

valgrindshell: ${TCL_EXE}
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT)

trace-shell: ${TCL_EXE}
	$(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCL_EXE} $(SCRIPT)

trace-test: ${TCLTEST_EXE}
	$(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl -singleproc 1 $(TESTFLAGS)

#--------------------------------------------------------------------------
# Installation rules
#--------------------------------------------------------------------------

INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA)
INSTALL_DOC_TARGETS = install-doc
INSTALL_PACKAGE_TARGETS = install-packages
INSTALL_DEV_TARGETS = install-headers
INSTALL_EXTRA_TARGETS = @EXTRA_INSTALL@
INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \
		  $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS)

install: $(INSTALL_TARGETS)

install-strip:
	$(MAKE) $(INSTALL_TARGETS) \
		INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \
		INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}"

install-binaries: binaries
	@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" \
		"$(CONFIG_INSTALL_DIR)" ; do \

	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \

	    fi; \
	done
	@echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/"
	@@INSTALL_LIB@
	@chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)"
	@echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
	@$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
	@echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/"
	@$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh"
	@echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/"
	@$(INSTALL_DATA) $(UNIX_DIR)/tclooConfig.sh \
		"$(CONFIG_INSTALL_DIR)/tclooConfig.sh"
	@if test "$(STUB_LIB_FILE)" != "" ; then \
	    echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
	    @INSTALL_STUB_LIB@ ; \
	fi
	@EXTRA_INSTALL_BINARIES@
	@echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/"
	@$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig
	@$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc

install-libraries-zipfs-shared: libraries
	@for i in "$(SCRIPT_INSTALL_DIR)" ; do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
	    fi; \
	done
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"
	@for i in $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	done

install-libraries-zipfs-static: install-libraries-zipfs-shared
	$(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)"

MODULE_INSTALL_DIR=$(SCRIPT_INSTALL_DIR)/..

install-libraries: libraries
	@for i in "$(SCRIPT_INSTALL_DIR)" ; do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \

	    fi; \
	done
	@for i in opt0.4 encoding ../tcl9 ../tcl9/9.0  ../tcl9/9.0/platform ; do \

	    if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \

	    fi; \
	done
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"
	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
		$(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \

	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	done
	@echo "Installing package http 2.9.0 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \
		"$(MODULE_INSTALL_DIR)"/tcl9/9.0/http-2.9.0.tm
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"
	@for i in $(TOP_DIR)/library/opt/*.tcl ; do \

	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	done
	@echo "Installing package msgcat 1.7.0 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \
		"$(MODULE_INSTALL_DIR)"/tcl9/9.0/msgcat-1.7.0.tm
	@echo "Installing package tcltest 2.4.1 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \
		"$(MODULE_INSTALL_DIR)"/tcl9/9.0/tcltest-2.4.1.tm
	@echo "Installing package platform 1.0.14 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \
		"$(MODULE_INSTALL_DIR)"/tcl9/9.0/platform-1.0.14.tm
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \
		"$(MODULE_INSTALL_DIR)"/tcl9/9.0/platform/shell-1.1.4.tm
	@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/"
	@for i in $(TOP_DIR)/library/encoding/*.enc ; do \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/encoding; \
	done
	@if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ] ; then \
	    echo "Customizing tcl module path"; \
	    echo "if {![interp issafe]} { ::tcl::tm::roots {$(TCL_MODULE_PATH)} }" >> \
	        "$(SCRIPT_INSTALL_DIR)"/tm.tcl; \
	fi

install-tzdata:
	@for i in tzdata ; do \

	    if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \

	    fi; \
	done
	@echo "Installing time zone files to $(SCRIPT_INSTALL_DIR)/tzdata/"
	@for i in $(TOP_DIR)/library/tzdata/* ; do \
	    if [ -d $$i ] ; then \
		ii=`basename $$i`; \
		if [ ! -d "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii ] ; then \
		    $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii; \
		fi; \
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945













946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039



1040
1041
1042
1043
1044
1045
1046
		    else \
			$(INSTALL_DATA) $$j "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii; \
		    fi; \
		done; \
	    else \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/tzdata; \
	    fi; \
	done;

install-msgs:
	@for i in msgs; \
	    do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing message catalog files to $(SCRIPT_INSTALL_DIR)/msgs/"
	@for i in $(TOP_DIR)/library/msgs/*.msg ; do \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/msgs; \
	done;

install-doc: doc
	@for i in "$(MAN_INSTALL_DIR)" "$(MAN1_INSTALL_DIR)" "$(MAN3_INSTALL_DIR)" "$(MANN_INSTALL_DIR)" ; \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	@echo "Installing and cross-linking top-level (.1) docs to $(MAN1_INSTALL_DIR)/";
	@for i in $(TOP_DIR)/doc/*.1; do \
	    $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN1_INSTALL_DIR)"; \
	done

	@echo "Installing and cross-linking C API (.3) docs to $(MAN3_INSTALL_DIR)/";
	@for i in $(TOP_DIR)/doc/*.3; do \
	    $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN3_INSTALL_DIR)"; \
	done

	@echo "Installing and cross-linking command (.n) docs to $(MANN_INSTALL_DIR)/";
	@for i in $(TOP_DIR)/doc/*.n; do \
	    $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MANN_INSTALL_DIR)"; \
	done














install-headers:
	@for i in "$(INCLUDE_INSTALL_DIR)"; \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	@echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
	@for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
		$(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
		$(GENERIC_DIR)/tclPlatDecls.h \
		$(GENERIC_DIR)/tclTomMath.h \
		$(GENERIC_DIR)/tclTomMathDecls.h ; \
	    do \
	    $(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)"; \
	    done;

# Optional target to install private headers
install-private-headers:
	@for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	@echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/";
	@for i in $(GENERIC_DIR)/tclInt.h $(GENERIC_DIR)/tclIntDecls.h \
		$(GENERIC_DIR)/tclIntPlatDecls.h $(GENERIC_DIR)/tclPort.h \
		$(GENERIC_DIR)/tclOOInt.h $(GENERIC_DIR)/tclOOIntDecls.h \
		$(UNIX_DIR)/tclUnixPort.h; \
	    do \
	    $(INSTALL_DATA) $$i "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	    done;
	@if test -f tclConfig.h; then\
	    $(INSTALL_DATA) tclConfig.h "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	    fi;

#--------------------------------------------------------------------------
# Rules for how to compile C files
#--------------------------------------------------------------------------

# Test binaries. The rules for tclTestInit.o and xtTestInit.o are complicated
# because they are compiled from tclAppInit.c. Can't use the "-o" option
# because this doesn't work on some strange compilers (e.g. UnixWare).
#
# To enable concurrent parallel make of tclsh and tcltest resp xttest, these
# targets have to depend on tclsh, this ensures that linking of tclsh with
# tclAppInit.o does not execute concurrently with the renaming and recompiling
# of that same object file in the targets below.

tclTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
	@if test -f tclAppInit.o ; then \
	    rm -f tclAppInit.sav; \
	    mv tclAppInit.o tclAppInit.sav; \
	fi;
	$(CC) -c $(APP_CC_SWITCHES) \
		-DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
		-DTCL_TEST $(UNIX_DIR)/tclAppInit.c
	rm -f tclTestInit.o
	mv tclAppInit.o tclTestInit.o
	@if test -f tclAppInit.sav ; then \
	    mv tclAppInit.sav tclAppInit.o; \
	fi;

xtTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
	@if test -f tclAppInit.o ; then \
	    rm -f tclAppInit.sav; \
	    mv tclAppInit.o tclAppInit.sav; \
	fi;
	$(CC) -c $(APP_CC_SWITCHES) \
		-DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
		-DTCL_TEST -DTCL_XT_TEST $(UNIX_DIR)/tclAppInit.c
	rm -f xtTestInit.o
	mv tclAppInit.o xtTestInit.o
	@if test -f tclAppInit.sav ; then \
	    mv tclAppInit.sav tclAppInit.o; \
	fi;

# Object files used on all Unix systems:

REGHDRS=$(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
		$(GENERIC_DIR)/regcustom.h
TCLREHDRS=$(GENERIC_DIR)/tclRegexp.h
COMPILEHDR=$(GENERIC_DIR)/tclCompile.h
FSHDR=$(GENERIC_DIR)/tclFileSystem.h
IOHDR=$(GENERIC_DIR)/tclIO.h
MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
PARSEHDR=$(GENERIC_DIR)/tclParse.h
NREHDR=$(GENERIC_DIR)/tclInt.h
TRIMHDR=$(GENERIC_DIR)/tclStringTrim.h




regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
		$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
		$(GENERIC_DIR)/regc_nfa.c $(GENERIC_DIR)/regc_cvec.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regcomp.c

regexec.o: $(REGHDRS) $(GENERIC_DIR)/regexec.c $(GENERIC_DIR)/rege_dfa.c







|


|
<



<
|
|


|
|


|
<



<
|
|
|
|


<
|
|


<

|



>
>
>
>
>
>
>
>
>
>
>
>
>

|
<



<
|
|

|
<
<
<
<
<

|



|
<



<
|
|

|
<
<
<
<

|
|

|


















|



|



|





|



|



|



|
|
|
|
|
|
|
|
|
|
>
>
>







976
977
978
979
980
981
982
983
984
985
986

987
988
989

990
991
992
993
994
995
996
997
998

999
1000
1001

1002
1003
1004
1005
1006
1007

1008
1009
1010
1011

1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031

1032
1033
1034

1035
1036
1037
1038





1039
1040
1041
1042
1043
1044

1045
1046
1047

1048
1049
1050
1051




1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
		    else \
			$(INSTALL_DATA) $$j "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii; \
		    fi; \
		done; \
	    else \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/tzdata; \
	    fi; \
	done

install-msgs:
	@for i in msgs ; do \

	    if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \

	    fi; \
	done
	@echo "Installing message catalog files to $(SCRIPT_INSTALL_DIR)/msgs/"
	@for i in $(TOP_DIR)/library/msgs/*.msg ; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/msgs; \
	done

install-doc: doc
	@for i in "$(MAN_INSTALL_DIR)" "$(MAN1_INSTALL_DIR)" "$(MAN3_INSTALL_DIR)" "$(MANN_INSTALL_DIR)" ; do \

	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \

	    fi; \
	done
	@echo "Installing and cross-linking top-level (.1) docs to $(MAN1_INSTALL_DIR)/"
	@for i in $(TOP_DIR)/doc/*.1 ; do \
	    $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN1_INSTALL_DIR)"; \
	done

	@echo "Installing and cross-linking C API (.3) docs to $(MAN3_INSTALL_DIR)/"
	@for i in $(TOP_DIR)/doc/*.3 ; do \
	    $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN3_INSTALL_DIR)"; \
	done

	@echo "Installing and cross-linking command (.n) docs to $(MANN_INSTALL_DIR)/";
	@for i in $(TOP_DIR)/doc/*.n ; do \
	    $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MANN_INSTALL_DIR)"; \
	done

# Public headers that define Tcl's API
TCL_PUBLIC_HEADERS = $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
	$(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
	$(GENERIC_DIR)/tclPlatDecls.h $(GENERIC_DIR)/tclTomMath.h \
	$(GENERIC_DIR)/tclTomMathDecls.h
# Private headers that define Tcl's internal API
TCL_PRIVATE_HEADERS = $(GENERIC_DIR)/tclInt.h $(GENERIC_DIR)/tclIntDecls.h \
	$(GENERIC_DIR)/tclIntPlatDecls.h $(GENERIC_DIR)/tclPort.h \
	$(GENERIC_DIR)/tclOOInt.h $(GENERIC_DIR)/tclOOIntDecls.h \
	$(UNIX_DIR)/tclUnixPort.h
# Any other headers you find in the Tcl sources are purely part of Tcl's
# implementation, and aren't to be installed.

install-headers:
	@for i in "$(INCLUDE_INSTALL_DIR)" ; do \

	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \

	    fi; \
	done
	@echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
	@for i in $(TCL_PUBLIC_HEADERS) ; do \





	    $(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)"; \
	done

# Optional target to install private headers
install-private-headers:
	@for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)" ; do \

	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \

	    fi; \
	done
	@echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/";
	@for i in $(TCL_PRIVATE_HEADERS) ; do \




	    $(INSTALL_DATA) $$i "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	done
	@if test -f tclConfig.h ; then \
	    $(INSTALL_DATA) tclConfig.h "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	fi

#--------------------------------------------------------------------------
# Rules for how to compile C files
#--------------------------------------------------------------------------

# Test binaries. The rules for tclTestInit.o and xtTestInit.o are complicated
# because they are compiled from tclAppInit.c. Can't use the "-o" option
# because this doesn't work on some strange compilers (e.g. UnixWare).
#
# To enable concurrent parallel make of tclsh and tcltest resp xttest, these
# targets have to depend on tclsh, this ensures that linking of tclsh with
# tclAppInit.o does not execute concurrently with the renaming and recompiling
# of that same object file in the targets below.

tclTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
	@if test -f tclAppInit.o ; then \
	    rm -f tclAppInit.sav; \
	    mv tclAppInit.o tclAppInit.sav; \
	fi
	$(CC) -c $(APP_CC_SWITCHES) \
		-DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
		-DTCL_TEST $(UNIX_DIR)/tclAppInit.c
	@rm -f tclTestInit.o
	mv tclAppInit.o tclTestInit.o
	@if test -f tclAppInit.sav ; then \
	    mv tclAppInit.sav tclAppInit.o; \
	fi

xtTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
	@if test -f tclAppInit.o ; then \
	    rm -f tclAppInit.sav; \
	    mv tclAppInit.o tclAppInit.sav; \
	fi
	$(CC) -c $(APP_CC_SWITCHES) \
		-DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
		-DTCL_TEST -DTCL_XT_TEST $(UNIX_DIR)/tclAppInit.c
	@rm -f xtTestInit.o
	mv tclAppInit.o xtTestInit.o
	@if test -f tclAppInit.sav ; then \
	    mv tclAppInit.sav tclAppInit.o; \
	fi

# Object files used on all Unix systems:

REGHDRS		= $(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
	$(GENERIC_DIR)/regcustom.h
TCLREHDRS	= $(GENERIC_DIR)/tclRegexp.h
COMPILEHDR	= $(GENERIC_DIR)/tclCompile.h
FSHDR		= $(GENERIC_DIR)/tclFileSystem.h
IOHDR		= $(GENERIC_DIR)/tclIO.h
MATHHDRS	= $(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
PARSEHDR	= $(GENERIC_DIR)/tclParse.h
NREHDR		= $(GENERIC_DIR)/tclInt.h
TRIMHDR		= $(GENERIC_DIR)/tclStringTrim.h

TCL_LOCATIONS	= -DTCL_LIBRARY="\"${TCL_LIBRARY}\"" \
	-DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\""

regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
		$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
		$(GENERIC_DIR)/regc_nfa.c $(GENERIC_DIR)/regc_cvec.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regcomp.c

regexec.o: $(REGHDRS) $(GENERIC_DIR)/regexec.c $(GENERIC_DIR)/rege_dfa.c
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230

tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNamesp.c

tclNotify.o: $(GENERIC_DIR)/tclNotify.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c

tclOO.o: $(GENERIC_DIR)/tclOO.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOO.c

tclOOBasic.o: $(GENERIC_DIR)/tclOOBasic.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOBasic.c

tclOOCall.o: $(GENERIC_DIR)/tclOOCall.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOCall.c







|







1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304

tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNamesp.c

tclNotify.o: $(GENERIC_DIR)/tclNotify.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c

tclOO.o: $(GENERIC_DIR)/tclOO.c $(GENERIC_DIR)/tclOOScript.h
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOO.c

tclOOBasic.o: $(GENERIC_DIR)/tclOOBasic.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOBasic.c

tclOOCall.o: $(GENERIC_DIR)/tclOOCall.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOCall.c
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280

1281
1282
1283
1284
1285
1286
1287
# Part of Tcl's configuration information are the paths where it was installed
# and where it will look for its libraries (which can be different). We derive
# this information from the variables which can be overridden by the user. As
# every path can be configured separately we do not remember one general
# prefix/exec_prefix but all the different paths individually.

tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c
	$(CC) -c $(CC_SWITCHES)					\
		-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR)\"" \
		-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR)\"" \
		-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR)\"" \
		-DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR)\"" \
		-DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \
		\
		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
		-DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \
		-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
		-DCFG_RUNTIME_INCDIR="\"$(includedir)\"" \
		-DCFG_RUNTIME_DOCDIR="\"$(mandir)\"" \
		\

		$(GENERIC_DIR)/tclPkgConfig.c

tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPosixStr.c

tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPreserve.c







|





<





|
>







1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347

1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
# Part of Tcl's configuration information are the paths where it was installed
# and where it will look for its libraries (which can be different). We derive
# this information from the variables which can be overridden by the user. As
# every path can be configured separately we do not remember one general
# prefix/exec_prefix but all the different paths individually.

tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c
	$(CC) -c $(CC_SWITCHES) \
		-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR)\"" \
		-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR)\"" \
		-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR)\"" \
		-DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR)\"" \
		-DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \

		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
		-DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \
		-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
		-DCFG_RUNTIME_INCDIR="\"$(includedir)\"" \
		-DCFG_RUNTIME_DOCDIR="\"$(mandir)\"" \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
		$(GENERIC_DIR)/tclPkgConfig.c

tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPosixStr.c

tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPreserve.c
1323
1324
1325
1326
1327
1328
1329









1330
1331
1332
1333
1334
1335
1336
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtf.c

tclVar.o: $(GENERIC_DIR)/tclVar.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c

tclZlib.o: $(GENERIC_DIR)/tclZlib.c
	$(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c










tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c

tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c








>
>
>
>
>
>
>
>
>







1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtf.c

tclVar.o: $(GENERIC_DIR)/tclVar.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c

tclZlib.o: $(GENERIC_DIR)/tclZlib.c
	$(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c

tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c
	$(CC) -c $(CC_SWITCHES) \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
		-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
		$(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip \
		$(GENERIC_DIR)/tclZipfs.c

tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c

tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c

1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614

tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixThrd.c

tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c

TCL_LOCATIONS=-DTCL_LIBRARY="\"${TCL_LIBRARY}\"" -DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\""
tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh
	$(CC) -c $(CC_SWITCHES) $(TCL_LOCATIONS) $(UNIX_DIR)/tclUnixInit.c

tclUnixCompat.o: $(UNIX_DIR)/tclUnixCompat.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixCompat.c

# The following are Mac OS X only sources:







<







1683
1684
1685
1686
1687
1688
1689

1690
1691
1692
1693
1694
1695
1696

tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixThrd.c

tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c


tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh
	$(CC) -c $(CC_SWITCHES) $(TCL_LOCATIONS) $(UNIX_DIR)/tclUnixInit.c

tclUnixCompat.o: $(UNIX_DIR)/tclUnixCompat.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixCompat.c

# The following are Mac OS X only sources:
1727
1728
1729
1730
1731
1732
1733



















































1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
	$(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLib.c

tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c

.c.o:
	$(CC) -c $(CC_SWITCHES) $<




















































#--------------------------------------------------------------------------
# Bundled Package targets
#--------------------------------------------------------------------------

# Propagate configure args like --enable-64bit to package configure
PKG_CFG_ARGS		= @PKG_CFG_ARGS@
# If PKG_DIR is changed to a different relative depth to the build dir, need
# to adapt the ../.. relative paths below and at the top of configure.ac (we
# cannot use absolute paths due to issues in nested configure when path to
# build dir contains spaces).
PKG_DIR			= ./pkgs

configure-packages:
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    if [ -x $$i/configure ]; then \
	      pkg=`basename $$i`; \
	      echo "Configuring package '$$pkg'"; \
	      mkdir -p $(PKG_DIR)/$$pkg; \
	      if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
		( cd $(PKG_DIR)/$$pkg; \
		  $$i/configure --with-tcl=../.. \
		      --with-tclinclude=$(GENERIC_DIR) \
		      $(PKG_CFG_ARGS) --libdir=$(PACKAGE_DIR) \
		      --enable-shared; ) || exit $$?; \
	      fi; \
	    fi; \
	  fi; \
	done

packages: configure-packages ${STUB_LIB_FILE}
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      echo "Building package '$$pkg'"; \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) || exit $$?; \
	    fi; \
	  fi; \
	done

install-packages: packages
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      echo "Installing package '$$pkg'"; \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE) install \
		  "DESTDIR=$(INSTALL_ROOT)"; ) || exit $$?; \
	    fi; \
	  fi; \
	done

test-packages: ${TCLTEST_EXE} packages
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      echo "Testing package '$$pkg'"; \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE) \
		  "@LD_LIBRARY_PATH_VAR@=../..:$${@LD_LIBRARY_PATH_VAR@}" \
		  "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" \
		  "TCLLIBPATH=../../pkgs" test \
		  "TCLSH_PROG=../../${TCLTEST_EXE}"; ) \
	    fi; \
	  fi; \
	done

clean-packages:
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \
	    fi; \
	  fi; \
	done

distclean-packages:
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \
	    fi; \
	    rm -rf $(PKG_DIR)/$$pkg; \
	  fi; \
	done; \
	rm -rf $(PKG_DIR)

dist-packages: configure-packages
	@rm -rf $(DISTROOT)/pkgs; \
	mkdir -p $(DISTROOT)/pkgs; \
	for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE) dist \
		  "DIST_ROOT=$(DISTROOT)/pkgs"; ) || exit $$?; \
	    fi; \
	  fi; \
	done

#--------------------------------------------------------------------------
# Maintainer-only targets
#--------------------------------------------------------------------------

# The following target generates the file generic/tclDate.c from the yacc
# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is
# not available in all environments. The name of the .c file is different than
# the name of the .y file so that make doesn't try to automatically regenerate
# the .c file.

gendate:
	bison --output-file=$(GENERIC_DIR)/tclDate.c \
	--no-lines \
	--name-prefix=TclDate \
	$(GENERIC_DIR)/tclGetDate.y

#	yacc -l $(GENERIC_DIR)/tclGetDate.y
#	sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
#	    -e 's?SCCSID?RCS: @(#) ?' \
#	    -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
#	    -e '/TclDatenewstate:/d' -e '/#pragma/d' \
#	    -e '/#include <inttypes.h>/d' \







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>














|
|
|
|
|
|
|
|
|
|
|
|
|
|
|



|
|
|
|
|
|
|
|



|
|
|
|
|
|
|
|
|



|
|
|
|
|
|
|
|
|
|
|
|



|
|
|
|
|
|
|



|
|
|
|
|
|
|
|






|
|
|
|
|
|
|
|














|
|
|







1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
	$(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLib.c

tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c

.c.o:
	$(CC) -c $(CC_SWITCHES) $<

#--------------------------------------------------------------------------
# Minizip implementation
#--------------------------------------------------------------------------
adler32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c

compress.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c

crc32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c

deflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c

ioapi.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
		$(ZLIB_DIR)/contrib/minizip/ioapi.c

infback.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c

inffast.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c

inflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c

inftrees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c

trees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c

uncompr.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c

zip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
		$(ZLIB_DIR)/contrib/minizip/zip.c

zutil.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c

minizip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
		$(ZLIB_DIR)/contrib/minizip/minizip.c

minizip${HOST_EXEEXT}: $(MINIZIP_OBJS)
	$(HOST_CC) -o $@ $(MINIZIP_OBJS)

#--------------------------------------------------------------------------
# Bundled Package targets
#--------------------------------------------------------------------------

# Propagate configure args like --enable-64bit to package configure
PKG_CFG_ARGS		= @PKG_CFG_ARGS@
# If PKG_DIR is changed to a different relative depth to the build dir, need
# to adapt the ../.. relative paths below and at the top of configure.ac (we
# cannot use absolute paths due to issues in nested configure when path to
# build dir contains spaces).
PKG_DIR			= ./pkgs

configure-packages:
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		if [ -x $$i/configure ] ; then \
		    pkg=`basename $$i`; \
		    echo "Configuring package '$$pkg'"; \
		    mkdir -p $(PKG_DIR)/$$pkg; \
		    if [ ! -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
			( cd $(PKG_DIR)/$$pkg; \
			  $$i/configure --with-tcl=../.. \
			      --with-tclinclude=$(GENERIC_DIR) \
			      $(PKG_CFG_ARGS) --libdir=$(PACKAGE_DIR) \
			      --enable-shared; ) || exit $$?; \
		    fi; \
		fi; \
	    fi; \
	done

packages: configure-packages ${STUB_LIB_FILE}
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    echo "Building package '$$pkg'"; \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) || exit $$?; \
		fi; \
	    fi; \
	done

install-packages: packages
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    echo "Installing package '$$pkg'"; \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) install \
			  "DESTDIR=$(INSTALL_ROOT)"; ) || exit $$?; \
		fi; \
	    fi; \
	done

test-packages: ${TCLTEST_EXE} packages
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    echo "Testing package '$$pkg'"; \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) \
			  "@LD_LIBRARY_PATH_VAR@=../..:$${@LD_LIBRARY_PATH_VAR@}" \
			  "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" \
			  "TCLLIBPATH=../../pkgs" test \
			  "TCLSH_PROG=../../${TCLTEST_EXE}"; ) \
		fi; \
	    fi; \
	done

clean-packages:
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \
		fi; \
	    fi; \
	done

distclean-packages:
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \
		fi; \
		rm -rf $(PKG_DIR)/$$pkg; \
	    fi; \
	done; \
	rm -rf $(PKG_DIR)

dist-packages: configure-packages
	@rm -rf $(DISTROOT)/pkgs; \
	mkdir -p $(DISTROOT)/pkgs; \
	for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) dist \
			  "DIST_ROOT=$(DISTROOT)/pkgs"; ) || exit $$?; \
		fi; \
	    fi; \
	done

#--------------------------------------------------------------------------
# Maintainer-only targets
#--------------------------------------------------------------------------

# The following target generates the file generic/tclDate.c from the yacc
# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is
# not available in all environments. The name of the .c file is different than
# the name of the .y file so that make doesn't try to automatically regenerate
# the .c file.

gendate:
	bison --output-file=$(GENERIC_DIR)/tclDate.c \
		--no-lines \
		--name-prefix=TclDate \
		$(GENERIC_DIR)/tclGetDate.y

#	yacc -l $(GENERIC_DIR)/tclGetDate.y
#	sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
#	    -e 's?SCCSID?RCS: @(#) ?' \
#	    -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
#	    -e '/TclDatenewstate:/d' -e '/#pragma/d' \
#	    -e '/#include <inttypes.h>/d' \
1881
1882
1883
1884
1885
1886
1887





1888
1889
1890
1891
1892
1893
1894




1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910


1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927


1928
1929
1930
1931
1932
1933
1934
	@echo "This warning can be safely ignored, do not report as a bug!"

$(GENERIC_DIR)/tclOOStubInit.c: $(GENERIC_DIR)/tclOO.decls
	@echo "Warning: tclOOStubInit.c may be out of date."
	@echo "Developers may want to run \"make genstubs\" to regenerate."
	@echo "This warning can be safely ignored, do not report as a bug!"






genstubs:
	$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
		$(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls \
		$(GENERIC_DIR)/tclTomMath.decls
	$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
		$(GENERIC_DIR)/tclOO.decls





#
# Target to check that all exported functions have an entry in the stubs
# tables.
#

checkstubs: $(TCL_LIB_FILE)
	-@for i in `nm -p $(TCL_LIB_FILE) \
		| awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \
		| sort -n`; do \
		match=0; \
		for j in $(TCL_DECLS); do \
		    if [ `grep -c "$$i *(" $$j` -gt 0 ]; then \
			match=1; \
		    fi; \
		done; \
		if [ $$match -eq 0 ]; then echo $$i; fi \


	done

#
# Target to check that all public APIs which are not command implementations
# have an entry in section three of the distributed manpages.
#

checkdoc: $(TCL_LIB_FILE)
	-@for i in `nm -p $(TCL_LIB_FILE) | awk '$$3 ~ /Tcl_/ { print $$3 }' \
		| grep -v 'Cmd$$' | sort -n`; do \
		match=0; \
		for j in $(TOP_DIR)/doc/*.3; do \
		    if [ `grep '\-' $$j | grep -c $$i` -gt 0 ]; then \
			match=1; \
		    fi; \
		done; \
		if [ $$match -eq 0 ]; then echo $$i; fi \


	done

#
# Target to check for proper usage of UCHAR macro.
#

checkuchar:







>
>
>
>
>







>
>
>
>








|
|
|
|
|
|
|
|
>
>









|
|
|
|
|
|
|
|
>
>







2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
	@echo "This warning can be safely ignored, do not report as a bug!"

$(GENERIC_DIR)/tclOOStubInit.c: $(GENERIC_DIR)/tclOO.decls
	@echo "Warning: tclOOStubInit.c may be out of date."
	@echo "Developers may want to run \"make genstubs\" to regenerate."
	@echo "This warning can be safely ignored, do not report as a bug!"

$(GENERIC_DIR)/tclOOScript.h: $(GENERIC_DIR)/tclOOScript.tcl
	@echo "Warning: tclOOScript.h may be out of date."
	@echo "Developers may want to run \"make genscript\" to regenerate."
	@echo "This warning can be safely ignored, do not report as a bug!"

genstubs:
	$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
		$(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls \
		$(GENERIC_DIR)/tclTomMath.decls
	$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
		$(GENERIC_DIR)/tclOO.decls

genscript:
	$(NATIVE_TCLSH) $(TOOL_DIR)/makeHeader.tcl \
		$(GENERIC_DIR)/tclOOScript.tcl $(GENERIC_DIR)/tclOOScript.h

#
# Target to check that all exported functions have an entry in the stubs
# tables.
#

checkstubs: $(TCL_LIB_FILE)
	-@for i in `nm -p $(TCL_LIB_FILE) \
		| awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \
		| sort -n` ; do \
	    match=0; \
	    for j in $(TCL_DECLS) ; do \
		if [ `grep -c "$$i *(" $$j` -gt 0 ] ; then \
		    match=1; \
		fi; \
	    done; \
	    if [ $$match -eq 0 ] ; then \
		echo $$i; \
	    fi; \
	done

#
# Target to check that all public APIs which are not command implementations
# have an entry in section three of the distributed manpages.
#

checkdoc: $(TCL_LIB_FILE)
	-@for i in `nm -p $(TCL_LIB_FILE) | awk '$$3 ~ /Tcl_/ { print $$3 }' \
		| grep -v 'Cmd$$' | sort -n` ; do \
	    match=0; \
	    for j in $(TOP_DIR)/doc/*.3 ; do \
		if [ `grep '\-' $$j | grep -c $$i` -gt 0 ] ; then \
		    match=1; \
		fi; \
	    done; \
	    if [ $$match -eq 0 ] ; then \
		echo $$i; \
	    fi; \
	done

#
# Target to check for proper usage of UCHAR macro.
#

checkuchar:
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976

1977
1978
1979
1980
1981
1982
1983

#
# Target to create a Tcl RPM for Linux. Requires that you be on a Linux
# system.
#

rpm: all
	rm -f THIS.TCL.SPEC
	echo "%define _builddir `pwd`" > THIS.TCL.SPEC
	echo "%define _rpmdir `pwd`/RPMS" >> THIS.TCL.SPEC
	cat tcl.spec >> THIS.TCL.SPEC
	mkdir -p RPMS/i386
	rpmbuild -bb THIS.TCL.SPEC
	mv RPMS/i386/*.rpm .
	rm -rf RPMS THIS.TCL.SPEC

#
# Target to create a proper Tcl distribution from information in the master
# source directory. DISTDIR must be defined to indicate where to put the
# distribution. DISTDIR must be an absolute path name.
#

DISTROOT = /tmp/dist
DISTNAME = tcl${VERSION}${PATCH_LEVEL}
ZIPNAME	 = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip
DISTDIR	 = $(DISTROOT)/$(DISTNAME)
DIST_INSTALL_DATA   = CPPROG='cp -p' $(INSTALL) -m 644
DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755


$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \
		$(UNIX_DIR)/aclocal.m4
	cd $(UNIX_DIR); autoconf
$(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure
	cd $(MAC_OSX_DIR); autoconf
$(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure







|






|













>







2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130

#
# Target to create a Tcl RPM for Linux. Requires that you be on a Linux
# system.
#

rpm: all
	-@rm -f THIS.TCL.SPEC
	echo "%define _builddir `pwd`" > THIS.TCL.SPEC
	echo "%define _rpmdir `pwd`/RPMS" >> THIS.TCL.SPEC
	cat tcl.spec >> THIS.TCL.SPEC
	mkdir -p RPMS/i386
	rpmbuild -bb THIS.TCL.SPEC
	mv RPMS/i386/*.rpm .
	-rm -rf RPMS THIS.TCL.SPEC

#
# Target to create a proper Tcl distribution from information in the master
# source directory. DISTDIR must be defined to indicate where to put the
# distribution. DISTDIR must be an absolute path name.
#

DISTROOT = /tmp/dist
DISTNAME = tcl${VERSION}${PATCH_LEVEL}
ZIPNAME	 = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip
DISTDIR	 = $(DISTROOT)/$(DISTNAME)
DIST_INSTALL_DATA   = CPPROG='cp -p' $(INSTALL) -m 644
DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755
BUILTIN_PACKAGE_LIST = http opt msgcat reg dde tcltest platform

$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \
		$(UNIX_DIR)/aclocal.m4
	cd $(UNIX_DIR); autoconf
$(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure
	cd $(MAC_OSX_DIR); autoconf
$(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README \
		$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
		$(DISTDIR)
	$(INSTALL_DATA_DIR) $(DISTDIR)/library
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
	for i in http opt msgcat reg dde tcltest platform; \
	    do \
		$(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i ;\
		$(DIST_INSTALL_DATA) $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
	    done;
	$(INSTALL_DATA_DIR) $(DISTDIR)/library/encoding
	$(DIST_INSTALL_DATA) $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
	$(INSTALL_DATA_DIR) $(DISTDIR)/library/msgs
	$(DIST_INSTALL_DATA) $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs
	@echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata
	@( cd $(TOP_DIR); \
	  find library/tzdata -name CVS -prune -o -type f -print ) \







|
<
|
|
|







2150
2151
2152
2153
2154
2155
2156
2157

2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README \
		$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
		$(DISTDIR)
	$(INSTALL_DATA_DIR) $(DISTDIR)/library
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
	for i in $(BUILTIN_PACKAGE_LIST) ; do \

	    $(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i;\
	    $(DIST_INSTALL_DATA) $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
	done
	$(INSTALL_DATA_DIR) $(DISTDIR)/library/encoding
	$(DIST_INSTALL_DATA) $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
	$(INSTALL_DATA_DIR) $(DISTDIR)/library/msgs
	$(DIST_INSTALL_DATA) $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs
	@echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata
	@( cd $(TOP_DIR); \
	  find library/tzdata -name CVS -prune -o -type f -print ) \
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095

2096
2097

2098
2099
2100
2101
2102
2103
2104
		$(DISTDIR)/tools/makeTestCases.tcl $(DISTDIR)/tools/tclZIC.tcl \
		$(DISTDIR)/tools/tcltk-man2html.tcl
	$(INSTALL_DATA_DIR) $(DISTDIR)/libtommath
	$(DIST_INSTALL_DATA) $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath
	$(INSTALL_DATA_DIR) $(DISTDIR)/pkgs
	$(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs
	$(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs
	for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \
	    tar -C $(DISTDIR)/pkgs -xzf "$$i"; \
	done

alldist: dist
	rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME)

	cd $(DISTROOT); tar cf $(DISTNAME)-src.tar $(DISTNAME); \
		gzip -9 $(DISTNAME)-src.tar; zip -qr8 $(ZIPNAME) $(DISTNAME)


#--------------------------------------------------------------------------
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
# tk8.* up two directories from the TOOL_DIR.
#







|





>
|
|
>







2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
		$(DISTDIR)/tools/makeTestCases.tcl $(DISTDIR)/tools/tclZIC.tcl \
		$(DISTDIR)/tools/tcltk-man2html.tcl
	$(INSTALL_DATA_DIR) $(DISTDIR)/libtommath
	$(DIST_INSTALL_DATA) $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath
	$(INSTALL_DATA_DIR) $(DISTDIR)/pkgs
	$(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs
	$(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs
	for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null` ; do \
	    tar -C $(DISTDIR)/pkgs -xzf "$$i"; \
	done

alldist: dist
	rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME)
	( cd $(DISTROOT); \
		tar cf $(DISTNAME)-src.tar $(DISTNAME); \
		gzip -9 $(DISTNAME)-src.tar; \
		zip -qr8 $(ZIPNAME) $(DISTNAME) )

#--------------------------------------------------------------------------
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
# tk8.* up two directories from the TOOL_DIR.
#
2142
2143
2144
2145
2146
2147
2148

2149
2150
2151
.PHONY: clean distclean depend genstubs checkstubs checkexports checkuchar
.PHONY: shell gdb valgrind valgrindshell dist alldist rpm
.PHONY: tclLibObjs tcltest-real test-tcl gdb-test ro-test trace-test xttest
.PHONY: topDirName gendate gentommath_h trace-shell checkdoc
.PHONY: install-tzdata install-msgs
.PHONY: packages configure-packages test-packages clean-packages
.PHONY: dist-packages distclean-packages install-packages


#--------------------------------------------------------------------------
# DO NOT DELETE THIS LINE -- make depend depends on it.







>



2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
.PHONY: clean distclean depend genstubs checkstubs checkexports checkuchar
.PHONY: shell gdb valgrind valgrindshell dist alldist rpm
.PHONY: tclLibObjs tcltest-real test-tcl gdb-test ro-test trace-test xttest
.PHONY: topDirName gendate gentommath_h trace-shell checkdoc
.PHONY: install-tzdata install-msgs
.PHONY: packages configure-packages test-packages clean-packages
.PHONY: dist-packages distclean-packages install-packages
.PHONY: install-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile

#--------------------------------------------------------------------------
# DO NOT DELETE THIS LINE -- make depend depends on it.
Changes to unix/configure.
660
661
662
663
664
665
666










667
668
669
670
671
672
673
TCL_LIB_FILE
PKG_CFG_ARGS
TCL_YEAR
TCL_PATCH_LEVEL
TCL_MINOR_VERSION
TCL_MAJOR_VERSION
TCL_VERSION










DTRACE
LDFLAGS_DEFAULT
CFLAGS_DEFAULT
INSTALL_STUB_LIB
DLL_INSTALL_DIR
INSTALL_LIB
MAKE_STUB_LIB







>
>
>
>
>
>
>
>
>
>







660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
TCL_LIB_FILE
PKG_CFG_ARGS
TCL_YEAR
TCL_PATCH_LEVEL
TCL_MINOR_VERSION
TCL_MAJOR_VERSION
TCL_VERSION
INSTALL_MSGS
INSTALL_LIBRARIES
TCL_ZIP_FILE
ZIPFS_BUILD
ZIP_INSTALL_OBJS
ZIP_PROG_VFSSEARCH
ZIP_PROG_OPTIONS
ZIP_PROG
EXEEXT_FOR_BUILD
CC_FOR_BUILD
DTRACE
LDFLAGS_DEFAULT
CFLAGS_DEFAULT
INSTALL_STUB_LIB
DLL_INSTALL_DIR
INSTALL_LIB
MAKE_STUB_LIB
695
696
697
698
699
700
701

702
703
704
705
706
707
708
LIBOBJS
AR
RANLIB
ZLIB_INCLUDE
ZLIB_SRCS
ZLIB_OBJS
TCLSH_PROG

EGREP
GREP
CPP
OBJEXT
EXEEXT
ac_ct_CC
CPPFLAGS







>







705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
LIBOBJS
AR
RANLIB
ZLIB_INCLUDE
ZLIB_SRCS
ZLIB_OBJS
TCLSH_PROG
SHARED_BUILD
EGREP
GREP
CPP
OBJEXT
EXEEXT
ac_ct_CC
CPPFLAGS
743
744
745
746
747
748
749
750

751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768

769
770
771
772
773
774
775
PACKAGE_URL
PACKAGE_BUGREPORT
PACKAGE_STRING
PACKAGE_VERSION
PACKAGE_TARNAME
PACKAGE_NAME
PATH_SEPARATOR
SHELL'

ac_subst_files=''
ac_user_opts='
enable_option_checking
enable_man_symlinks
enable_man_compression
enable_man_suffix
with_encoding
enable_shared
enable_64bit
enable_64bit_vis
enable_rpath
enable_corefoundation
enable_load
enable_symbols
enable_langinfo
enable_dll_unloading
with_tzdata
enable_dtrace

enable_framework
'
      ac_precious_vars='build_alias
host_alias
target_alias
CC
CFLAGS







|
>


















>







754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
PACKAGE_URL
PACKAGE_BUGREPORT
PACKAGE_STRING
PACKAGE_VERSION
PACKAGE_TARNAME
PACKAGE_NAME
PATH_SEPARATOR
SHELL
OBJEXT_FOR_BUILD'
ac_subst_files=''
ac_user_opts='
enable_option_checking
enable_man_symlinks
enable_man_compression
enable_man_suffix
with_encoding
enable_shared
enable_64bit
enable_64bit_vis
enable_rpath
enable_corefoundation
enable_load
enable_symbols
enable_langinfo
enable_dll_unloading
with_tzdata
enable_dtrace
enable_zipfs
enable_framework
'
      ac_precious_vars='build_alias
host_alias
target_alias
CC
CFLAGS
1401
1402
1403
1404
1405
1406
1407

1408
1409
1410
1411
1412
1413
1414
  --enable-load           allow dynamic loading and "load" command (default:
                          on)
  --enable-symbols        build with debugging symbols (default: off)
  --enable-langinfo       use nl_langinfo if possible to determine encoding at
                          startup, otherwise use old heuristic (default: on)
  --enable-dll-unloading  enable the 'unload' command (default: on)
  --enable-dtrace         build with DTrace support (default: off)

  --enable-framework      package shared libraries in MacOSX frameworks
                          (default: off)

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
  --with-encoding         encoding for configuration values (default:







>







1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
  --enable-load           allow dynamic loading and "load" command (default:
                          on)
  --enable-symbols        build with debugging symbols (default: off)
  --enable-langinfo       use nl_langinfo if possible to determine encoding at
                          startup, otherwise use old heuristic (default: on)
  --enable-dll-unloading  enable the 'unload' command (default: on)
  --enable-dtrace         build with DTrace support (default: off)
  --enable-zipfs          build with Zipfs support (default: on)
  --enable-framework      package shared libraries in MacOSX frameworks
                          (default: off)

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
  --with-encoding         encoding for configuration values (default:
1848
1849
1850
1851
1852
1853
1854














































1855
1856
1857
1858
1859
1860
1861
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_func















































# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
# -------------------------------------------
# Tests whether TYPE exists after having included INCLUDES, setting cache
# variable VAR accordingly.
ac_fn_c_check_type ()
{







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_func

# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES
# ---------------------------------------------
# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR
# accordingly.
ac_fn_c_check_decl ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  as_decl_name=`echo $2|sed 's/ *(.*//'`
  as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
$as_echo_n "checking whether $as_decl_name is declared... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
int
main ()
{
#ifndef $as_decl_name
#ifdef __cplusplus
  (void) $as_decl_use;
#else
  (void) $as_decl_name;
#endif
#endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  eval "$3=yes"
else
  eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_decl

# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
# -------------------------------------------
# Tests whether TYPE exists after having included INCLUDES, setting cache
# variable VAR accordingly.
ac_fn_c_check_type ()
{
3265
3266
3267
3268
3269
3270
3271

3272
3273
3274
3275
3276
3277
3278
#ifndef __cplusplus
#define inline $ac_val
#endif
_ACEOF
    ;;
esac



#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files.  Special notes:
#	- stdlib.h doesn't define strtol, strtoul, or
#	  strtod insome versions of SunOS
#	- some versions of string.h don't declare procedures such
#	  as strstr







>







3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
#ifndef __cplusplus
#define inline $ac_val
#endif
_ACEOF
    ;;
esac



#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files.  Special notes:
#	- stdlib.h doesn't define strtol, strtoul, or
#	  strtod insome versions of SunOS
#	- some versions of string.h don't declare procedures such
#	  as strstr
4392
4393
4394
4395
4396
4397
4398



















4399
4400
4401
4402
4403
4404
4405
_ACEOF

fi
done

    LIBS=$ac_saved_libs





















# Add the threads support libraries
LIBS="$LIBS$THREADS_LIBS"


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5
$as_echo_n "checking how to build libraries... " >&6; }







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
_ACEOF

fi
done

    LIBS=$ac_saved_libs

    # TIP #509
    ac_fn_c_check_decl "$LINENO" "PTHREAD_MUTEX_RECURSIVE" "ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" "#include <pthread.h>
"
if test "x$ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" = xyes; then :
  ac_have_decl=1
else
  ac_have_decl=0
fi

cat >>confdefs.h <<_ACEOF
#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE $ac_have_decl
_ACEOF
if test $ac_have_decl = 1; then :
  tcl_ok=yes
else
  tcl_ok=no
fi



# Add the threads support libraries
LIBS="$LIBS$THREADS_LIBS"


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5
$as_echo_n "checking how to build libraries... " >&6; }
4426
4427
4428
4429
4430
4431
4432

4433
4434
4435
4436
4437
4438
4439
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5
$as_echo "static" >&6; }
	SHARED_BUILD=0

$as_echo "#define STATIC_BUILD 1" >>confdefs.h

    fi



#--------------------------------------------------------------------
# Look for a native installed tclsh binary (if available)
# If one cannot be found then use the binary we build (fails for
# cross compiling). This is used for NATIVE_TCLSH in Makefile.
#--------------------------------------------------------------------







>







4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5
$as_echo "static" >&6; }
	SHARED_BUILD=0

$as_echo "#define STATIC_BUILD 1" >>confdefs.h

    fi



#--------------------------------------------------------------------
# Look for a native installed tclsh binary (if available)
# If one cannot be found then use the binary we build (fails for
# cross compiling). This is used for NATIVE_TCLSH in Makefile.
#--------------------------------------------------------------------
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    if test "$GCC" = yes; then :

	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement"

else

	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""

fi







|







4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    if test "$GCC" = yes; then :

	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith"

else

	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""

fi
10042
10043
10044
10045
10046
10047
10048





































































































































































10049
10050
10051
10052
10053
10054
10055
	    AR='/usr/ccs/bin/ar'
	    RANLIB='/usr/ccs/bin/ranlib'
	fi
    fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5
$as_echo "$tcl_ok" >&6; }






































































































































































#--------------------------------------------------------------------
# The check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the cpuid instruction is usable" >&5
$as_echo_n "checking whether the cpuid instruction is usable... " >&6; }







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







10123
10124
10125
10126
10127
10128
10129
10130
10131
10132
10133
10134
10135
10136
10137
10138
10139
10140
10141
10142
10143
10144
10145
10146
10147
10148
10149
10150
10151
10152
10153
10154
10155
10156
10157
10158
10159
10160
10161
10162
10163
10164
10165
10166
10167
10168
10169
10170
10171
10172
10173
10174
10175
10176
10177
10178
10179
10180
10181
10182
10183
10184
10185
10186
10187
10188
10189
10190
10191
10192
10193
10194
10195
10196
10197
10198
10199
10200
10201
10202
10203
10204
10205
10206
10207
10208
10209
10210
10211
10212
10213
10214
10215
10216
10217
10218
10219
10220
10221
10222
10223
10224
10225
10226
10227
10228
10229
10230
10231
10232
10233
10234
10235
10236
10237
10238
10239
10240
10241
10242
10243
10244
10245
10246
10247
10248
10249
10250
10251
10252
10253
10254
10255
10256
10257
10258
10259
10260
10261
10262
10263
10264
10265
10266
10267
10268
10269
10270
10271
10272
10273
10274
10275
10276
10277
10278
10279
10280
10281
10282
10283
10284
10285
10286
10287
10288
10289
10290
10291
10292
10293
10294
10295
10296
10297
10298
10299
10300
10301
	    AR='/usr/ccs/bin/ar'
	    RANLIB='/usr/ccs/bin/ranlib'
	fi
    fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5
$as_echo "$tcl_ok" >&6; }

#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
# Check whether --enable-zipfs was given.
if test "${enable_zipfs+set}" = set; then :
  enableval=$enable_zipfs; tcl_ok=$enableval
else
  tcl_ok=yes
fi

if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    # Put a plausible default for CC_FOR_BUILD in Makefile.
    if test -z "$CC_FOR_BUILD"; then
      if test "x$cross_compiling" = "xno"; then
        CC_FOR_BUILD='$(CC)'
      else
        { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
$as_echo_n "checking for gcc... " >&6; }
        if ${ac_cv_path_cc+:} false; then :
  $as_echo_n "(cached) " >&6
else

            search_path=`echo ${PATH} | sed -e 's/:/ /g'`
            for dir in $search_path ; do
                for j in `ls -r $dir/gcc 2> /dev/null` \
                        `ls -r $dir/gcc 2> /dev/null` ; do
                    if test x"$ac_cv_path_cc" = x ; then
                        if test -f "$j" ; then
                            ac_cv_path_cc=$j
                            break
                        fi
                    fi
                done
            done

fi

      fi
    fi

    # Also set EXEEXT_FOR_BUILD.
    if test "x$cross_compiling" = "xno"; then
      EXEEXT_FOR_BUILD='$(EXEEXT)'
      OBJEXT_FOR_BUILD='$(OBJEXT)'
    else
      OBJEXT_FOR_BUILD='.no'
      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
$as_echo_n "checking for build system executable suffix... " >&6; }
if ${bfd_cv_build_exeext+:} false; then :
  $as_echo_n "(cached) " >&6
else
  rm -f conftest*
         echo 'int main () { return 0; }' > conftest.c
         bfd_cv_build_exeext=
         ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
         for file in conftest.*; do
           case $file in
           *.c | *.o | *.obj | *.ilk | *.pdb) ;;
           *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
           esac
         done
         rm -f conftest*
         test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
$as_echo "$bfd_cv_build_exeext" >&6; }
      EXEEXT_FOR_BUILD=""
      test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
    fi

    #
    # Find a native zip implementation
    #

    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
$as_echo_n "checking for zip... " >&6; }
    if ${ac_cv_path_zip+:} false; then :
  $as_echo_n "(cached) " >&6
else

    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
        for j in `ls -r $dir/zip 2> /dev/null` \
            `ls -r $dir/zip 2> /dev/null` ; do
        if test x"$ac_cv_path_zip" = x ; then
            if test -f "$j" ; then
            ac_cv_path_zip=$j
            break
            fi
        fi
        done
    done

fi

    if test -f "$ac_cv_path_zip" ; then
        ZIP_PROG="$ac_cv_path_zip "
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
$as_echo "$ZIP_PROG" >&6; }
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="."
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
$as_echo "Found INFO Zip in environment" >&6; }
        # Use standard arguments for zip
    else
        # It is not an error if an installed version of Zip can't be located.
        # We can use the locally distributed minizip instead
        ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
        ZIP_PROG_OPTIONS="-o -r"
        ZIP_PROG_VFSSEARCH="."
        ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH. Building minizip" >&5
$as_echo "No zip found on PATH. Building minizip" >&6; }
    fi





	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
$as_echo_n "checking for building with zipfs... " >&6; }
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;

$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h

       INSTALL_LIBRARIES=install-libraries-zipfs-static
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
     else

$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h
\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
    fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi






#--------------------------------------------------------------------
# The check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the cpuid instruction is usable" >&5
$as_echo_n "checking whether the cpuid instruction is usable... " >&6; }
10268
10269
10270
10271
10272
10273
10274

10275
10276
10277
10278
10279
10280
10281
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""

#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
#------------------------------------------------------------------------

TCL_SHARED_BUILD=${SHARED_BUILD}















>







10514
10515
10516
10517
10518
10519
10520
10521
10522
10523
10524
10525
10526
10527
10528
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""

#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
#------------------------------------------------------------------------

TCL_SHARED_BUILD=${SHARED_BUILD}








Changes to unix/configure.ac.
81
82
83
84
85
86
87

88
89
90
91
92
93
94
# the AC_PROG_CC macro from adding "-g -O2".
if test "${CFLAGS+set}" != "set" ; then
    CFLAGS=""
fi

AC_PROG_CC
AC_C_INLINE


#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files.  Special notes:
#	- stdlib.h doesn't define strtol, strtoul, or
#	  strtod insome versions of SunOS
#	- some versions of string.h don't declare procedures such
#	  as strstr







>







81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
# the AC_PROG_CC macro from adding "-g -O2".
if test "${CFLAGS+set}" != "set" ; then
    CFLAGS=""
fi

AC_PROG_CC
AC_C_INLINE


#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files.  Special notes:
#	- stdlib.h doesn't define strtol, strtoul, or
#	  strtod insome versions of SunOS
#	- some versions of string.h don't declare procedures such
#	  as strstr
776
777
778
779
780
781
782














































783
784
785
786
787
788
789
	    # tclDTrace.o and the combined object file above.
	    AR='/usr/ccs/bin/ar'
	    RANLIB='/usr/ccs/bin/ranlib'
	fi
    fi
fi
AC_MSG_RESULT([$tcl_ok])















































#--------------------------------------------------------------------
# The check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------

AC_CACHE_CHECK([whether the cpuid instruction is usable], tcl_cv_cpuid, [
    AC_TRY_LINK(, [







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
	    # tclDTrace.o and the combined object file above.
	    AR='/usr/ccs/bin/ar'
	    RANLIB='/usr/ccs/bin/ranlib'
	fi
    fi
fi
AC_MSG_RESULT([$tcl_ok])

#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
AC_ARG_ENABLE(zipfs,
    AC_HELP_STRING([--enable-zipfs],
	[build with Zipfs support (default: on)]),
    [tcl_ok=$enableval], [tcl_ok=yes])
if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    AX_CC_FOR_BUILD
    #
    # Find a native zip implementation
    #
    SC_ZIPFS_SUPPORT
	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
AC_MSG_CHECKING([for building with zipfs])
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;
       AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?])
       INSTALL_LIBRARIES=install-libraries-zipfs-static
       AC_MSG_RESULT([yes])
     else
       AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       AC_MSG_RESULT([yes])
    fi
else
AC_MSG_RESULT([no])
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi
AC_SUBST(ZIPFS_BUILD)
AC_SUBST(TCL_ZIP_FILE)
AC_SUBST(INSTALL_LIBRARIES)
AC_SUBST(INSTALL_MSGS)


#--------------------------------------------------------------------
# The check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------

AC_CACHE_CHECK([whether the cpuid instruction is usable], tcl_cv_cpuid, [
    AC_TRY_LINK(, [
947
948
949
950
951
952
953

954
955
956
957
958
959
960
AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_YEAR)
AC_SUBST(PKG_CFG_ARGS)


AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FLAG)
AC_SUBST(TCL_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_FILE)
AC_SUBST(TCL_STUB_LIB_FLAG)
AC_SUBST(TCL_STUB_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_PATH)







>







994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_YEAR)
AC_SUBST(PKG_CFG_ARGS)

AC_SUBST(TCL_ZIP_FILE)
AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FLAG)
AC_SUBST(TCL_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_FILE)
AC_SUBST(TCL_STUB_LIB_FLAG)
AC_SUBST(TCL_STUB_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_PATH)
Changes to unix/tcl.m4.
543
544
545
546
547
548
549

550
551
552
553
554
555
556
	AC_MSG_RESULT([shared])
	SHARED_BUILD=1
    else
	AC_MSG_RESULT([static])
	SHARED_BUILD=0
	AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
    fi

])

#------------------------------------------------------------------------
# SC_ENABLE_FRAMEWORK --
#
#	Allows the building of shared libraries into frameworks
#







>







543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
	AC_MSG_RESULT([shared])
	SHARED_BUILD=1
    else
	AC_MSG_RESULT([static])
	SHARED_BUILD=0
	AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
    fi
    AC_SUBST(SHARED_BUILD)
])

#------------------------------------------------------------------------
# SC_ENABLE_FRAMEWORK --
#
#	Allows the building of shared libraries into frameworks
#
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
    UNSHARED_LIB_SUFFIX=""
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    AS_IF([test "$GCC" = yes], [
	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement"
    ], [
	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""
    ])
    AC_CHECK_TOOL(AR, ar)
    STLIB_LD='${AR} cr'
    LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"







|







982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
    UNSHARED_LIB_SUFFIX=""
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    AS_IF([test "$GCC" = yes], [
	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith"
    ], [
	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""
    ])
    AC_CHECK_TOOL(AR, ar)
    STLIB_LD='${AR} cr'
    LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
2351
2352
2353
2354
2355
2356
2357



2358
2359
2360
2361
2362
2363
2364
    # Does the pthread-implementation provide
    # 'pthread_attr_setstacksize' ?

    ac_saved_libs=$LIBS
    LIBS="$LIBS $THREADS_LIBS"
    AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
    LIBS=$ac_saved_libs



])

#--------------------------------------------------------------------
# SC_TCL_EARLY_FLAGS
#
#	Check for what flags are needed to be passed so the correct OS
#	features are available.







>
>
>







2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
    # Does the pthread-implementation provide
    # 'pthread_attr_setstacksize' ?

    ac_saved_libs=$LIBS
    LIBS="$LIBS $THREADS_LIBS"
    AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
    LIBS=$ac_saved_libs

    # TIP #509
    AC_CHECK_DECLS([PTHREAD_MUTEX_RECURSIVE],tcl_ok=yes,tcl_ok=no, [[#include <pthread.h>]])
])

#--------------------------------------------------------------------
# SC_TCL_EARLY_FLAGS
#
#	Check for what flags are needed to be passed so the correct OS
#	features are available.
2954
2955
2956
2957
2958
2959
2960



























































































































2961
2962
2963
if test "x$NEED_FAKE_RFC2553" = "x1"; then
   AC_DEFINE([NEED_FAKE_RFC2553], 1,
        [Use compat implementation of getaddrinfo() and friends])
   AC_LIBOBJ([fake-rfc2553])
   AC_CHECK_FUNC(strlcpy)
fi
])



























































































































# Local Variables:
# mode: autoconf
# End:







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
if test "x$NEED_FAKE_RFC2553" = "x1"; then
   AC_DEFINE([NEED_FAKE_RFC2553], 1,
        [Use compat implementation of getaddrinfo() and friends])
   AC_LIBOBJ([fake-rfc2553])
   AC_CHECK_FUNC(strlcpy)
fi
])

#------------------------------------------------------------------------
# SC_CC_FOR_BUILD
#	For cross compiles, locate a C compiler that can generate native binaries.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		CC_FOR_BUILD
#		EXEEXT_FOR_BUILD
#------------------------------------------------------------------------

dnl Get a default for CC_FOR_BUILD to put into Makefile.
AC_DEFUN([AX_CC_FOR_BUILD],[# Put a plausible default for CC_FOR_BUILD in Makefile.
    if test -z "$CC_FOR_BUILD"; then
      if test "x$cross_compiling" = "xno"; then
        CC_FOR_BUILD='$(CC)'
      else
        AC_MSG_CHECKING([for gcc])
        AC_CACHE_VAL(ac_cv_path_cc, [
            search_path=`echo ${PATH} | sed -e 's/:/ /g'`
            for dir in $search_path ; do
                for j in `ls -r $dir/gcc 2> /dev/null` \
                        `ls -r $dir/gcc 2> /dev/null` ; do
                    if test x"$ac_cv_path_cc" = x ; then
                        if test -f "$j" ; then
                            ac_cv_path_cc=$j
                            break
                        fi
                    fi
                done
            done
        ])
      fi
    fi
    AC_SUBST(CC_FOR_BUILD)
    # Also set EXEEXT_FOR_BUILD.
    if test "x$cross_compiling" = "xno"; then
      EXEEXT_FOR_BUILD='$(EXEEXT)'
      OBJEXT_FOR_BUILD='$(OBJEXT)'
    else
      OBJEXT_FOR_BUILD='.no'
      AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext,
        [rm -f conftest*
         echo 'int main () { return 0; }' > conftest.c
         bfd_cv_build_exeext=
         ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
         for file in conftest.*; do
           case $file in
           *.c | *.o | *.obj | *.ilk | *.pdb) ;;
           *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
           esac
         done
         rm -f conftest*
         test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no])
      EXEEXT_FOR_BUILD=""
      test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
    fi
    AC_SUBST(EXEEXT_FOR_BUILD)])dnl
    AC_SUBST(OBJEXT_FOR_BUILD)])dnl
])


#------------------------------------------------------------------------
# SC_ZIPFS_SUPPORT
#	Locate a zip encoder installed on the system path, or none.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		ZIP_PROG
#       ZIP_PROG_OPTIONS
#       ZIP_PROG_VFSSEARCH
#       ZIP_INSTALL_OBJS
#------------------------------------------------------------------------

AC_DEFUN([SC_ZIPFS_SUPPORT], [
    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    AC_MSG_CHECKING([for zip])
    AC_CACHE_VAL(ac_cv_path_zip, [
    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
        for j in `ls -r $dir/zip 2> /dev/null` \
            `ls -r $dir/zip 2> /dev/null` ; do
        if test x"$ac_cv_path_zip" = x ; then
            if test -f "$j" ; then
            ac_cv_path_zip=$j
            break
            fi
        fi
        done
    done
    ])
    if test -f "$ac_cv_path_zip" ; then
        ZIP_PROG="$ac_cv_path_zip "
        AC_MSG_RESULT([$ZIP_PROG])
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="."
        AC_MSG_RESULT([Found INFO Zip in environment])
        # Use standard arguments for zip
    else
        # It is not an error if an installed version of Zip can't be located.
        # We can use the locally distributed minizip instead
        ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
        ZIP_PROG_OPTIONS="-o -r"
        ZIP_PROG_VFSSEARCH="."
        ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
        AC_MSG_RESULT([No zip found on PATH. Building minizip])
    fi
    AC_SUBST(ZIP_PROG)
    AC_SUBST(ZIP_PROG_OPTIONS)
    AC_SUBST(ZIP_PROG_VFSSEARCH)
    AC_SUBST(ZIP_INSTALL_OBJS)
])

# Local Variables:
# mode: autoconf
# End:
Changes to unix/tcl.pc.in.
1
2
3
4
5
6


7
8
9
10
11
12
13
# tcl pkg-config source file

prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@



Name: Tool Command Language
Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
URL: http://www.tcl.tk/
Version: @TCL_VERSION@@TCL_PATCH_LEVEL@
Requires.private: zlib >= 1.2.3
Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_STUB_LIB_FLAG@






>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# tcl pkg-config source file

prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@
libfile=@TCL_LIB_FILE@
zipfile=@TCL_ZIP_FILE@

Name: Tool Command Language
Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
URL: http://www.tcl.tk/
Version: @TCL_VERSION@@TCL_PATCH_LEVEL@
Requires.private: zlib >= 1.2.3
Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_STUB_LIB_FLAG@
Changes to unix/tclAppInit.c.
75
76
77
78
79
80
81


82
83
84
85
86
87
88
{
#ifdef TCL_XT_TEST
    XtToolkitInitialize();
#endif

#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);


#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*







>
>







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
{
#ifdef TCL_XT_TEST
    XtToolkitInitialize();
#endif

#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#else
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*
Changes to unix/tclConfig.sh.in.
34
35
36
37
38
39
40



41
42
43
44
45
46
47
TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@'

# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=@TCL_SHARED_BUILD@

# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='@TCL_LIB_FILE@'




# Additional libraries to use when linking Tcl.
TCL_LIBS='@TCL_LIBS@'

# Top-level directory in which Tcl's platform-independent files are
# installed.
TCL_PREFIX='@prefix@'







>
>
>







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@'

# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=@TCL_SHARED_BUILD@

# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='@TCL_LIB_FILE@'

# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library):
TCL_ZIP_FILE='@TCL_ZIP_FILE@'

# Additional libraries to use when linking Tcl.
TCL_LIBS='@TCL_LIBS@'

# Top-level directory in which Tcl's platform-independent files are
# installed.
TCL_PREFIX='@prefix@'
Changes to unix/tclEpollNotfy.c.
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
    if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
	newEvent.events |= EPOLLIN;
    }
    if (filePtr->mask & TCL_WRITABLE) {
	newEvent.events |= EPOLLOUT;
    }
    if (isNew) {
        newPedPtr = ckalloc(sizeof(*newPedPtr));
        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
	filePtr->pedPtr = newPedPtr;
    }
    newEvent.data.ptr = filePtr->pedPtr;

    /*







|







224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
    if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
	newEvent.events |= EPOLLIN;
    }
    if (filePtr->mask & TCL_WRITABLE) {
	newEvent.events |= EPOLLOUT;
    }
    if (isNew) {
        newPedPtr = Tcl_Alloc(sizeof(*newPedPtr));
        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
	filePtr->pedPtr = newPedPtr;
    }
    newEvent.data.ptr = filePtr->pedPtr;

    /*
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
	tsdPtr->triggerPipe[0] = -1;
    }
    if (tsdPtr->triggerPipe[1]) {
	close(tsdPtr->triggerPipe[1]);
	tsdPtr->triggerPipe[1] = -1;
    }
#endif /* HAVE_EVENTFD */
    ckfree(tsdPtr->triggerFilePtr->pedPtr);
    ckfree(tsdPtr->triggerFilePtr);
    if (tsdPtr->eventsFd > 0) {
	close(tsdPtr->eventsFd);
	tsdPtr->eventsFd = 0;
    }
    if (tsdPtr->readyEvents) {
	ckfree(tsdPtr->readyEvents);
	tsdPtr->maxReadyEvents = 0;
    }
    pthread_mutex_unlock(&tsdPtr->notifierMutex);
    if ((errno = pthread_mutex_destroy(&tsdPtr->notifierMutex))) {
	Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno));
    }
}







|
|





|







303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
	tsdPtr->triggerPipe[0] = -1;
    }
    if (tsdPtr->triggerPipe[1]) {
	close(tsdPtr->triggerPipe[1]);
	tsdPtr->triggerPipe[1] = -1;
    }
#endif /* HAVE_EVENTFD */
    Tcl_Free(tsdPtr->triggerFilePtr->pedPtr);
    Tcl_Free(tsdPtr->triggerFilePtr);
    if (tsdPtr->eventsFd > 0) {
	close(tsdPtr->eventsFd);
	tsdPtr->eventsFd = 0;
    }
    if (tsdPtr->readyEvents) {
	Tcl_Free(tsdPtr->readyEvents);
	tsdPtr->maxReadyEvents = 0;
    }
    pthread_mutex_unlock(&tsdPtr->notifierMutex);
    if ((errno = pthread_mutex_destroy(&tsdPtr->notifierMutex))) {
	Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno));
    }
}
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr;

    errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
    if (errno) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex");
    }
    filePtr = ckalloc(sizeof(*filePtr));
#ifdef HAVE_EVENTFD
    if ((tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK)) <= 0) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger eventfd");
    }
    filePtr->fd = tsdPtr->triggerEventFd;
#else
    if (pipe2(tsdPtr->triggerPipe, O_CLOEXEC | O_NONBLOCK) != 0) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe");
    }
    filePtr->fd = tsdPtr->triggerPipe[0];
#endif
    tsdPtr->triggerFilePtr = filePtr;
    if ((tsdPtr->eventsFd = epoll_create1(EPOLL_CLOEXEC)) == -1) {
	Tcl_Panic("epoll_create1: %s", strerror(errno));
    }
    filePtr->mask = TCL_READABLE;
    PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1);
    if (!tsdPtr->readyEvents) {
        tsdPtr->maxReadyEvents = 512;
	tsdPtr->readyEvents = ckalloc(tsdPtr->maxReadyEvents
	    * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------







|



















|







355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr;

    errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
    if (errno) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex");
    }
    filePtr = Tcl_Alloc(sizeof(*filePtr));
#ifdef HAVE_EVENTFD
    if ((tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK)) <= 0) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger eventfd");
    }
    filePtr->fd = tsdPtr->triggerEventFd;
#else
    if (pipe2(tsdPtr->triggerPipe, O_CLOEXEC | O_NONBLOCK) != 0) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe");
    }
    filePtr->fd = tsdPtr->triggerPipe[0];
#endif
    tsdPtr->triggerFilePtr = filePtr;
    if ((tsdPtr->eventsFd = epoll_create1(EPOLL_CLOEXEC)) == -1) {
	Tcl_Panic("epoll_create1: %s", strerror(errno));
    }
    filePtr->mask = TCL_READABLE;
    PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1);
    if (!tsdPtr->readyEvents) {
        tsdPtr->maxReadyEvents = 512;
	tsdPtr->readyEvents = Tcl_Alloc(tsdPtr->maxReadyEvents
	    * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = ckalloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	    isNew = 1;
	} else {
	    isNew = 0;







|







534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = Tcl_Alloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	    isNew = 1;
	} else {
	    isNew = 0;
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630

	/*
	 * Update the check masks for this file.
	 */

	PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0);
	if (filePtr->pedPtr) {
	    ckfree(filePtr->pedPtr);
	}

	/*
	 * Clean up information in the callback record.
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	ckfree(filePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --







|











|







604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630

	/*
	 * Update the check masks for this file.
	 */

	PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0);
	if (filePtr->pedPtr) {
	    Tcl_Free(filePtr->pedPtr);
	}

	/*
	 * Clean up information in the callback record.
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	Tcl_Free(filePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
		    ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
		numQueued++;
	    }
	    filePtr->readyMask = mask;







|







716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
		    Tcl_Alloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
		numQueued++;
	    }
	    filePtr->readyMask = mask;
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
			ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask = mask;
	}







|







784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
			Tcl_Alloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask = mask;
	}
Changes to unix/tclKqueueNotfy.c.
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
{
    int numChanges;
    struct kevent changeList[2];
    struct PlatformEventData *newPedPtr;
    struct stat fdStat;

    if (isNew) {
        newPedPtr = ckalloc(sizeof(*newPedPtr));
        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
        filePtr->pedPtr = newPedPtr;
    }

    /*
     * N.B.	As discussed in Tcl_WaitForEvent(), kqueue(2) does not repro-







|







210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
{
    int numChanges;
    struct kevent changeList[2];
    struct PlatformEventData *newPedPtr;
    struct stat fdStat;

    if (isNew) {
        newPedPtr = Tcl_Alloc(sizeof(*newPedPtr));
        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
        filePtr->pedPtr = newPedPtr;
    }

    /*
     * N.B.	As discussed in Tcl_WaitForEvent(), kqueue(2) does not repro-
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
	tsdPtr->triggerPipe[1] = -1;
    }
    if (tsdPtr->eventsFd > 0) {
	close(tsdPtr->eventsFd);
	tsdPtr->eventsFd = 0;
    }
    if (tsdPtr->readyEvents) {
	ckfree(tsdPtr->readyEvents);
	tsdPtr->maxReadyEvents = 0;
    }
    pthread_mutex_unlock(&tsdPtr->notifierMutex);
    if ((errno = pthread_mutex_destroy(&tsdPtr->notifierMutex))) {
	Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno));
    }
}







|







328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
	tsdPtr->triggerPipe[1] = -1;
    }
    if (tsdPtr->eventsFd > 0) {
	close(tsdPtr->eventsFd);
	tsdPtr->eventsFd = 0;
    }
    if (tsdPtr->readyEvents) {
	Tcl_Free(tsdPtr->readyEvents);
	tsdPtr->maxReadyEvents = 0;
    }
    pthread_mutex_unlock(&tsdPtr->notifierMutex);
    if ((errno = pthread_mutex_destroy(&tsdPtr->notifierMutex))) {
	Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno));
    }
}
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
	}
    }
    if ((tsdPtr->eventsFd = kqueue()) == -1) {
	Tcl_Panic("kqueue: %s", strerror(errno));
    } else if (fcntl(tsdPtr->eventsFd, F_SETFD, FD_CLOEXEC) == -1) {
	Tcl_Panic("fcntl: %s", strerror(errno));
    }
    filePtr = ckalloc(sizeof(*filePtr));
    filePtr->fd = tsdPtr->triggerPipe[0];
    filePtr->mask = TCL_READABLE;
    PlatformEventsControl(filePtr, tsdPtr, EV_ADD, 1);
    if (!tsdPtr->readyEvents) {
        tsdPtr->maxReadyEvents = 512;
	tsdPtr->readyEvents = ckalloc(tsdPtr->maxReadyEvents
	    * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------







|





|







394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
	}
    }
    if ((tsdPtr->eventsFd = kqueue()) == -1) {
	Tcl_Panic("kqueue: %s", strerror(errno));
    } else if (fcntl(tsdPtr->eventsFd, F_SETFD, FD_CLOEXEC) == -1) {
	Tcl_Panic("fcntl: %s", strerror(errno));
    }
    filePtr = Tcl_Alloc(sizeof(*filePtr));
    filePtr->fd = tsdPtr->triggerPipe[0];
    filePtr->mask = TCL_READABLE;
    PlatformEventsControl(filePtr, tsdPtr, EV_ADD, 1);
    if (!tsdPtr->readyEvents) {
        tsdPtr->maxReadyEvents = 512;
	tsdPtr->readyEvents = Tcl_Alloc(tsdPtr->maxReadyEvents
	    * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = ckalloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	    isNew = 1;
	} else {
	    isNew = 0;







|







564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = Tcl_Alloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	    isNew = 1;
	} else {
	    isNew = 0;
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659

	/*
	 * Update the check masks for this file.
	 */

	PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0);
	if (filePtr->pedPtr) {
	    ckfree(filePtr->pedPtr);
	}

	/*
	 * Clean up information in the callback record.
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	ckfree(filePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --







|











|







633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659

	/*
	 * Update the check masks for this file.
	 */

	PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0);
	if (filePtr->pedPtr) {
	    Tcl_Free(filePtr->pedPtr);
	}

	/*
	 * Clean up information in the callback record.
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	Tcl_Free(filePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
		    ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
		numQueued++;
	    }
	    filePtr->readyMask = mask;







|







750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
		    Tcl_Alloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
		numQueued++;
	    }
	    filePtr->readyMask = mask;
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
			ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask |= mask;
	}







|







813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
			Tcl_Alloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask |= mask;
	}
Changes to unix/tclLoadDl.c.
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't load file \"%s\": %s",
		    Tcl_GetString(pathPtr), errorStr));
	}
	return TCL_ERROR;
    }
    newHandle = ckalloc(sizeof(*newHandle));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;

    return TCL_OK;







|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't load file \"%s\": %s",
		    Tcl_GetString(pathPtr), errorStr));
	}
	return TCL_ERROR;
    }
    newHandle = Tcl_Alloc(sizeof(*newHandle));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;

    return TCL_OK;
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    void *handle = loadHandle->clientData;

    dlclose(handle);
    ckfree(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *







|







228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    void *handle = loadHandle->clientData;

    dlclose(handle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
Changes to unix/tclLoadDyld.c.
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
		if (err == NSObjectFileImageSuccess && dyldObjFileImage) {
		    int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR;
		    if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE;
		    if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW;
		    module = NSLinkModule(dyldObjFileImage, nativePath, nsflags);
		    NSDestroyObjectFileImage(dyldObjFileImage);
		    if (module) {
			modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle));
			modulePtr->module = module;
			modulePtr->nextPtr = NULL;
		    } else {
			NSLinkEditError(&editError, &errorNumber, &errorName,
				&errMsg);
		    }
		} else {
		    objFileImageErrMsg = DyldOFIErrorMsg(err);
		}
	    }
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }

    if (dlHandle
#if TCL_DYLD_USE_NSMODULE
	    || dyldLibHeader || modulePtr
#endif /* TCL_DYLD_USE_NSMODULE */
    ) {
	dyldLoadHandle = ckalloc(sizeof(Tcl_DyldLoadHandle));
	dyldLoadHandle->dlHandle = dlHandle;
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
	dyldLoadHandle->dyldLibHeader = dyldLibHeader;
	dyldLoadHandle->modulePtr = modulePtr;
#endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */
	newHandle = ckalloc(sizeof(*newHandle));
	newHandle->clientData = dyldLoadHandle;
	newHandle->findSymbolProcPtr = &FindSymbol;
	newHandle->unloadFileProcPtr = &UnloadFile;
	*unloadProcPtr = &UnloadFile;
	*loadHandle = newHandle;
	result = TCL_OK;
    } else {







|



















|





|







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
		if (err == NSObjectFileImageSuccess && dyldObjFileImage) {
		    int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR;
		    if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE;
		    if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW;
		    module = NSLinkModule(dyldObjFileImage, nativePath, nsflags);
		    NSDestroyObjectFileImage(dyldObjFileImage);
		    if (module) {
			modulePtr = Tcl_Alloc(sizeof(Tcl_DyldModuleHandle));
			modulePtr->module = module;
			modulePtr->nextPtr = NULL;
		    } else {
			NSLinkEditError(&editError, &errorNumber, &errorName,
				&errMsg);
		    }
		} else {
		    objFileImageErrMsg = DyldOFIErrorMsg(err);
		}
	    }
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }

    if (dlHandle
#if TCL_DYLD_USE_NSMODULE
	    || dyldLibHeader || modulePtr
#endif /* TCL_DYLD_USE_NSMODULE */
    ) {
	dyldLoadHandle = Tcl_Alloc(sizeof(Tcl_DyldLoadHandle));
	dyldLoadHandle->dlHandle = dlHandle;
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
	dyldLoadHandle->dyldLibHeader = dyldLibHeader;
	dyldLoadHandle->modulePtr = modulePtr;
#endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */
	newHandle = Tcl_Alloc(sizeof(*newHandle));
	newHandle->clientData = dyldLoadHandle;
	newHandle->findSymbolProcPtr = &FindSymbol;
	newHandle->unloadFileProcPtr = &UnloadFile;
	*unloadProcPtr = &UnloadFile;
	*loadHandle = newHandle;
	result = TCL_OK;
    } else {
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
		while (modulePtr != NULL) {
		    if (module == modulePtr->module) {
			break;
		    }
		    modulePtr = modulePtr->nextPtr;
		}
		if (modulePtr == NULL) {
		    modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle));
		    modulePtr->module = module;
		    modulePtr->nextPtr = dyldLoadHandle->modulePtr;
		    dyldLoadHandle->modulePtr = modulePtr;
		}
#endif /* DYLD_SUPPORTS_DYLIB_UNLOADING */
	    } else {
		NSLinkEditErrors editError;







|







377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
		while (modulePtr != NULL) {
		    if (module == modulePtr->module) {
			break;
		    }
		    modulePtr = modulePtr->nextPtr;
		}
		if (modulePtr == NULL) {
		    modulePtr = Tcl_Alloc(sizeof(Tcl_DyldModuleHandle));
		    modulePtr->module = module;
		    modulePtr->nextPtr = dyldLoadHandle->modulePtr;
		    dyldLoadHandle->modulePtr = modulePtr;
		}
#endif /* DYLD_SUPPORTS_DYLIB_UNLOADING */
	    } else {
		NSLinkEditErrors editError;
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471

	while (modulePtr != NULL) {
	    void *ptr = modulePtr;

	    (void) NSUnLinkModule(modulePtr->module,
		    NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES);
	    modulePtr = modulePtr->nextPtr;
	    ckfree(ptr);
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }
    ckfree(dyldLoadHandle);
    ckfree(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *







|



|
|







452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471

	while (modulePtr != NULL) {
	    void *ptr = modulePtr;

	    (void) NSUnLinkModule(modulePtr->module,
		    NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES);
	    modulePtr = modulePtr->nextPtr;
	    Tcl_Free(ptr);
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }
    Tcl_Free(dyldLoadHandle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
	return TCL_ERROR;
    }

    /*
     * Stash the module reference within the load handle we create and return.
     */

    modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle));
    modulePtr->module = module;
    modulePtr->nextPtr = NULL;
    dyldLoadHandle = ckalloc(sizeof(Tcl_DyldLoadHandle));
    dyldLoadHandle->dlHandle = NULL;
    dyldLoadHandle->dyldLibHeader = NULL;
    dyldLoadHandle->modulePtr = modulePtr;
    newHandle = ckalloc(sizeof(*newHandle));
    newHandle->clientData = dyldLoadHandle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}







|


|



|







689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
	return TCL_ERROR;
    }

    /*
     * Stash the module reference within the load handle we create and return.
     */

    modulePtr = Tcl_Alloc(sizeof(Tcl_DyldModuleHandle));
    modulePtr->module = module;
    modulePtr->nextPtr = NULL;
    dyldLoadHandle = Tcl_Alloc(sizeof(Tcl_DyldLoadHandle));
    dyldLoadHandle->dlHandle = NULL;
    dyldLoadHandle->dyldLibHeader = NULL;
    dyldLoadHandle->modulePtr = modulePtr;
    newHandle = Tcl_Alloc(sizeof(*newHandle));
    newHandle->clientData = dyldLoadHandle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}
Changes to unix/tclLoadNext.c.
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s", fileName, data));
	NXCloseMemory(errorStream, NX_FREEBUFFER);
	return TCL_ERROR;
    }
    NXCloseMemory(errorStream, NX_FREEBUFFER);

    newHandle = ckalloc(sizeof(Tcl_LoadHandle));
    newHandle->clientData = INT2PTR(1);
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;

    return TCL_OK;







|







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s", fileName, data));
	NXCloseMemory(errorStream, NX_FREEBUFFER);
	return TCL_ERROR;
    }
    NXCloseMemory(errorStream, NX_FREEBUFFER);

    newHandle = Tcl_Alloc(sizeof(Tcl_LoadHandle));
    newHandle->clientData = INT2PTR(1);
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;

    return TCL_OK;
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185

void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    ckfree(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *







|







171
172
173
174
175
176
177
178
179
180
181
182
183
184
185

void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
Changes to unix/tclLoadOSF.c.
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
     */

    if ((pkg = strrchr(fileName, '/')) == NULL) {
        pkg = fileName;
    } else {
	pkg++;
    }
    newHandle = ckalloc(sizeof(*newHandle));
    newHandle->clientData = pkg;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}







|







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
     */

    if ((pkg = strrchr(fileName, '/')) == NULL) {
        pkg = fileName;
    } else {
	pkg++;
    }
    newHandle = Tcl_Alloc(sizeof(*newHandle));
    newHandle->clientData = pkg;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203

static void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    ckfree(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *







|







189
190
191
192
193
194
195
196
197
198
199
200
201
202
203

static void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
Changes to unix/tclLoadShl.c.
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

    if (handle == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s",
		fileName, Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    newHandle = ckalloc(sizeof(*newHandle));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    return TCL_OK;
}








|







93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

    if (handle == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s",
		fileName, Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    newHandle = Tcl_Alloc(sizeof(*newHandle));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    return TCL_OK;
}

178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    shl_t handle = (shl_t) loadHandle->clientData;

    shl_unload(handle);
    ckfree(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *







|







178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    shl_t handle = (shl_t) loadHandle->clientData;

    shl_unload(handle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
Changes to unix/tclSelectNotfy.c.
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = ckalloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	}
	filePtr->proc = proc;
	filePtr->clientData = clientData;







|







460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = Tcl_Alloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	}
	filePtr->proc = proc;
	filePtr->clientData = clientData;
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	ckfree(filePtr);
    }
}

#if defined(__CYGWIN__)

static DWORD __stdcall
NotifierProc(







|







579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	Tcl_Free(filePtr);
    }
}

#if defined(__CYGWIN__)

static DWORD __stdcall
NotifierProc(
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
			ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask = mask;
	}







|







873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
			Tcl_Alloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask = mask;
	}
Changes to unix/tclUnixChan.c.
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354

    if (!TclInThreadExit()
	    || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
	if (close(fsPtr->fd) < 0) {
	    errorCode = errno;
	}
    }
    ckfree(fsPtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * FileSeekProc --







|







340
341
342
343
344
345
346
347
348
349
350
351
352
353
354

    if (!TclInThreadExit()
	    || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
	if (close(fsPtr->fd) < 0) {
	    errorCode = errno;
	}
    }
    Tcl_Free(fsPtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * FileSeekProc --
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
    Tcl_WideInt oldLoc, newLoc;

    /*
     * Save our current place in case we need to roll-back the seek.
     */

    oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
    if (oldLoc == Tcl_LongAsWide(-1)) {
	/*
	 * Bad things are happening. Error out...
	 */

	*errorCodePtr = errno;
	return -1;
    }

    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);

    /*
     * Check for expressability in our return type, and roll-back otherwise.
     */

    if (newLoc > Tcl_LongAsWide(INT_MAX)) {
	*errorCodePtr = EOVERFLOW;
	TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
	return -1;
    } else {
	*errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0;
    }
    return (int) Tcl_WideAsLong(newLoc);
}

/*
 *----------------------------------------------------------------------
 *
 * FileWideSeekProc --
 *







|














|




|

|







379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
    Tcl_WideInt oldLoc, newLoc;

    /*
     * Save our current place in case we need to roll-back the seek.
     */

    oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
    if (oldLoc == -1) {
	/*
	 * Bad things are happening. Error out...
	 */

	*errorCodePtr = errno;
	return -1;
    }

    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);

    /*
     * Check for expressability in our return type, and roll-back otherwise.
     */

    if (newLoc > INT_MAX) {
	*errorCodePtr = EOVERFLOW;
	TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
	return -1;
    } else {
	*errorCodePtr = (newLoc == -1) ? errno : 0;
    }
    return (int) newLoc;
}

/*
 *----------------------------------------------------------------------
 *
 * FileWideSeekProc --
 *
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -xchar: should be a list of"
			" two elements", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	tcgetattr(fsPtr->fd, &iostate);

	Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds);
	iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds);
	TclDStringClear(&ds);

	Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds);
	iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds);
	Tcl_DStringFree(&ds);
	ckfree(argv);

	tcsetattr(fsPtr->fd, TCSADRAIN, &iostate);
	return TCL_OK;
    }

    /*
     * Option -timeout msec







|












|







662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -xchar: should be a list of"
			" two elements", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    Tcl_Free(argv);
	    return TCL_ERROR;
	}

	tcgetattr(fsPtr->fd, &iostate);

	Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds);
	iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds);
	TclDStringClear(&ds);

	Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds);
	iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds);
	Tcl_DStringFree(&ds);
	Tcl_Free(argv);

	tcsetattr(fsPtr->fd, TCSADRAIN, &iostate);
	return TCL_OK;
    }

    /*
     * Option -timeout msec
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -ttycontrol: should be a list of"
			" signal,value pairs", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	ioctl(fsPtr->fd, TIOCMGET, &control);
	for (i = 0; i < argc-1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
		ckfree(argv);
		return TCL_ERROR;
	    }
	    if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
		if (flag) {
		    SET_BITS(control, TIOCM_DTR);
		} else {
		    CLEAR_BITS(control, TIOCM_DTR);







|






|







717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -ttycontrol: should be a list of"
			" signal,value pairs", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    Tcl_Free(argv);
	    return TCL_ERROR;
	}

	ioctl(fsPtr->fd, TIOCMGET, &control);
	for (i = 0; i < argc-1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
		Tcl_Free(argv);
		return TCL_ERROR;
	    }
	    if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
		if (flag) {
		    SET_BITS(control, TIOCM_DTR);
		} else {
		    CLEAR_BITS(control, TIOCM_DTR);
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
		if (flag) {
		    ioctl(fsPtr->fd, TIOCSBRK, NULL);
		} else {
		    ioctl(fsPtr->fd, TIOCCBRK, NULL);
		}
#else /* TIOCSBRK & TIOCCBRK */
		UNSUPPORTED_OPTION("-ttycontrol BREAK");
		ckfree(argv);
		return TCL_ERROR;
#endif /* TIOCSBRK & TIOCCBRK */
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "bad signal \"%s\" for -ttycontrol: must be"
			    " DTR, RTS or BREAK", argv[i]));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
		}
		ckfree(argv);
		return TCL_ERROR;
	    }
	} /* -ttycontrol options loop */

	ioctl(fsPtr->fd, TIOCMSET, &control);
	ckfree(argv);
	return TCL_OK;
#else /* TIOCMGET&TIOCMSET */
	UNSUPPORTED_OPTION("-ttycontrol");
#endif /* TIOCMGET&TIOCMSET */
    }

    return Tcl_BadChannelOption(interp, optionName,







|










|





|







748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
		if (flag) {
		    ioctl(fsPtr->fd, TIOCSBRK, NULL);
		} else {
		    ioctl(fsPtr->fd, TIOCCBRK, NULL);
		}
#else /* TIOCSBRK & TIOCCBRK */
		UNSUPPORTED_OPTION("-ttycontrol BREAK");
		Tcl_Free(argv);
		return TCL_ERROR;
#endif /* TIOCSBRK & TIOCCBRK */
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "bad signal \"%s\" for -ttycontrol: must be"
			    " DTR, RTS or BREAK", argv[i]));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
		}
		Tcl_Free(argv);
		return TCL_ERROR;
	    }
	} /* -ttycontrol options loop */

	ioctl(fsPtr->fd, TIOCMSET, &control);
	Tcl_Free(argv);
	return TCL_OK;
#else /* TIOCMGET&TIOCMSET */
	UNSUPPORTED_OPTION("-ttycontrol");
#endif /* TIOCMGET&TIOCMSET */
    }

    return Tcl_BadChannelOption(interp, optionName,
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
    } else
#endif	/* SUPPORTS_TTY */
    {
	translation = NULL;
	channelTypePtr = &fileChannelType;
    }

    fsPtr = ckalloc(sizeof(FileState));
    fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
    fsPtr->fd = fd;

    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    fsPtr, channelPermissions);

    if (translation != NULL) {







|







1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
    } else
#endif	/* SUPPORTS_TTY */
    {
	translation = NULL;
	channelTypePtr = &fileChannelType;
    }

    fsPtr = Tcl_Alloc(sizeof(FileState));
    fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
    fsPtr->fd = fd;

    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    fsPtr, channelPermissions);

    if (translation != NULL) {
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
	    return TclpMakeTcpClientChannelMode(INT2PTR(fd), mode);
	}
    }

    channelTypePtr = &fileChannelType;
    sprintf(channelName, "file%d", fd);

    fsPtr = ckalloc(sizeof(FileState));
    fsPtr->fd = fd;
    fsPtr->validMask = mode | TCL_EXCEPTION;
    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    fsPtr, mode);

    return fsPtr->channel;
}







|







1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
	    return TclpMakeTcpClientChannelMode(INT2PTR(fd), mode);
	}
    }

    channelTypePtr = &fileChannelType;
    sprintf(channelName, "file%d", fd);

    fsPtr = Tcl_Alloc(sizeof(FileState));
    fsPtr->fd = fd;
    fsPtr->validMask = mode | TCL_EXCEPTION;
    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    fsPtr, mode);

    return fsPtr->channel;
}
Changes to unix/tclUnixCompat.c.
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
     */

    if (tsdPtr->pbuf == NULL) {
	tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
	if (tsdPtr->pbuflen < 1) {
	    tsdPtr->pbuflen = 1024;
	}
	tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen);
	Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
    }
    while (1) {
	int e = getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen,
		&pwPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->pbuflen *= 2;
	tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
    }
    return (pwPtr != NULL ? &tsdPtr->pwd : NULL);

#elif defined(HAVE_GETPWNAM_R_4)
    return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else







|












|







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
     */

    if (tsdPtr->pbuf == NULL) {
	tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
	if (tsdPtr->pbuflen < 1) {
	    tsdPtr->pbuflen = 1024;
	}
	tsdPtr->pbuf = Tcl_Alloc(tsdPtr->pbuflen);
	Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
    }
    while (1) {
	int e = getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen,
		&pwPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->pbuflen *= 2;
	tsdPtr->pbuf = Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen);
    }
    return (pwPtr != NULL ? &tsdPtr->pwd : NULL);

#elif defined(HAVE_GETPWNAM_R_4)
    return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
     */

    if (tsdPtr->pbuf == NULL) {
	tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
	if (tsdPtr->pbuflen < 1) {
	    tsdPtr->pbuflen = 1024;
	}
	tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen);
	Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
    }
    while (1) {
	int e = getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen,
		&pwPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->pbuflen *= 2;
	tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
    }
    return (pwPtr != NULL ? &tsdPtr->pwd : NULL);

#elif defined(HAVE_GETPWUID_R_4)
    return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else







|












|







275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
     */

    if (tsdPtr->pbuf == NULL) {
	tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
	if (tsdPtr->pbuflen < 1) {
	    tsdPtr->pbuflen = 1024;
	}
	tsdPtr->pbuf = Tcl_Alloc(tsdPtr->pbuflen);
	Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
    }
    while (1) {
	int e = getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen,
		&pwPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->pbuflen *= 2;
	tsdPtr->pbuf = Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen);
    }
    return (pwPtr != NULL ? &tsdPtr->pwd : NULL);

#elif defined(HAVE_GETPWUID_R_4)
    return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
#ifdef NEED_PW_CLEANER
static void
FreePwBuf(
    ClientData ignored)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    ckfree(tsdPtr->pbuf);
}
#endif /* NEED_PW_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetGrNam --







|







334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
#ifdef NEED_PW_CLEANER
static void
FreePwBuf(
    ClientData ignored)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_Free(tsdPtr->pbuf);
}
#endif /* NEED_PW_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetGrNam --
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
     */

    if (tsdPtr->gbuf == NULL) {
	tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
	if (tsdPtr->gbuflen < 1) {
	    tsdPtr->gbuflen = 1024;
	}
	tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen);
	Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
    }
    while (1) {
	int e = getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen,
		&grPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->gbuflen *= 2;
	tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
    }
    return (grPtr != NULL ? &tsdPtr->grp : NULL);

#elif defined(HAVE_GETGRNAM_R_4)
    return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else







|












|







378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
     */

    if (tsdPtr->gbuf == NULL) {
	tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
	if (tsdPtr->gbuflen < 1) {
	    tsdPtr->gbuflen = 1024;
	}
	tsdPtr->gbuf = Tcl_Alloc(tsdPtr->gbuflen);
	Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
    }
    while (1) {
	int e = getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen,
		&grPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->gbuflen *= 2;
	tsdPtr->gbuf = Tcl_Realloc(tsdPtr->gbuf, tsdPtr->gbuflen);
    }
    return (grPtr != NULL ? &tsdPtr->grp : NULL);

#elif defined(HAVE_GETGRNAM_R_4)
    return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
     */

    if (tsdPtr->gbuf == NULL) {
	tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
	if (tsdPtr->gbuflen < 1) {
	    tsdPtr->gbuflen = 1024;
	}
	tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen);
	Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
    }
    while (1) {
	int e = getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen,
		&grPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->gbuflen *= 2;
	tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
    }
    return (grPtr != NULL ? &tsdPtr->grp : NULL);

#elif defined(HAVE_GETGRGID_R_4)
    return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else







|












|







458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
     */

    if (tsdPtr->gbuf == NULL) {
	tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
	if (tsdPtr->gbuflen < 1) {
	    tsdPtr->gbuflen = 1024;
	}
	tsdPtr->gbuf = Tcl_Alloc(tsdPtr->gbuflen);
	Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
    }
    while (1) {
	int e = getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen,
		&grPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->gbuflen *= 2;
	tsdPtr->gbuf = Tcl_Realloc(tsdPtr->gbuf, tsdPtr->gbuflen);
    }
    return (grPtr != NULL ? &tsdPtr->grp : NULL);

#elif defined(HAVE_GETGRGID_R_4)
    return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
#ifdef NEED_GR_CLEANER
static void
FreeGrBuf(
    ClientData ignored)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    ckfree(tsdPtr->gbuf);
}
#endif /* NEED_GR_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetHostByName --







|







517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
#ifdef NEED_GR_CLEANER
static void
FreeGrBuf(
    ClientData ignored)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_Free(tsdPtr->gbuf);
}
#endif /* NEED_GR_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetHostByName --
Changes to unix/tclUnixFCmd.c.
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
    const char *dst,		/* Pathname of file to create/overwrite
				 * (native). */
    const Tcl_StatBuf *statBufPtr,
				/* Used to determine mode and blocksize. */
    int dontCopyAtts)		/* If flag set, don't copy attributes. */
{
    int srcFd, dstFd;
    unsigned blockSize;		/* Optimal I/O blocksize for filesystem */
    char *buffer;		/* Data buffer for copy */
    size_t nread;

#ifdef DJGPP
#define BINMODE |O_BINARY
#else
#define BINMODE







|







548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
    const char *dst,		/* Pathname of file to create/overwrite
				 * (native). */
    const Tcl_StatBuf *statBufPtr,
				/* Used to determine mode and blocksize. */
    int dontCopyAtts)		/* If flag set, don't copy attributes. */
{
    int srcFd, dstFd;
    size_t blockSize;		/* Optimal I/O blocksize for filesystem */
    char *buffer;		/* Data buffer for copy */
    size_t nread;

#ifdef DJGPP
#define BINMODE |O_BINARY
#else
#define BINMODE
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
     * detecting such a situation we now simply fall back to a hardwired
     * default size.
     */

    if (blockSize <= 0) {
	blockSize = DEFAULT_COPY_BLOCK_SIZE;
    }
    buffer = ckalloc(blockSize);
    while (1) {
	nread = (size_t) read(srcFd, buffer, blockSize);
	if ((nread == (size_t) -1) || (nread == 0)) {
	    break;
	}
	if ((size_t) write(dstFd, buffer, nread) != nread) {
	    nread = (size_t) -1;
	    break;
	}
    }

    ckfree(buffer);
    close(srcFd);
    if ((close(dstFd) != 0) || (nread == (size_t) -1)) {
	unlink(dst);					/* INTL: Native. */
	return TCL_ERROR;
    }
    if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
	/*







|











|







604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
     * detecting such a situation we now simply fall back to a hardwired
     * default size.
     */

    if (blockSize <= 0) {
	blockSize = DEFAULT_COPY_BLOCK_SIZE;
    }
    buffer = Tcl_Alloc(blockSize);
    while (1) {
	nread = (size_t) read(srcFd, buffer, blockSize);
	if ((nread == (size_t) -1) || (nread == 0)) {
	    break;
	}
	if ((size_t) write(dstFd, buffer, nread) != nread) {
	    nread = (size_t) -1;
	    break;
	}
    }

    Tcl_Free(buffer);
    close(srcFd);
    if ((close(dstFd) != 0) || (nread == (size_t) -1)) {
	unlink(dst);					/* INTL: Native. */
	return TCL_ERROR;
    }
    if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
	/*
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
    				 * traverseProc has returned TCL_OK; this is
    				 * required when traverseProc modifies the
    				 * source hierarchy, e.g. by deleting
    				 * files. */
{
    Tcl_StatBuf statBuf;
    const char *source, *errfile;
    int result, sourceLen;
    int targetLen;
#ifndef HAVE_FTS
    int numProcessed = 0;
    Tcl_DirEntry *dirEntPtr;
    TclDIR *dirPtr;
#else
    const char *paths[2] = {NULL, NULL};
    FTS *fts = NULL;







|
|







954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
    				 * traverseProc has returned TCL_OK; this is
    				 * required when traverseProc modifies the
    				 * source hierarchy, e.g. by deleting
    				 * files. */
{
    Tcl_StatBuf statBuf;
    const char *source, *errfile;
    int result;
    size_t targetLen, sourceLen;
#ifndef HAVE_FTS
    int numProcessed = 0;
    Tcl_DirEntry *dirEntPtr;
    TclDIR *dirPtr;
#else
    const char *paths[2] = {NULL, NULL};
    FTS *fts = NULL;
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062

	if (nextCheckpoint == 0) {
	    return 0;
	}

	nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds);
	if (Realpath(nativePath, normPath) != NULL) {
	    int newNormLen;

	wholeStringOk:
	    newNormLen = strlen(normPath);
	    if ((newNormLen == Tcl_DStringLength(&ds))
		    && (strcmp(normPath, nativePath) == 0)) {
		/*
		 * String is unchanged.







|







2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062

	if (nextCheckpoint == 0) {
	    return 0;
	}

	nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds);
	if (Realpath(nativePath, normPath) != NULL) {
	    size_t newNormLen;

	wholeStringOk:
	    newNormLen = strlen(normPath);
	    if ((newNormLen == Tcl_DStringLength(&ds))
		    && (strcmp(normPath, nativePath) == 0)) {
		/*
		 * String is unchanged.
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096

	    /*
	     * Free up the native path and put in its place the converted,
	     * normalized path.
	     */

	    Tcl_DStringFree(&ds);
	    Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds);

	    if (path[nextCheckpoint] != '\0') {
		/*
		 * Not at end, append remaining path.
		 */

		int normLen = Tcl_DStringLength(&ds);







|







2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096

	    /*
	     * Free up the native path and put in its place the converted,
	     * normalized path.
	     */

	    Tcl_DStringFree(&ds);
	    Tcl_ExternalToUtfDString(NULL, normPath, newNormLen, &ds);

	    if (path[nextCheckpoint] != '\0') {
		/*
		 * Not at end, append remaining path.
		 */

		int normLen = Tcl_DStringLength(&ds);
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
	    TclGetString(fileName), Tcl_PosixError(interp)));
}

static WCHAR *
winPathFromObj(
    Tcl_Obj *fileName)
{
    int size;
    const char *native =  Tcl_FSGetNativePath(fileName);
    WCHAR *winPath;

    size = cygwin_conv_path(1, native, NULL, 0);
    winPath = ckalloc(size);
    cygwin_conv_path(1, native, winPath, size);

    return winPath;
}

static const int attributeArray[] = {
    0x20, 0, 2, 0, 0, 1, 4







|




|







2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
	    TclGetString(fileName), Tcl_PosixError(interp)));
}

static WCHAR *
winPathFromObj(
    Tcl_Obj *fileName)
{
    size_t size;
    const char *native =  Tcl_FSGetNativePath(fileName);
    WCHAR *winPath;

    size = cygwin_conv_path(1, native, NULL, 0);
    winPath = Tcl_Alloc(size);
    cygwin_conv_path(1, native, winPath, size);

    return winPath;
}

static const int attributeArray[] = {
    0x20, 0, 2, 0, 0, 1, 4
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    int fileAttributes;
    WCHAR *winPath = winPathFromObj(fileName);

    fileAttributes = GetFileAttributesW(winPath);
    ckfree(winPath);

    if (fileAttributes == -1) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewIntObj(







|







2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    int fileAttributes;
    WCHAR *winPath = winPathFromObj(fileName);

    fileAttributes = GetFileAttributesW(winPath);
    Tcl_Free(winPath);

    if (fileAttributes == -1) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewIntObj(
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
    }

    winPath = winPathFromObj(fileName);

    fileAttributes = old = GetFileAttributesW(winPath);

    if (fileAttributes == -1) {
	ckfree(winPath);
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    if (yesNo) {
	fileAttributes |= attributeArray[objIndex];
    } else {
	fileAttributes &= ~attributeArray[objIndex];
    }

    if ((fileAttributes != old)
	    && !SetFileAttributesW(winPath, fileAttributes)) {
	ckfree(winPath);
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    ckfree(winPath);
    return TCL_OK;
}
#elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
/*
 *----------------------------------------------------------------------
 *
 * GetUnixFileAttributes







|












|




|







2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
    }

    winPath = winPathFromObj(fileName);

    fileAttributes = old = GetFileAttributesW(winPath);

    if (fileAttributes == -1) {
	Tcl_Free(winPath);
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    if (yesNo) {
	fileAttributes |= attributeArray[objIndex];
    } else {
	fileAttributes &= ~attributeArray[objIndex];
    }

    if ((fileAttributes != old)
	    && !SetFileAttributesW(winPath, fileAttributes)) {
	Tcl_Free(winPath);
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    Tcl_Free(winPath);
    return TCL_OK;
}
#elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
/*
 *----------------------------------------------------------------------
 *
 * GetUnixFileAttributes
Changes to unix/tclUnixFile.c.
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
#else
    if (getcwd(buffer, MAXPATHLEN+1) == NULL) {		/* INTL: Native. */
	return NULL;
    }
#endif /* USEGETWD */

    if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) {
	char *newCd = ckalloc(strlen(buffer) + 1);

	strcpy(newCd, buffer);
	return newCd;
    }

    /*
     * No change to pwd.







|







716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
#else
    if (getcwd(buffer, MAXPATHLEN+1) == NULL) {		/* INTL: Native. */
	return NULL;
    }
#endif /* USEGETWD */

    if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) {
	char *newCd = Tcl_Alloc(strlen(buffer) + 1);

	strcpy(newCd, buffer);
	return newCd;
    }

    /*
     * No change to pwd.
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
    if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
	/* See bug [3118489]: NUL in filenames */
	Tcl_DecrRefCount(validPathPtr);
	Tcl_DStringFree(&ds);
	return NULL;
    }
    Tcl_DecrRefCount(validPathPtr);
    nativePathPtr = ckalloc(len);
    memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);

    Tcl_DStringFree(&ds);
    return nativePathPtr;
}

/*
 *---------------------------------------------------------------------------







|
|







1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
    if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
	/* See bug [3118489]: NUL in filenames */
	Tcl_DecrRefCount(validPathPtr);
	Tcl_DStringFree(&ds);
	return NULL;
    }
    Tcl_DecrRefCount(validPathPtr);
    nativePathPtr = Tcl_Alloc(len);
    memcpy(nativePathPtr, Tcl_DStringValue(&ds), len);

    Tcl_DStringFree(&ds);
    return nativePathPtr;
}

/*
 *---------------------------------------------------------------------------
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167

    /*
     * ASCII representation when running on Unix.
     */

    len = (strlen((const char*) clientData) + 1) * sizeof(char);

    copy = ckalloc(len);
    memcpy(copy, clientData, len);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *







|







1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167

    /*
     * ASCII representation when running on Unix.
     */

    len = (strlen((const char*) clientData) + 1) * sizeof(char);

    copy = Tcl_Alloc(len);
    memcpy(copy, clientData, len);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *
Changes to unix/tclUnixInit.c.
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
	     * string.
	     */

	    pathv[pathc - 1] = installLib + 4;
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds));
	}
	ckfree(pathv);
    }

    /*
     * Finally, look for the library relative to the compiled-in path. This is
     * needed when users install Tcl with an exec-prefix that is different
     * from the prefix.
     */







|







501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
	     * string.
	     */

	    pathv[pathc - 1] = installLib + 4;
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds));
	}
	Tcl_Free(pathv);
    }

    /*
     * Finally, look for the library relative to the compiled-in path. This is
     * needed when users install Tcl with an exec-prefix that is different
     * from the prefix.
     */
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
	}
    }
    Tcl_DStringFree(&buffer);

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    str = TclGetString(pathPtr);
    *lengthPtr = pathPtr->length;
    *valuePtr = ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, str, *lengthPtr + 1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *







|







535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
	}
    }
    Tcl_DStringFree(&buffer);

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    str = TclGetString(pathPtr);
    *lengthPtr = pathPtr->length;
    *valuePtr = Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, str, *lengthPtr + 1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensetive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"name", or -1 if there is no such entry. The integer at *lengthPtr is
 *	filled in with the length of name (if a matching entry is found) or
 *	the length of the environ array (if no matching entry is found).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (native). */
    int *lengthPtr)		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    int i, result = -1;
    register const char *env, *p1, *p2;
    Tcl_DString envString;

    Tcl_DStringInit(&envString);
    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
	p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
	p2 = name;







|









|



|




|







977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensetive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"name", or (size_t)-1 if there is no such entry. The integer at *lengthPtr is
 *	filled in with the length of name (if a matching entry is found) or
 *	the length of the environ array (if no matching entry is found).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (native). */
    size_t *lengthPtr)		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    size_t i, result = (size_t)-1;
    register const char *env, *p1, *p2;
    Tcl_DString envString;

    Tcl_DStringInit(&envString);
    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
	p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
	p2 = name;
Changes to unix/tclUnixPipe.c.
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
    Tcl_Pid *pidPtr)		/* An array of process identifiers. Allocated
				 * by the caller, freed when the channel is
				 * closed or the processes are detached (in a
				 * background exec). */
{
    char channelName[16 + TCL_INTEGER_SPACE];
    int channelId;
    PipeState *statePtr = ckalloc(sizeof(PipeState));
    int mode;

    statePtr->inFile = readFile;
    statePtr->outFile = writeFile;
    statePtr->errorFile = errorFile;
    statePtr->numPids = numPids;
    statePtr->pidPtr = pidPtr;







|







740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
    Tcl_Pid *pidPtr)		/* An array of process identifiers. Allocated
				 * by the caller, freed when the channel is
				 * closed or the processes are detached (in a
				 * background exec). */
{
    char channelName[16 + TCL_INTEGER_SPACE];
    int channelId;
    PipeState *statePtr = Tcl_Alloc(sizeof(PipeState));
    int mode;

    statePtr->inFile = readFile;
    statePtr->outFile = writeFile;
    statePtr->errorFile = errorFile;
    statePtr->numPids = numPids;
    statePtr->pidPtr = pidPtr;
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
    for (i = 0; i < pipePtr->numPids; i++) {
	Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewLongObj(
		PTR2INT(pipePtr->pidPtr[i])));
	Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
	ckfree(pipePtr->pidPtr);
	pipePtr->numPids = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
    for (i = 0; i < pipePtr->numPids; i++) {
	Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewLongObj(
		PTR2INT(pipePtr->pidPtr[i])));
	Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
	Tcl_Free(pipePtr->pidPtr);
	pipePtr->numPids = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
	    errChan = NULL;
	}
	result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
		errChan);
    }

    if (pipePtr->numPids != 0) {
	ckfree(pipePtr->pidPtr);
    }
    ckfree(pipePtr);
    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}

/*







|

|







1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
	    errChan = NULL;
	}
	result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
		errChan);
    }

    if (pipePtr->numPids != 0) {
	Tcl_Free(pipePtr->pidPtr);
    }
    Tcl_Free(pipePtr);
    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}

/*
Changes to unix/tclUnixPort.h.
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
/*
 *---------------------------------------------------------------------------
 * The following defines wrap the system memory allocation routines.
 *---------------------------------------------------------------------------
 */

#define TclpSysAlloc(size)		malloc(size)
#define TclpSysFree(ptr)		free((char *)(ptr))
#define TclpSysRealloc(ptr, size)	realloc(ptr, size)

/*
 *---------------------------------------------------------------------------
 * The following macros and declaration wrap the C runtime library functions.
 *---------------------------------------------------------------------------
 */







|







672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
/*
 *---------------------------------------------------------------------------
 * The following defines wrap the system memory allocation routines.
 *---------------------------------------------------------------------------
 */

#define TclpSysAlloc(size)		malloc(size)
#define TclpSysFree(ptr)		free(ptr)
#define TclpSysRealloc(ptr, size)	realloc(ptr, size)

/*
 *---------------------------------------------------------------------------
 * The following macros and declaration wrap the C runtime library functions.
 *---------------------------------------------------------------------------
 */
Changes to unix/tclUnixSock.c.
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
	     * as it exceeds SYS_NMLN. See if we can just get the immediate
	     * nodename and get a proper answer that way.
	     */

	    char *dot = strchr(u.nodename, '.');

	    if (dot != NULL) {
		char *node = ckalloc(dot - u.nodename + 1);

		memcpy(node, u.nodename, (size_t) (dot - u.nodename));
		node[dot - u.nodename] = '\0';
		hp = TclpGetHostByName(node);
		ckfree(node);
	    }
	}
        if (hp != NULL) {
	    native = hp->h_name;
        } else {
	    native = u.nodename;
        }







|




|







235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
	     * as it exceeds SYS_NMLN. See if we can just get the immediate
	     * nodename and get a proper answer that way.
	     */

	    char *dot = strchr(u.nodename, '.');

	    if (dot != NULL) {
		char *node = Tcl_Alloc(dot - u.nodename + 1);

		memcpy(node, u.nodename, (size_t) (dot - u.nodename));
		node[dot - u.nodename] = '\0';
		hp = TclpGetHostByName(node);
		Tcl_Free(node);
	    }
	}
        if (hp != NULL) {
	    native = hp->h_name;
        } else {
	    native = u.nodename;
        }
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
    if (gethostname(buffer, sizeof(buffer)) > -1) {	/* INTL: Native. */
	native = buffer;
    }
#endif /* NO_UNAME */

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    *lengthPtr = strlen(native);
    *valuePtr = ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, native, *lengthPtr + 1);
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_GetHostName --







|







281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
    if (gethostname(buffer, sizeof(buffer)) > -1) {	/* INTL: Native. */
	native = buffer;
    }
#endif /* NO_UNAME */

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    *lengthPtr = strlen(native);
    *valuePtr = Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, native, *lengthPtr + 1);
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_GetHostName --
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
	}

    }
    fds = statePtr->fds.next;
    while (fds != NULL) {
	TcpFdList *next = fds->next;

	ckfree(fds);
	fds = next;
    }
    if (statePtr->addrlist != NULL) {
        freeaddrinfo(statePtr->addrlist);
    }
    if (statePtr->myaddrlist != NULL) {
        freeaddrinfo(statePtr->myaddrlist);
    }
    ckfree(statePtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpClose2Proc --







|








|







642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
	}

    }
    fds = statePtr->fds.next;
    while (fds != NULL) {
	TcpFdList *next = fds->next;

	Tcl_Free(fds);
	fds = next;
    }
    if (statePtr->addrlist != NULL) {
        freeaddrinfo(statePtr->addrlist);
    }
    if (statePtr->myaddrlist != NULL) {
        freeaddrinfo(statePtr->myaddrlist);
    }
    Tcl_Free(statePtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpClose2Proc --
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
        return NULL;
    }

    /*
     * Allocate a new TcpState for this socket.
     */

    statePtr = ckalloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->flags = async ? TCP_ASYNC_CONNECT : 0;
    statePtr->cachedBlocking = TCL_MODE_BLOCKING;
    statePtr->addrlist = addrlist;
    statePtr->myaddrlist = myaddrlist;
    statePtr->fds.fd = -1;








|







1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
        return NULL;
    }

    /*
     * Allocate a new TcpState for this socket.
     */

    statePtr = Tcl_Alloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->flags = async ? TCP_ASYNC_CONNECT : 0;
    statePtr->cachedBlocking = TCL_MODE_BLOCKING;
    statePtr->addrlist = addrlist;
    statePtr->myaddrlist = myaddrlist;
    statePtr->fds.fd = -1;

1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
    void *sock,		/* The socket to wrap up into a channel. */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];

    statePtr = ckalloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->fds.fd = PTR2INT(sock);
    statePtr->flags = 0;

    sprintf(channelName, SOCK_TEMPLATE, (long)statePtr);

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,







|







1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
    void *sock,		/* The socket to wrap up into a channel. */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];

    statePtr = Tcl_Alloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->fds.fd = PTR2INT(sock);
    statePtr->flags = 0;

    sprintf(channelName, SOCK_TEMPLATE, (long)statePtr);

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
            continue;
        }
        if (statePtr == NULL) {
            /*
             * Allocate a new TcpState for this socket.
             */

            statePtr = ckalloc(sizeof(TcpState));
            memset(statePtr, 0, sizeof(TcpState));
            statePtr->acceptProc = acceptProc;
            statePtr->acceptProcData = acceptProcData;
            sprintf(channelName, SOCK_TEMPLATE, (long) statePtr);
            newfds = &statePtr->fds;
        } else {
            newfds = ckalloc(sizeof(TcpFdList));
            memset(newfds, (int) 0, sizeof(TcpFdList));
            fds->next = newfds;
        }
        newfds->fd = sock;
        newfds->statePtr = statePtr;
        fds = newfds;








|






|







1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
            continue;
        }
        if (statePtr == NULL) {
            /*
             * Allocate a new TcpState for this socket.
             */

            statePtr = Tcl_Alloc(sizeof(TcpState));
            memset(statePtr, 0, sizeof(TcpState));
            statePtr->acceptProc = acceptProc;
            statePtr->acceptProcData = acceptProcData;
            sprintf(channelName, SOCK_TEMPLATE, (long) statePtr);
            newfds = &statePtr->fds;
        } else {
            newfds = Tcl_Alloc(sizeof(TcpFdList));
            memset(newfds, (int) 0, sizeof(TcpFdList));
            fds->next = newfds;
        }
        newfds->fd = sock;
        newfds->statePtr = statePtr;
        fds = newfds;

1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
    /*
     * Set close-on-exec flag to prevent the newly accepted socket from being
     * inherited by child processes.
     */

    (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);

    newSockState = ckalloc(sizeof(TcpState));
    memset(newSockState, 0, sizeof(TcpState));
    newSockState->flags = 0;
    newSockState->fds.fd = newsock;

    sprintf(channelName, SOCK_TEMPLATE, (long) newSockState);
    newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newSockState, TCL_READABLE | TCL_WRITABLE);







|







1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
    /*
     * Set close-on-exec flag to prevent the newly accepted socket from being
     * inherited by child processes.
     */

    (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);

    newSockState = Tcl_Alloc(sizeof(TcpState));
    memset(newSockState, 0, sizeof(TcpState));
    newSockState->flags = 0;
    newSockState->fds.fd = newsock;

    sprintf(channelName, SOCK_TEMPLATE, (long) newSockState);
    newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newSockState, TCL_READABLE | TCL_WRITABLE);
Changes to unix/tclUnixThrd.c.
10
11
12
13
14
15
16

























































































































































17
18
19
20
21
22
23
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#if TCL_THREADS


























































































































































/*
 * masterLock is used to serialize creation of mutexes, condition variables,
 * and thread local storage. This is the only place that can count on the
 * ability to statically initialize the mutex.
 */








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#if TCL_THREADS

/*
 * TIP #509. Ensures that Tcl's mutexes are reentrant.
 *
 *----------------------------------------------------------------------
 *
 * PMutexInit --
 *
 *	Sets up the memory pointed to by its argument so that it contains the
 *	implementation of a recursive lock. Caller supplies the space.
 *
 *----------------------------------------------------------------------
 *
 * PMutexDestroy --
 *
 *	Tears down the implementation of a recursive lock (but does not
 *	deallocate the space holding the lock).
 *
 *----------------------------------------------------------------------
 *
 * PMutexLock --
 *
 *	Locks a recursive lock. (Similar to pthread_mutex_lock)
 *
 *----------------------------------------------------------------------
 *
 * PMutexUnlock --
 *
 *	Unlocks a recursive lock. (Similar to pthread_mutex_unlock)
 *
 *----------------------------------------------------------------------
 *
 * PCondWait --
 *
 *	Waits on a condition variable linked a recursive lock. (Similar to
 *	pthread_cond_wait)
 *
 *----------------------------------------------------------------------
 *
 * PCondTimedWait --
 *
 *	Waits for a limited amount of time on a condition variable linked to a
 *	recursive lock. (Similar to pthread_cond_timedwait)
 *
 *----------------------------------------------------------------------
 */

#ifndef HAVE_DECL_PTHREAD_MUTEX_RECURSIVE
#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE 0
#endif

#if HAVE_DECL_PTHREAD_MUTEX_RECURSIVE
/*
 * Pthread has native reentrant (AKA recursive) mutexes. Use them for
 * Tcl_Mutex.
 */

typedef pthread_mutex_t PMutex;

static void
PMutexInit(
    PMutex *pmutexPtr)
{
    pthread_mutexattr_t attr;

    pthread_mutexattr_init(&attr);
    pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
    pthread_mutex_init(pmutexPtr, &attr);
}

#define PMutexDestroy	pthread_mutex_destroy
#define PMutexLock	pthread_mutex_lock
#define PMutexUnlock	pthread_mutex_unlock
#define PCondWait	pthread_cond_wait
#define PCondTimedWait	pthread_cond_timedwait

#else /* !HAVE_PTHREAD_MUTEX_RECURSIVE */

/*
 * No native support for reentrant mutexes. Emulate them with regular mutexes
 * and thread-local counters.
 */

typedef struct PMutex {
    pthread_mutex_t mutex;
    pthread_t thread;
    int counter;
} PMutex;

static void
PMutexInit(
    PMutex *pmutexPtr)
{
    pthread_mutex_init(&pmutexPtr->mutex, NULL);
    pmutexPtr->thread = 0;
    pmutexPtr->counter = 0;
}

static void
PMutexDestroy(
    PMutex *pmutexPtr)
{
    pthread_mutex_destroy(&pmutexPtr->mutex);
}

static void
PMutexLock(
    PMutex *pmutexPtr)
{
    if (pmutexPtr->thread != pthread_self() || pmutexPtr->counter == 0) {
	pthread_mutex_lock(&pmutexPtr->mutex);
	pmutexPtr->thread = pthread_self();
	pmutexPtr->counter = 0;
    }
    pmutexPtr->counter++;
}

static void
PMutexUnlock(
    PMutex *pmutexPtr)
{
    pmutexPtr->counter--;
    if (pmutexPtr->counter == 0) {
	pmutexPtr->thread = 0;
	pthread_mutex_unlock(&pmutexPtr->mutex);
    }
}

static void
PCondWait(
    pthread_cond_t *pcondPtr,
    PMutex *pmutexPtr)
{
    pthread_cond_wait(pcondPtr, &pmutexPtr->mutex);
}

static void
PCondTimedWait(
    pthread_cond_t *pcondPtr,
    PMutex *pmutexPtr,
    struct timespec *ptime)
{
    pthread_cond_timedwait(pcondPtr, &pmutexPtr->mutex, ptime);
}
#endif /* HAVE_PTHREAD_MUTEX_RECURSIVE */

#ifndef TCL_NO_DEPRECATED
typedef struct {
    char nabuf[16];
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;
#endif /* TCL_NO_DEPRECATED */

/*
 * masterLock is used to serialize creation of mutexes, condition variables,
 * and thread local storage. This is the only place that can count on the
 * ability to statically initialize the mutex.
 */

31
32
33
34
35
36
37


38





39
40
41
42
43
44
45
46
static pthread_mutex_t initLock = PTHREAD_MUTEX_INITIALIZER;

/*
 * allocLock is used by Tcl's version of malloc for synchronization. For
 * obvious reasons, cannot use any dyamically allocated storage.
 */



static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER;





static pthread_mutex_t *allocLockPtr = &allocLock;

#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --







>
>
|
>
>
>
>
>
|







184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
static pthread_mutex_t initLock = PTHREAD_MUTEX_INITIALIZER;

/*
 * allocLock is used by Tcl's version of malloc for synchronization. For
 * obvious reasons, cannot use any dyamically allocated storage.
 */

static PMutex allocLock;
static pthread_once_t allocLockInitOnce = PTHREAD_ONCE_INIT;

static void
allocLockInit(void)
{
    PMutexInit(&allocLock);
}
static PMutex *allocLockPtr = &allocLock;

#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;

    pthread_attr_init(&attr);
    pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);

#ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE
    if (stackSize != TCL_THREAD_STACK_DEFAULT) {
	pthread_attr_setstacksize(&attr, (size_t) stackSize);
#ifdef TCL_THREAD_STACK_MIN
    } else {
	/*
	 * Certain systems define a thread stack size that by default is too
	 * small for many operations. The user has the option of defining
	 * TCL_THREAD_STACK_MIN to a value large enough to work for their
	 * needs. This would look like (for 128K min stack):







|













|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    size_t stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;

    pthread_attr_init(&attr);
    pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);

#ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE
    if (stackSize != TCL_THREAD_STACK_DEFAULT) {
	pthread_attr_setstacksize(&attr, stackSize);
#ifdef TCL_THREAD_STACK_MIN
    } else {
	/*
	 * Certain systems define a thread stack size that by default is too
	 * small for many operations. The user has the option of defining
	 * TCL_THREAD_STACK_MIN to a value large enough to work for their
	 * needs. This would look like (for 128K min stack):
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
	if (!result && (size < TCL_THREAD_STACK_MIN)) {
	    pthread_attr_setstacksize(&attr, (size_t) TCL_THREAD_STACK_MIN);
	}
#endif /* TCL_THREAD_STACK_MIN */
    }
#endif /* HAVE_PTHREAD_ATTR_SETSTACKSIZE */

    if (! (flags & TCL_THREAD_JOINABLE)) {
	pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED);
    }

    if (pthread_create(&theThread, &attr,
	    (void * (*)(void *))proc, (void *)clientData) &&
	    pthread_create(&theThread, NULL,
		    (void * (*)(void *))proc, (void *)clientData)) {
	result = TCL_ERROR;
    } else {
	*idPtr = (Tcl_ThreadId)theThread;
	result = TCL_OK;
    }
    pthread_attr_destroy(&attr);
    return result;
#else
    return TCL_ERROR;
#endif /* TCL_THREADS */







|
|



|

|


|







257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
	if (!result && (size < TCL_THREAD_STACK_MIN)) {
	    pthread_attr_setstacksize(&attr, (size_t) TCL_THREAD_STACK_MIN);
	}
#endif /* TCL_THREAD_STACK_MIN */
    }
#endif /* HAVE_PTHREAD_ATTR_SETSTACKSIZE */

    if (!(flags & TCL_THREAD_JOINABLE)) {
	pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
    }

    if (pthread_create(&theThread, &attr,
	    (void * (*)(void *)) proc, (void *) clientData) &&
	    pthread_create(&theThread, NULL,
		    (void * (*)(void *)) proc, (void *) clientData)) {
	result = TCL_ERROR;
    } else {
	*idPtr = (Tcl_ThreadId) theThread;
	result = TCL_OK;
    }
    pthread_attr_destroy(&attr);
    return result;
#else
    return TCL_ERROR;
#endif /* TCL_THREADS */
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
void
TclpMasterLock(void)
{
#if TCL_THREADS
    pthread_mutex_lock(&masterLock);
#endif
}


/*
 *----------------------------------------------------------------------
 *
 * TclpMasterUnlock
 *
 *	This procedure is used to release a lock that serializes creation and







<







479
480
481
482
483
484
485

486
487
488
489
490
491
492
void
TclpMasterLock(void)
{
#if TCL_THREADS
    pthread_mutex_lock(&masterLock);
#endif
}


/*
 *----------------------------------------------------------------------
 *
 * TclpMasterUnlock
 *
 *	This procedure is used to release a lock that serializes creation and
369
370
371
372
373
374
375
376


377
378
379
380
381
382
383
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#if TCL_THREADS
    pthread_mutex_t **allocLockPtrPtr = &allocLockPtr;


    return (Tcl_Mutex *) allocLockPtrPtr;
#else
    return NULL;
#endif
}

#if TCL_THREADS







|
>
>







528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#if TCL_THREADS
    PMutex **allocLockPtrPtr = &allocLockPtr;

    pthread_once(&allocLockInitOnce, allocLockInit);
    return (Tcl_Mutex *) allocLockPtrPtr;
#else
    return NULL;
#endif
}

#if TCL_THREADS
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
 *	first time this Tcl_Mutex is used.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexLock(
    Tcl_Mutex *mutexPtr)	/* Really (pthread_mutex_t **) */
{
    pthread_mutex_t *pmutexPtr;

    if (*mutexPtr == NULL) {
	pthread_mutex_lock(&masterLock);
	if (*mutexPtr == NULL) {
	    /*
	     * Double inside master lock check to avoid a race condition.
	     */

	    pmutexPtr = ckalloc(sizeof(pthread_mutex_t));
	    pthread_mutex_init(pmutexPtr, NULL);
	    *mutexPtr = (Tcl_Mutex)pmutexPtr;
	    TclRememberMutex(mutexPtr);
	}
	pthread_mutex_unlock(&masterLock);
    }
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pthread_mutex_lock(pmutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexUnlock --
 *







|

|








|
|
|




|
|







562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
 *	first time this Tcl_Mutex is used.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexLock(
    Tcl_Mutex *mutexPtr)	/* Really (PMutex **) */
{
    PMutex *pmutexPtr;

    if (*mutexPtr == NULL) {
	pthread_mutex_lock(&masterLock);
	if (*mutexPtr == NULL) {
	    /*
	     * Double inside master lock check to avoid a race condition.
	     */

	    pmutexPtr = Tcl_Alloc(sizeof(PMutex));
	    PMutexInit(pmutexPtr);
	    *mutexPtr = (Tcl_Mutex) pmutexPtr;
	    TclRememberMutex(mutexPtr);
	}
	pthread_mutex_unlock(&masterLock);
    }
    pmutexPtr = *((PMutex **) mutexPtr);
    PMutexLock(pmutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexUnlock --
 *
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
 *	The mutex is released when this returns.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexUnlock(
    Tcl_Mutex *mutexPtr)	/* Really (pthread_mutex_t **) */
{
    pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **) mutexPtr;

    pthread_mutex_unlock(pmutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeMutex --
 *







|

|

|







603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
 *	The mutex is released when this returns.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexUnlock(
    Tcl_Mutex *mutexPtr)	/* Really (PMutex **) */
{
    PMutex *pmutexPtr = *(PMutex **) mutexPtr;

    PMutexUnlock(pmutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeMutex --
 *
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
 *----------------------------------------------------------------------
 */

void
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **) mutexPtr;

    if (pmutexPtr != NULL) {
	pthread_mutex_destroy(pmutexPtr);
	ckfree(pmutexPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *







|


|
|







633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
 *----------------------------------------------------------------------
 */

void
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    PMutex *pmutexPtr = *(PMutex **) mutexPtr;

    if (pmutexPtr != NULL) {
	PMutexDestroy(pmutexPtr);
	Tcl_Free(pmutexPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ConditionWait(
    Tcl_Condition *condPtr,	/* Really (pthread_cond_t **) */
    Tcl_Mutex *mutexPtr,	/* Really (pthread_mutex_t **) */
    const Tcl_Time *timePtr) /* Timeout on waiting period */
{
    pthread_cond_t *pcondPtr;
    pthread_mutex_t *pmutexPtr;
    struct timespec ptime;

    if (*condPtr == NULL) {
	pthread_mutex_lock(&masterLock);

	/*
	 * Double check inside mutex to avoid race, then initialize condition
	 * variable if necessary.
	 */

	if (*condPtr == NULL) {
	    pcondPtr = ckalloc(sizeof(pthread_cond_t));
	    pthread_cond_init(pcondPtr, NULL);
	    *condPtr = (Tcl_Condition) pcondPtr;
	    TclRememberCondition(condPtr);
	}
	pthread_mutex_unlock(&masterLock);
    }
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pcondPtr = *((pthread_cond_t **)condPtr);
    if (timePtr == NULL) {
	pthread_cond_wait(pcondPtr, pmutexPtr);
    } else {
	Tcl_Time now;

	/*
	 * Make sure to take into account the microsecond component of the
	 * current time, including possible overflow situations. [Bug #411603]
	 */

	Tcl_GetTime(&now);
	ptime.tv_sec = timePtr->sec + now.sec +
	    (timePtr->usec + now.usec) / 1000000;
	ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);
	pthread_cond_timedwait(pcondPtr, pmutexPtr, &ptime);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionNotify --







|



|











|






|
|

|












|







667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ConditionWait(
    Tcl_Condition *condPtr,	/* Really (pthread_cond_t **) */
    Tcl_Mutex *mutexPtr,	/* Really (PMutex **) */
    const Tcl_Time *timePtr) /* Timeout on waiting period */
{
    pthread_cond_t *pcondPtr;
    PMutex *pmutexPtr;
    struct timespec ptime;

    if (*condPtr == NULL) {
	pthread_mutex_lock(&masterLock);

	/*
	 * Double check inside mutex to avoid race, then initialize condition
	 * variable if necessary.
	 */

	if (*condPtr == NULL) {
	    pcondPtr = Tcl_Alloc(sizeof(pthread_cond_t));
	    pthread_cond_init(pcondPtr, NULL);
	    *condPtr = (Tcl_Condition) pcondPtr;
	    TclRememberCondition(condPtr);
	}
	pthread_mutex_unlock(&masterLock);
    }
    pmutexPtr = *((PMutex **) mutexPtr);
    pcondPtr = *((pthread_cond_t **) condPtr);
    if (timePtr == NULL) {
	PCondWait(pcondPtr, pmutexPtr);
    } else {
	Tcl_Time now;

	/*
	 * Make sure to take into account the microsecond component of the
	 * current time, including possible overflow situations. [Bug #411603]
	 */

	Tcl_GetTime(&now);
	ptime.tv_sec = timePtr->sec + now.sec +
	    (timePtr->usec + now.usec) / 1000000;
	ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);
	PCondTimedWait(pcondPtr, pmutexPtr, &ptime);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionNotify --
572
573
574
575
576
577
578
579

580
581
582
583
584
585
586
587
588
589
590
591
 *----------------------------------------------------------------------
 */

void
Tcl_ConditionNotify(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *((pthread_cond_t **)condPtr);

    if (pcondPtr != NULL) {
	pthread_cond_broadcast(pcondPtr);
    } else {
	/*
	 * Noone has used the condition variable, so there are no waiters.
	 */
    }
}

/*
 *----------------------------------------------------------------------
 *







|
>




|







733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
 *----------------------------------------------------------------------
 */

void
Tcl_ConditionNotify(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *((pthread_cond_t **) condPtr);

    if (pcondPtr != NULL) {
	pthread_cond_broadcast(pcondPtr);
    } else {
	/*
	 * No-one has used the condition variable, so there are no waiters.
	 */
    }
}

/*
 *----------------------------------------------------------------------
 *
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652

653
654
655
656
657
658
659
660
661
662
663
664
 *----------------------------------------------------------------------
 */

void
TclpFinalizeCondition(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *(pthread_cond_t **)condPtr;

    if (pcondPtr != NULL) {
	pthread_cond_destroy(pcondPtr);
	ckfree(pcondPtr);
	*condPtr = NULL;
    }
}

/*
 * Additions by AOL for specialized thread memory allocator.
 */

#ifdef USE_THREAD_ALLOC
static pthread_key_t key;

typedef struct {
    Tcl_Mutex tlock;
    pthread_mutex_t plock;
} allocMutex;

Tcl_Mutex *
TclpNewAllocMutex(void)
{
    allocMutex *lockPtr;
    register pthread_mutex_t *plockPtr;

    lockPtr = malloc(sizeof(allocMutex));
    if (lockPtr == NULL) {
	Tcl_Panic("could not allocate lock");
    }
    plockPtr = &lockPtr->plock;
    lockPtr->tlock = (Tcl_Mutex) plockPtr;
    pthread_mutex_init(&lockPtr->plock, NULL);
    return &lockPtr->tlock;
}

void
TclpFreeAllocMutex(
    Tcl_Mutex *mutex)		/* The alloc mutex to free. */
{

    allocMutex* lockPtr = (allocMutex*) mutex;
    if (!lockPtr) {
	return;
    }
    pthread_mutex_destroy(&lockPtr->plock);
    free(lockPtr);
}

void
TclpInitAllocCache(void)
{
    pthread_key_create(&key, NULL);







|



|













|
|




|
|

|





|







>
|



|







767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
 *----------------------------------------------------------------------
 */

void
TclpFinalizeCondition(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *(pthread_cond_t **) condPtr;

    if (pcondPtr != NULL) {
	pthread_cond_destroy(pcondPtr);
	Tcl_Free(pcondPtr);
	*condPtr = NULL;
    }
}

/*
 * Additions by AOL for specialized thread memory allocator.
 */

#ifdef USE_THREAD_ALLOC
static pthread_key_t key;

typedef struct {
    Tcl_Mutex tlock;
    PMutex plock;
} AllocMutex;

Tcl_Mutex *
TclpNewAllocMutex(void)
{
    AllocMutex *lockPtr;
    register PMutex *plockPtr;

    lockPtr = malloc(sizeof(AllocMutex));
    if (lockPtr == NULL) {
	Tcl_Panic("could not allocate lock");
    }
    plockPtr = &lockPtr->plock;
    lockPtr->tlock = (Tcl_Mutex) plockPtr;
    PMutexInit(&lockPtr->plock);
    return &lockPtr->tlock;
}

void
TclpFreeAllocMutex(
    Tcl_Mutex *mutex)		/* The alloc mutex to free. */
{
    AllocMutex *lockPtr = (AllocMutex *) mutex;

    if (!lockPtr) {
	return;
    }
    PMutexDestroy(&lockPtr->plock);
    free(lockPtr);
}

void
TclpInitAllocCache(void)
{
    pthread_key_create(&key, NULL);
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
#endif /* USE_THREAD_ALLOC */

void *
TclpThreadCreateKey(void)
{
    pthread_key_t *ptkeyPtr;

    ptkeyPtr = TclpSysAlloc(sizeof *ptkeyPtr);
    if (NULL == ptkeyPtr) {
	Tcl_Panic("unable to allocate thread key!");
    }

    if (pthread_key_create(ptkeyPtr, NULL)) {
	Tcl_Panic("unable to create pthread key!");
    }







|







865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
#endif /* USE_THREAD_ALLOC */

void *
TclpThreadCreateKey(void)
{
    pthread_key_t *ptkeyPtr;

    ptkeyPtr = TclpSysAlloc(sizeof(pthread_key_t));
    if (NULL == ptkeyPtr) {
	Tcl_Panic("unable to allocate thread key!");
    }

    if (pthread_key_create(ptkeyPtr, NULL)) {
	Tcl_Panic("unable to create pthread key!");
    }
Changes to unix/tclUnixTime.c.
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

unsigned long
TclpGetSeconds(void)
{
    return time(NULL);
}

/*
 *----------------------------------------------------------------------







|







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetSeconds(void)
{
    return time(NULL);
}

/*
 *----------------------------------------------------------------------
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

unsigned long
TclpGetClicks(void)
{
    unsigned long now;

#ifdef NO_GETTOD
    if (tclGetTimeProcPtr != NativeGetTime) {
	Tcl_Time time;

	tclGetTimeProcPtr(&time, tclTimeClientData);
	now = time.sec*1000000 + time.usec;
    } else {
	/*
	 * A semi-NativeGetTime, specialized to clicks.
	 */
	struct tms dummy;

	now = (unsigned long) times(&dummy);
    }
#else
    Tcl_Time time;

    tclGetTimeProcPtr(&time, tclTimeClientData);
    now = time.sec*1000000 + time.usec;
#endif

    return now;
}
#ifdef TCL_WIDE_CLICKS

/*
 *----------------------------------------------------------------------
 *
 * TclpGetWideClicks --
 *
 *	This procedure returns a WideInt value that represents the highest
 *	resolution clock available on the system. There are no garantees on
 *	what the resolution will be. In Tcl we will call this value a "click".
 *	The start time is also system dependant.
 *
 * Results:
 *	Number of WideInt clicks from some start time.
 *
 * Side effects:
 *	None.
 *







|


|






|






|





|












|

|







71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetClicks(void)
{
	Tcl_WideUInt now;

#ifdef NO_GETTOD
    if (tclGetTimeProcPtr != NativeGetTime) {
	Tcl_Time time;

	tclGetTimeProcPtr(&time, tclTimeClientData);
	now = (Tcl_WideUInt)time.sec*1000000 + time.usec;
    } else {
	/*
	 * A semi-NativeGetTime, specialized to clicks.
	 */
	struct tms dummy;

	now = (Tcl_WideUInt) times(&dummy);
    }
#else
    Tcl_Time time;

    tclGetTimeProcPtr(&time, tclTimeClientData);
    now = (Tcl_WideUInt)time.sec*1000000 + time.usec;
#endif

    return now;
}
#ifdef TCL_WIDE_CLICKS

/*
 *----------------------------------------------------------------------
 *
 * TclpGetWideClicks --
 *
 *	This procedure returns a WideInt value that represents the highest
 *	resolution clock available on the system. There are no guarantees on
 *	what the resolution will be. In Tcl we will call this value a "click".
 *	The start time is also system dependent.
 *
 * Results:
 *	Number of WideInt clicks from some start time.
 *
 * Side effects:
 *	None.
 *
Changes to unix/tclXtNotify.c.
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	filePtr = ckalloc(sizeof(FileHandler));
	filePtr->fd = fd;
	filePtr->read = 0;
	filePtr->write = 0;
	filePtr->except = 0;
	filePtr->readyMask = 0;
	filePtr->mask = 0;
	filePtr->nextPtr = notifier.firstFileHandlerPtr;







|







355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	filePtr = Tcl_Alloc(sizeof(FileHandler));
	filePtr->fd = fd;
	filePtr->read = 0;
	filePtr->write = 0;
	filePtr->except = 0;
	filePtr->readyMask = 0;
	filePtr->mask = 0;
	filePtr->nextPtr = notifier.firstFileHandlerPtr;
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
    }
    if (filePtr->mask & TCL_WRITABLE) {
	XtRemoveInput(filePtr->write);
    }
    if (filePtr->mask & TCL_EXCEPTION) {
	XtRemoveInput(filePtr->except);
    }
    ckfree(filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileProc --
 *







|







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
    }
    if (filePtr->mask & TCL_WRITABLE) {
	XtRemoveInput(filePtr->write);
    }
    if (filePtr->mask & TCL_EXCEPTION) {
	XtRemoveInput(filePtr->except);
    }
    Tcl_Free(filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileProc --
 *
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
    }

    /*
     * This is an interesting event, so put it onto the event queue.
     */

    filePtr->readyMask |= mask;
    fileEvPtr = ckalloc(sizeof(FileHandlerEvent));
    fileEvPtr->header.proc = FileHandlerEventProc;
    fileEvPtr->fd = filePtr->fd;
    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);

    /*
     * Process events on the Tcl event queue before returning to Xt.
     */







|







521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
    }

    /*
     * This is an interesting event, so put it onto the event queue.
     */

    filePtr->readyMask |= mask;
    fileEvPtr = Tcl_Alloc(sizeof(FileHandlerEvent));
    fileEvPtr->header.proc = FileHandlerEventProc;
    fileEvPtr->fd = filePtr->fd;
    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);

    /*
     * Process events on the Tcl event queue before returning to Xt.
     */
Changes to win/Makefile.in.
132
133
134
135
136
137
138





139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154

155
156
157
158
159
160
161

VER			= @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@
DOTVER			= @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@
DDEVER			= @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@
DDEDOTVER		= @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@
REGVER			= @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@
REGDOTVER		= @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@






TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
TCL_DLL_FILE		= @TCL_DLL_FILE@
TCL_LIB_FILE		= @TCL_LIB_FILE@
DDE_DLL_FILE		= tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX}
REG_DLL_FILE		= tclreg$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${LIBSUFFIX}
ZLIB_DLL_FILE		= zlib1.dll

SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@
STATIC_LIBRARIES	= $(TCL_LIB_FILE)

TCLSH			= tclsh$(VER)${EXESUFFIX}

CAT32			= cat32$(EXEEXT)
MAN2TCL			= man2tcl$(EXEEXT)

# For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is
# available *BEFORE* running make for the first time. Certain build targets
# (make genstubs, make install) need it to be available on the PATH. This
# executable should *NOT* be required just to do a normal build although







>
>
>
>
>
















>







132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167

VER			= @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@
DOTVER			= @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@
DDEVER			= @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@
DDEDOTVER		= @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@
REGVER			= @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@
REGDOTVER		= @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@

TCL_ZIP_FILE		= @TCL_ZIP_FILE@
TCL_VFS_PATH		= libtcl.vfs/tcl_library
TCL_VFS_ROOT		= libtcl.vfs


TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
TCL_DLL_FILE		= @TCL_DLL_FILE@
TCL_LIB_FILE		= @TCL_LIB_FILE@
DDE_DLL_FILE		= tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX}
REG_DLL_FILE		= tclreg$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${LIBSUFFIX}
ZLIB_DLL_FILE		= zlib1.dll

SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@
STATIC_LIBRARIES	= $(TCL_LIB_FILE)

TCLSH			= tclsh$(VER)${EXESUFFIX}
WINE			= @WINE@
CAT32			= cat32$(EXEEXT)
MAN2TCL			= man2tcl$(EXEEXT)

# For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is
# available *BEFORE* running make for the first time. Certain build targets
# (make genstubs, make install) need it to be available on the PATH. This
# executable should *NOT* be required just to do a normal build although
192
193
194
195
196
197
198







































199
200
201
202
203
204
205

RMDIR		= rm -rf
MKDIR		= mkdir -p
SHELL		= @SHELL@
RM		= rm -f
COPY		= cp








































CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
-I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" \
-DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}

CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250

RMDIR		= rm -rf
MKDIR		= mkdir -p
SHELL		= @SHELL@
RM		= rm -f
COPY		= cp

###
# Tip 430 - ZipFS Modifications
###

TCL_ZIP_FILE		= @TCL_ZIP_FILE@
TCL_VFS_PATH		= libtcl.vfs/tcl_library
TCL_VFS_ROOT		= libtcl.vfs

HOST_CC		        = @CC_FOR_BUILD@
HOST_EXEEXT             = @EXEEXT_FOR_BUILD@
HOST_OBJEXT             = @OBJEXT_FOR_BUILD@
ZIPFS_BUILD	        = @ZIPFS_BUILD@
NATIVE_ZIP		= @ZIP_PROG@
ZIP_PROG_OPTIONS		= @ZIP_PROG_OPTIONS@
ZIP_PROG_VFSSEARCH  = @ZIP_PROG_VFSSEARCH@
SHARED_BUILD		= @SHARED_BUILD@
INSTALL_MSGS            = @INSTALL_MSGS@
INSTALL_LIBRARIES       = @INSTALL_LIBRARIES@

# Minizip
MINIZIP_OBJS = \
        adler32.$(HOST_OBJEXT) \
        compress.$(HOST_OBJEXT) \
        crc32.$(HOST_OBJEXT) \
        deflate.$(HOST_OBJEXT) \
        infback.$(HOST_OBJEXT) \
        inffast.$(HOST_OBJEXT) \
        inflate.$(HOST_OBJEXT) \
        inftrees.$(HOST_OBJEXT) \
        ioapi.$(HOST_OBJEXT) \
        iowin32.$(HOST_OBJEXT)  \
        trees.$(HOST_OBJEXT) \
        uncompr.$(HOST_OBJEXT) \
        zip.$(HOST_OBJEXT) \
        zutil.$(HOST_OBJEXT) \
        minizip.$(HOST_OBJEXT)

ZIP_INSTALL_OBJS =  @ZIP_INSTALL_OBJS@

CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
-I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" \
-DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}

CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@
299
300
301
302
303
304
305

306
307
308
309
310
311
312
	tclThreadStorage.$(OBJEXT) \
	tclTimer.$(OBJEXT) \
	tclTomMathInterface.$(OBJEXT) \
	tclTrace.$(OBJEXT) \
	tclUtf.$(OBJEXT) \
	tclUtil.$(OBJEXT) \
	tclVar.$(OBJEXT) \

	tclZlib.$(OBJEXT)

TOMMATH_OBJS = \
	bncore.${OBJEXT} \
	bn_reverse.${OBJEXT} \
	bn_fast_s_mp_mul_digs.${OBJEXT} \
	bn_fast_s_mp_sqr.${OBJEXT} \







>







344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
	tclThreadStorage.$(OBJEXT) \
	tclTimer.$(OBJEXT) \
	tclTomMathInterface.$(OBJEXT) \
	tclTrace.$(OBJEXT) \
	tclUtf.$(OBJEXT) \
	tclUtil.$(OBJEXT) \
	tclVar.$(OBJEXT) \
	tclZipfs.$(OBJEXT) \
	tclZlib.$(OBJEXT)

TOMMATH_OBJS = \
	bncore.${OBJEXT} \
	bn_reverse.${OBJEXT} \
	bn_fast_s_mp_mul_digs.${OBJEXT} \
	bn_fast_s_mp_sqr.${OBJEXT} \
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436










437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459




460
461
462
463
464
465
466

TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]

all: binaries libraries doc packages

tcltest: $(TCLSH) $(TEST_DLL_FILE)

binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH)

winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}

libraries:

doc:











$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
	$(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
	@VC_MANIFEST_EMBED_EXE@

cat32.$(OBJEXT): cat.c
	$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)

$(CAT32): cat32.$(OBJEXT)
	$(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE)

# The following targets are configured by autoconf to generate either a shared
# library or static library

${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
	@$(RM) ${TCL_STUB_LIB_FILE}
	@MAKE_STUB_LIB@ ${STUB_OBJS}
	@POST_MAKE_LIB@

${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@
	@$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE)
	@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
	@VC_MANIFEST_EMBED_DLL@





${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
	@$(RM) ${TCL_LIB_FILE}
	@MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
	@POST_MAKE_LIB@

${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS}







|







>
>
>
>
>
>
>
>
>
>


|
















|



>
>
>
>







468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526

TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]

all: binaries libraries doc packages

tcltest: $(TCLSH) $(TEST_DLL_FILE)

binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH)

winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}

libraries:

doc:

tclzipfile: ${TCL_ZIP_FILE}

${TCL_ZIP_FILE}:  ${ZIP_INSTALL_OBJS} ${DDE_DLL_FILE} ${REG_DLL_FILE}
	rm -rf ${TCL_VFS_ROOT}
	mkdir -p ${TCL_VFS_PATH}
	$(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}
	$(COPY) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde
	$(COPY) ${REG_DLL_FILE} ${TCL_VFS_PATH}/reg
	cd  ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH}

$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
	$(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
	tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
	@VC_MANIFEST_EMBED_EXE@

cat32.$(OBJEXT): cat.c
	$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)

$(CAT32): cat32.$(OBJEXT)
	$(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE)

# The following targets are configured by autoconf to generate either a shared
# library or static library

${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
	@$(RM) ${TCL_STUB_LIB_FILE}
	@MAKE_STUB_LIB@ ${STUB_OBJS}
	@POST_MAKE_LIB@

${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ ${TCL_ZIP_FILE}
	@$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE)
	@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
	@VC_MANIFEST_EMBED_DLL@
ifeq (${ZIPFS_BUILD},1)
	cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE}
	${NATIVE_ZIP} -A ${TCL_DLL_FILE}
endif

${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
	@$(RM) ${TCL_LIB_FILE}
	@MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
	@POST_MAKE_LIB@

${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS}
497
498
499
500
501
502
503











504
505
506
507
508
509
510
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

testMain.${OBJEXT}: tclAppInit.c
	$(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME)

tclMain2.${OBJEXT}: tclMain.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)












# TIP #59, embedding of configuration information into the binary library.
#
# Part of Tcl's configuration information are the paths where it was installed
# and where it will look for its libraries (which can be different). We derive
# this information from the variables which can be overridden by the user. As
# every path can be configured separately we do not remember one general







>
>
>
>
>
>
>
>
>
>
>







557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

testMain.${OBJEXT}: tclAppInit.c
	$(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME)

tclMain2.${OBJEXT}: tclMain.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)

# TIP #430, ZipFS Support
tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl \
	-DCFG_RUNTIME_PATH=\"$(bindir_native)\" \
	-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
	-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
	-DCFG_RUNTIME_LIBDIR="\"$(bindir_native)\"" \
	-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \
	$(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip  @DEPARG@ $(CC_OBJNAME)


# TIP #59, embedding of configuration information into the binary library.
#
# Part of Tcl's configuration information are the paths where it was installed
# and where it will look for its libraries (which can be different). We derive
# this information from the variables which can be overridden by the user. As
# every path can be configured separately we do not remember one general
519
520
521
522
523
524
525


526
527
528
529
530
531
532
		-DCFG_INSTALL_DOCDIR=\"$(MAN_INSTALL_DIR)\" \
		\
		-DCFG_RUNTIME_LIBDIR=\"$(libdir_native)\" \
		-DCFG_RUNTIME_BINDIR=\"$(bindir_native)\" \
		-DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \
		-DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \
		-DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \


		-DBUILD_tcl \
		@DEPARG@ $(CC_OBJNAME)

# The following objects are part of the stub library and should not be built
# as DLL objects but none of the symbols should be exported

tclStubLib.${OBJEXT}: tclStubLib.c







>
>







590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
		-DCFG_INSTALL_DOCDIR=\"$(MAN_INSTALL_DIR)\" \
		\
		-DCFG_RUNTIME_LIBDIR=\"$(libdir_native)\" \
		-DCFG_RUNTIME_BINDIR=\"$(bindir_native)\" \
		-DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \
		-DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \
		-DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
		-DBUILD_tcl \
		@DEPARG@ $(CC_OBJNAME)

# The following objects are part of the stub library and should not be built
# as DLL objects but none of the symbols should be exported

tclStubLib.${OBJEXT}: tclStubLib.c
542
543
544
545
546
547
548





















































549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568







569

570
571
572
573
574
575
576

%.${OBJEXT}: %.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME)

.rc.$(RES):
	$(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@






















































# The following target generates the file generic/tclDate.c from the yacc
# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is
# not available in all environments. The name of the .c file is different than
# the name of the .y file so that make doesn't try to automatically regenerate
# the .c file.

gendate:
	bison --output-file=$(GENERIC_DIR)/tclDate.c \
	--name-prefix=TclDate \
	--no-lines \
	$(GENERIC_DIR)/tclGetDate.y

# The following target generates the file generic/tclTomMath.h. It needs to be
# run (and the results checked) after updating to a new release of libtommath.

gentommath_h:
	$(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/fix_tommath_h.tcl" \
		"$(TOMMATH_DIR_NATIVE)/tommath.h" \
		> "$(GENERIC_DIR_NATIVE)/tclTomMath.h"








install: all install-binaries install-libraries install-doc install-packages


install-binaries: binaries
	@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) $$i; \







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




















>
>
>
>
>
>
>
|
>







615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710

%.${OBJEXT}: %.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME)

.rc.$(RES):
	$(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@



#--------------------------------------------------------------------------
# Minizip implementation
#--------------------------------------------------------------------------
adler32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c

compress.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c

crc32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c

deflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c

ioapi.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c

iowin32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c

infback.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c

inffast.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c

inflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c

inftrees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c

trees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c

uncompr.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c

zip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c

zutil.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c

minizip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -DIOAPI_NO_64 -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c

minizip${HOST_EXEEXT}: $(MINIZIP_OBJS)
	$(HOST_CC) -o $@ $(MINIZIP_OBJS)

# The following target generates the file generic/tclDate.c from the yacc
# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is
# not available in all environments. The name of the .c file is different than
# the name of the .y file so that make doesn't try to automatically regenerate
# the .c file.

gendate:
	bison --output-file=$(GENERIC_DIR)/tclDate.c \
	--name-prefix=TclDate \
	--no-lines \
	$(GENERIC_DIR)/tclGetDate.y

# The following target generates the file generic/tclTomMath.h. It needs to be
# run (and the results checked) after updating to a new release of libtommath.

gentommath_h:
	$(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/fix_tommath_h.tcl" \
		"$(TOMMATH_DIR_NATIVE)/tommath.h" \
		> "$(GENERIC_DIR_NATIVE)/tclTomMath.h"

INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA)
INSTALL_DOC_TARGETS = install-doc
INSTALL_PACKAGE_TARGETS = install-packages
INSTALL_DEV_TARGETS = install-headers
INSTALL_EXTRA_TARGETS =
INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \
		  $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS)

install: $(INSTALL_TARGETS)

install-binaries: binaries
	@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) $$i; \
617
618
619
620
621
622
623





624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
		$(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    fi
	@if [ -f $(REG_LIB_FILE) ]; then \
	    echo Installing $(REG_LIB_FILE); \
	    $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    fi






install-libraries: libraries install-tzdata install-msgs
	@for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \
		$(SCRIPT_INSTALL_DIR); \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) $$i; \
		else true; \
		fi; \
	    done;
	@for i in opt0.4 encoding ../tcl9 ../tcl9/9.0 ../tcl9/9.0/platform; \
	    do \
	    if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing header files";
	@for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \
		"$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \
		"$(GENERIC_DIR)/tclPlatDecls.h" \
		"$(GENERIC_DIR)/tclTomMath.h" \
		"$(GENERIC_DIR)/tclTomMathDecls.h"; \
	    do \
	    $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
	    done;
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
	@for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
	    do \
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package http 2.8.13 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/http-2.8.13.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.7.0 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/msgcat-1.7.0.tm;







>
>
>
>
>


















<
<
<
<
<
<
<
<
<





|
|







751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780









781
782
783
784
785
786
787
788
789
790
791
792
793
794
		$(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    fi
	@if [ -f $(REG_LIB_FILE) ]; then \
	    echo Installing $(REG_LIB_FILE); \
	    $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    fi

install-libraries-zipfs-shared: libraries

install-libraries-zipfs-static: install-libraries-zipfs-shared
	$(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)"

install-libraries: libraries install-tzdata install-msgs
	@for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \
		$(SCRIPT_INSTALL_DIR); \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) $$i; \
		else true; \
		fi; \
	    done;
	@for i in opt0.4 encoding ../tcl9 ../tcl9/9.0 ../tcl9/9.0/platform; \
	    do \
	    if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \
		else true; \
		fi; \
	    done;









	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
	@for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
	    do \
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package http 2.9.0 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/http-2.9.0.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.7.0 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/msgcat-1.7.0.tm;
680
681
682
683
684
685
686



















687
688
689
690
691
692
693

install-msgs:
	@echo "Installing message catalogs"
	@$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
	    "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"

install-doc: doc




















# Optional target to install private headers
install-private-headers: libraries
	@for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842

install-msgs:
	@echo "Installing message catalogs"
	@$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
	    "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"

install-doc: doc

install-headers:
	@for i in "$(INCLUDE_INSTALL_DIR)"; \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	@echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
	@for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
		$(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
		$(GENERIC_DIR)/tclPlatDecls.h \
		$(GENERIC_DIR)/tclTomMath.h \
		$(GENERIC_DIR)/tclTomMathDecls.h ; \
	    do \
	    $(COPY) $$i "$(INCLUDE_INSTALL_DIR)"; \
	    done;

# Optional target to install private headers
install-private-headers: libraries
	@for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
708
709
710
711
712
713
714
715
716

717
718
719
720
721
722
723

724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750



751
752
753
754
755
756
757
758
759
760
761
# tcltest, i.e.:
#	% make test TESTFLAGS="-verbose bps -file fileName.test"

test: test-tcl test-packages

test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
	-load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \

	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)

# Useful target to launch a built tclsh with the proper path,...
runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \

	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)

# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
shell: binaries
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: binaries
	@echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run
	gdb ./$(TCLSH) --command=gdb.run
	rm gdb.run

depend:

Makefile: $(SRC_DIR)/Makefile.in
	./config.status

cleanhelp:
	$(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe

clean: cleanhelp clean-packages
	$(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
	$(RM) $(TCLSH) $(CAT32)
	$(RM) *.pch *.ilk *.pdb




distclean: distclean-packages clean
	$(RM) Makefile config.status config.cache config.log tclConfig.sh \
		tcl.hpj config.status.lineno

#
# Bundled package targets
#

PKG_CFG_ARGS		= @PKG_CFG_ARGS@
PKG_DIR			= ./pkgs







|

>

|




|
>







|



















>
>
>



|







857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
# tcltest, i.e.:
#	% make test TESTFLAGS="-verbose bps -file fileName.test"

test: test-tcl test-packages

test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	$(WINE) ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
	-load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
	package ifneeded tcltests 0.1 \"[list source [file normalize $(ROOT_DIR_NATIVE)/tests/tcltests.tcl]];package provide tcltests 0.1\"; \
	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | $(WINE) ./$(CAT32)

# Useful target to launch a built tclsh with the proper path,...
runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	$(WINE) ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
	package ifneeded tcltests 0.1 \"[list source [file normalize $(ROOT_DIR_NATIVE)/tests/tcltests.tcl]];package provide tcltests 0.1\"; \
	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)

# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
shell: binaries
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	$(WINE) ./$(TCLSH) $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: binaries
	@echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run
	gdb ./$(TCLSH) --command=gdb.run
	rm gdb.run

depend:

Makefile: $(SRC_DIR)/Makefile.in
	./config.status

cleanhelp:
	$(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe

clean: cleanhelp clean-packages
	$(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
	$(RM) $(TCLSH) $(CAT32)
	$(RM) *.pch *.ilk *.pdb
	$(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT}
	$(RM) *.zip
	$(RMDIR) *.vfs

distclean: distclean-packages clean
	$(RM) Makefile config.status config.cache config.log tclConfig.sh \
		tcl.hpj config.status.lineno tclsh.exe.manifest

#
# Bundled package targets
#

PKG_CFG_ARGS		= @PKG_CFG_ARGS@
PKG_DIR			= ./pkgs
876
877
878
879
880
881
882

883
884

.PHONY: all tcltest binaries libraries doc gendate gentommath_h install
.PHONY: install-binaries install-libraries install-tzdata install-msgs
.PHONY: install-doc install-private-headers test test-tcl runtest shell
.PHONY: gdb depend cleanhelp clean distclean packages install-packages
.PHONY: test-packages clean-packages distclean-packages genstubs html
.PHONY: html-tcl html-tk


# DO NOT DELETE THIS LINE -- make depend depends on it.







>


1030
1031
1032
1033
1034
1035
1036
1037
1038
1039

.PHONY: all tcltest binaries libraries doc gendate gentommath_h install
.PHONY: install-binaries install-libraries install-tzdata install-msgs
.PHONY: install-doc install-private-headers test test-tcl runtest shell
.PHONY: gdb depend cleanhelp clean distclean packages install-packages
.PHONY: test-packages clean-packages distclean-packages genstubs html
.PHONY: html-tcl html-tk
.PHONY: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile

# DO NOT DELETE THIS LINE -- make depend depends on it.
Changes to win/configure.
695
696
697
698
699
700
701











702
703
704
705
706
707
708

709

710
711
712
713
714
715
716
TCL_VERSION
MACHINE
TCL_WIN_VERSION
VC_MANIFEST_EMBED_EXE
VC_MANIFEST_EMBED_DLL
LDFLAGS_DEFAULT
CFLAGS_DEFAULT











ZLIB_OBJS
ZLIB_LIBS
ZLIB_DLL_FILE
CFLAGS_WARNING
CFLAGS_OPTIMIZE
CFLAGS_DEBUG
DL_LIBS

CYGPATH

SET_MAKE
RC
RANLIB
AR
EGREP
GREP
CPP







>
>
>
>
>
>
>
>
>
>
>







>

>







695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
TCL_VERSION
MACHINE
TCL_WIN_VERSION
VC_MANIFEST_EMBED_EXE
VC_MANIFEST_EMBED_DLL
LDFLAGS_DEFAULT
CFLAGS_DEFAULT
INSTALL_MSGS
INSTALL_LIBRARIES
TCL_ZIP_FILE
ZIPFS_BUILD
ZIP_INSTALL_OBJS
ZIP_PROG_VFSSEARCH
ZIP_PROG_OPTIONS
ZIP_PROG
TCLSH_PROG
EXEEXT_FOR_BUILD
CC_FOR_BUILD
ZLIB_OBJS
ZLIB_LIBS
ZLIB_DLL_FILE
CFLAGS_WARNING
CFLAGS_OPTIMIZE
CFLAGS_DEBUG
DL_LIBS
WINE
CYGPATH
SHARED_BUILD
SET_MAKE
RC
RANLIB
AR
EGREP
GREP
CPP
754
755
756
757
758
759
760
761

762
763
764
765
766
767

768
769
770
771
772
773
774
PACKAGE_URL
PACKAGE_BUGREPORT
PACKAGE_STRING
PACKAGE_VERSION
PACKAGE_TARNAME
PACKAGE_NAME
PATH_SEPARATOR
SHELL'

ac_subst_files=''
ac_user_opts='
enable_option_checking
with_encoding
enable_shared
enable_64bit

enable_symbols
enable_embedded_manifest
'
      ac_precious_vars='build_alias
host_alias
target_alias
CC







|
>






>







767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
PACKAGE_URL
PACKAGE_BUGREPORT
PACKAGE_STRING
PACKAGE_VERSION
PACKAGE_TARNAME
PACKAGE_NAME
PATH_SEPARATOR
SHELL
OBJEXT_FOR_BUILD'
ac_subst_files=''
ac_user_opts='
enable_option_checking
with_encoding
enable_shared
enable_64bit
enable_zipfs
enable_symbols
enable_embedded_manifest
'
      ac_precious_vars='build_alias
host_alias
target_alias
CC
1382
1383
1384
1385
1386
1387
1388

1389
1390
1391
1392
1393
1394
1395

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
  --enable-shared         build and link with shared libraries (default: on)
  --enable-64bit          enable 64bit support (where applicable)

  --enable-symbols        build with debugging symbols (default: off)
  --enable-embedded-manifest
                          embed manifest if possible (default: yes)

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)







>







1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
  --enable-shared         build and link with shared libraries (default: on)
  --enable-64bit          enable 64bit support (where applicable)
  --enable-zipfs          build with Zipfs support (default: on)
  --enable-symbols        build with debugging symbols (default: off)
  --enable-embedded-manifest
                          embed manifest if possible (default: yes)

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
3726
3727
3728
3729
3730
3731
3732

3733
3734
3735
3736
3737
3738
3739
$as_echo "static" >&6; }
	SHARED_BUILD=0

$as_echo "#define STATIC_BUILD 1" >>confdefs.h

    fi



#--------------------------------------------------------------------
# The statements below define a collection of compile flags.  This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------








>







3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
$as_echo "static" >&6; }
	SHARED_BUILD=0

$as_echo "#define STATIC_BUILD 1" >>confdefs.h

    fi



#--------------------------------------------------------------------
# The statements below define a collection of compile flags.  This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------

3804
3805
3806
3807
3808
3809
3810





































3811
3812
3813
3814
3815
3816
3817
  test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo"
fi
fi
CYGPATH=$ac_cv_prog_CYGPATH
if test -n "$CYGPATH"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5
$as_echo "$CYGPATH" >&6; }





































else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi










>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
  test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo"
fi
fi
CYGPATH=$ac_cv_prog_CYGPATH
if test -n "$CYGPATH"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5
$as_echo "$CYGPATH" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi


    # Extract the first word of "wine", so it can be a program name with args.
set dummy wine; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_WINE+:} false; then :
  $as_echo_n "(cached) " >&6
else
  if test -n "$WINE"; then
  ac_cv_prog_WINE="$WINE" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_WINE="wine"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi
fi
WINE=$ac_cv_prog_WINE
if test -n "$WINE"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $WINE" >&5
$as_echo "$WINE" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi



4654
4655
4656
4657
4658
4659
4660










































































































































































































4661
4662
4663
4664
4665
4666
4667
cat >>confdefs.h <<_ACEOF
#define uintptr_t $tcl_cv_uintptr_t
_ACEOF

    fi

fi












































































































































































































#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------

# See if declarations like FINDEX_INFO_LEVELS are







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
cat >>confdefs.h <<_ACEOF
#define uintptr_t $tcl_cv_uintptr_t
_ACEOF

    fi

fi



#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
# Check whether --enable-zipfs was given.
if test "${enable_zipfs+set}" = set; then :
  enableval=$enable_zipfs; tcl_ok=$enableval
else
  tcl_ok=yes
fi

if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    # Put a plausible default for CC_FOR_BUILD in Makefile.
if test -z "$CC_FOR_BUILD"; then
  if test "x$cross_compiling" = "xno"; then
    CC_FOR_BUILD='$(CC)'
  else
    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
$as_echo_n "checking for gcc... " >&6; }
    if ${ac_cv_path_cc+:} false; then :
  $as_echo_n "(cached) " >&6
else

	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
	for dir in $search_path ; do
	    for j in `ls -r $dir/gcc 2> /dev/null` \
		    `ls -r $dir/gcc 2> /dev/null` ; do
		if test x"$ac_cv_path_cc" = x ; then
		    if test -f "$j" ; then
			ac_cv_path_cc=$j
			break
		    fi
		fi
	    done
	done

fi

  fi
fi

# Also set EXEEXT_FOR_BUILD.
if test "x$cross_compiling" = "xno"; then
  EXEEXT_FOR_BUILD='$(EXEEXT)'
  OBJEXT_FOR_BUILD='$(OBJEXT)'
else
  OBJEXT_FOR_BUILD='.no'
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
$as_echo_n "checking for build system executable suffix... " >&6; }
if ${bfd_cv_build_exeext+:} false; then :
  $as_echo_n "(cached) " >&6
else
  rm -f conftest*
     echo 'int main () { return 0; }' > conftest.c
     bfd_cv_build_exeext=
     ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
     for file in conftest.*; do
       case $file in
       *.c | *.o | *.obj | *.ilk | *.pdb) ;;
       *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
       esac
     done
     rm -f conftest*
     test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
$as_echo "$bfd_cv_build_exeext" >&6; }
  EXEEXT_FOR_BUILD=""
  test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
fi

    #
    # Find a native zip implementation
    #

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
$as_echo_n "checking for tclsh... " >&6; }

    if ${ac_cv_path_tclsh+:} false; then :
  $as_echo_n "(cached) " >&6
else

	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
	for dir in $search_path ; do
	    for j in `ls -r $dir/tclsh[8-9]*.exe 2> /dev/null` \
		    `ls -r $dir/tclsh* 2> /dev/null` ; do
		if test x"$ac_cv_path_tclsh" = x ; then
		    if test -f "$j" ; then
			ac_cv_path_tclsh=$j
			break
		    fi
		fi
	    done
	done

fi


    if test -f "$ac_cv_path_tclsh" ; then
	TCLSH_PROG="$ac_cv_path_tclsh"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
$as_echo "$TCLSH_PROG" >&6; }
    else
	# It is not an error if an installed version of Tcl can't be located.
	TCLSH_PROG=""
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
$as_echo "No tclsh found on PATH" >&6; }
    fi



    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
$as_echo_n "checking for zip... " >&6; }
    if ${ac_cv_path_zip+:} false; then :
  $as_echo_n "(cached) " >&6
else

    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
        for j in `ls -r $dir/zip 2> /dev/null` \
            `ls -r $dir/zip 2> /dev/null` ; do
        if test x"$ac_cv_path_zip" = x ; then
            if test -f "$j" ; then
            ac_cv_path_zip=$j
            break
            fi
        fi
        done
    done

fi

    if test -f "$ac_cv_path_zip" ; then
        ZIP_PROG="$ac_cv_path_zip "
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
$as_echo "$ZIP_PROG" >&6; }
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="."
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
$as_echo "Found INFO Zip in environment" >&6; }
        # Use standard arguments for zip
    else
        # It is not an error if an installed version of Zip can't be located.
        # We can use the locally distributed minizip instead
        ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
        ZIP_PROG_OPTIONS="-o -r"
        ZIP_PROG_VFSSEARCH="."
        ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5
$as_echo "No zip found on PATH building minizip" >&6; }
    fi





	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
$as_echo_n "checking for building with zipfs... " >&6; }
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;

$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h

       INSTALL_LIBRARIES=install-libraries-zipfs-static
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
     else

$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h
\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
    fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi






#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------

# See if declarations like FINDEX_INFO_LEVELS are
Changes to win/configure.ac.
163
164
165
166
167
168
169
















































170
171
172
173
174
175
176
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_uintptr_t" != none; then
	AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer
	   type wide enough to hold a pointer.])
    fi
])

















































#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_uintptr_t" != none; then
	AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer
	   type wide enough to hold a pointer.])
    fi
])


#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
AC_ARG_ENABLE(zipfs,
    AC_HELP_STRING([--enable-zipfs],
	[build with Zipfs support (default: on)]),
    [tcl_ok=$enableval], [tcl_ok=yes])
if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    AX_CC_FOR_BUILD
    #
    # Find a native zip implementation
    #
    SC_PROG_TCLSH
    SC_ZIPFS_SUPPORT
	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
AC_MSG_CHECKING([for building with zipfs])
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;
       AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?])
       INSTALL_LIBRARIES=install-libraries-zipfs-static
       AC_MSG_RESULT([yes])
     else
       AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       AC_MSG_RESULT([yes])
    fi
else
AC_MSG_RESULT([no])
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi
AC_SUBST(ZIPFS_BUILD)
AC_SUBST(TCL_ZIP_FILE)
AC_SUBST(INSTALL_LIBRARIES)
AC_SUBST(INSTALL_MSGS)


#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
Changes to win/makefile.vc.
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
TCLREGLIBNAME	= $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB	= $(OUT_DIR)\$(TCLREGLIBNAME)

TCLDDELIBNAME	= $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB	= $(OUT_DIR)\$(TCLDDELIBNAME)

TCLTEST		= $(OUT_DIR)\$(PROJECT)test.exe
CAT32		= $(OUT_DIR)\cat32.exe

TCLSHOBJS = \
	$(TMP_DIR)\tclAppInit.obj \
!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
	$(TMP_DIR)\tclWinReg.obj \
	$(TMP_DIR)\tclWinDde.obj \







<







119
120
121
122
123
124
125

126
127
128
129
130
131
132
TCLREGLIBNAME	= $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB	= $(OUT_DIR)\$(TCLREGLIBNAME)

TCLDDELIBNAME	= $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB	= $(OUT_DIR)\$(TCLDDELIBNAME)

TCLTEST		= $(OUT_DIR)\$(PROJECT)test.exe


TCLSHOBJS = \
	$(TMP_DIR)\tclAppInit.obj \
!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
	$(TMP_DIR)\tclWinReg.obj \
	$(TMP_DIR)\tclWinDde.obj \
232
233
234
235
236
237
238

239
240
241
242
243
244
245
	$(TMP_DIR)\tclThreadStorage.obj \
	$(TMP_DIR)\tclTimer.obj \
	$(TMP_DIR)\tclTomMathInterface.obj \
	$(TMP_DIR)\tclTrace.obj \
	$(TMP_DIR)\tclUtf.obj \
	$(TMP_DIR)\tclUtil.obj \
	$(TMP_DIR)\tclVar.obj \

	$(TMP_DIR)\tclZlib.obj

ZLIBOBJS = \
	$(TMP_DIR)\adler32.obj \
	$(TMP_DIR)\compress.obj \
	$(TMP_DIR)\crc32.obj \
	$(TMP_DIR)\deflate.obj \







>







231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
	$(TMP_DIR)\tclThreadStorage.obj \
	$(TMP_DIR)\tclTimer.obj \
	$(TMP_DIR)\tclTomMathInterface.obj \
	$(TMP_DIR)\tclTrace.obj \
	$(TMP_DIR)\tclUtf.obj \
	$(TMP_DIR)\tclUtil.obj \
	$(TMP_DIR)\tclVar.obj \
	$(TMP_DIR)\tclZipfs.obj \
	$(TMP_DIR)\tclZlib.obj

ZLIBOBJS = \
	$(TMP_DIR)\adler32.obj \
	$(TMP_DIR)\compress.obj \
	$(TMP_DIR)\crc32.obj \
	$(TMP_DIR)\deflate.obj \
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
# Project specific targets
#---------------------------------------------------------------------

release:    setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
core:	    setup $(TCLLIB) $(TCLSTUBLIB)
shell:	    setup $(TCLSH)
dlls:	    setup $(TCLREGLIB) $(TCLDDELIB)
all:	    setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs
tcltest:    setup $(TCLTEST) dlls $(CAT32)
install:    install-binaries install-libraries install-docs install-pkgs
setup:      default-setup

test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls $(CAT32)
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
		package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.2 [list load "$(TCLREGLIB:\=/)" registry]
<<

runtest: setup $(TCLTEST) dlls $(CAT32)
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) $(SCRIPT)

runshell: setup $(TCLSH) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLSH) $(SCRIPT)








|
|




|






|







379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
# Project specific targets
#---------------------------------------------------------------------

release:    setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
core:	    setup $(TCLLIB) $(TCLSTUBLIB)
shell:	    setup $(TCLSH)
dlls:	    setup $(TCLREGLIB) $(TCLDDELIB)
all:	    setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
tcltest:    setup $(TCLTEST) dlls
install:    install-binaries install-libraries install-docs install-pkgs
setup:      default-setup

test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
		package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.2 [list load "$(TCLREGLIB:\=/)" registry]
<<

runtest: setup $(TCLTEST) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) $(SCRIPT)

runshell: setup $(TCLSH) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLSH) $(SCRIPT)

414
415
416
417
418
419
420

421
422
423
424
425
426
427
428
429
430
431
!else

$(TCLLIB): $(TCLOBJS)
	$(DLLCMD) @<<
$**
<<
	$(_VC_MANIFEST_EMBED_DLL)

$(TCLIMPLIB): $(TCLLIB)

!endif # $(STATIC_BUILD)


$(TCLSTUBLIB): $(TCLSTUBOBJS)
	$(LIBCMD) -nodefaultlib $(TCLSTUBOBJS)

$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
	$(CONEXECMD) -stack:2300000 $**
	$(_VC_MANIFEST_EMBED_EXE)







>



<







414
415
416
417
418
419
420
421
422
423
424

425
426
427
428
429
430
431
!else

$(TCLLIB): $(TCLOBJS)
	$(DLLCMD) @<<
$**
<<
	$(_VC_MANIFEST_EMBED_DLL)

$(TCLIMPLIB): $(TCLLIB)

!endif # $(STATIC_BUILD)


$(TCLSTUBLIB): $(TCLSTUBOBJS)
	$(LIBCMD) -nodefaultlib $(TCLSTUBOBJS)

$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
	$(CONEXECMD) -stack:2300000 $**
	$(_VC_MANIFEST_EMBED_EXE)
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
	@for /d %d in ($(PKGSDIR)\*) do \
	  @if exist "%~fd\win\makefile.vc" ( \
	    pushd "%~fd\win" & \
	    $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\
	    popd \
	  )

$(CAT32): $(WINDIR)\cat.c
	$(cc32) $(cflags) $(crt) -D_CRT_NONSTDC_NO_DEPRECATE -DCONSOLE -Fo$(TMP_DIR)\ $?
	$(CONEXECMD) -stack:16384 $(TMP_DIR)\cat.obj
	$(_VC_MANIFEST_EMBED_EXE)

#---------------------------------------------------------------------
# Regenerate the stubs files.  [Development use only]
#---------------------------------------------------------------------

genstubs:
!if !exist($(TCLSH))
	@echo Build tclsh first!







<
<
<
<
<







480
481
482
483
484
485
486





487
488
489
490
491
492
493
	@for /d %d in ($(PKGSDIR)\*) do \
	  @if exist "%~fd\win\makefile.vc" ( \
	    pushd "%~fd\win" & \
	    $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\
	    popd \
	  )






#---------------------------------------------------------------------
# Regenerate the stubs files.  [Development use only]
#---------------------------------------------------------------------

genstubs:
!if !exist($(TCLSH))
	@echo Build tclsh first!
682
683
684
685
686
687
688



689
690
691
692
693
694
695
696
697
698
699
700
701
702
703


704
705
706
707
708
709
710

$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
	$(cc32) $(appcflags) -Fo$@ $?

$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
	$(CCAPPCMD) $?




$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
	$(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -Fo$@ $?

$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
	$(cc32) $(pkgcflags) \
	-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\""	\
	-DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\""     \


	-Fo$@ $?

$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
	$(cc32) $(appcflags) \
	    -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
	    -Fo$@ $?








>
>
>















>
>







677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710

$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
	$(cc32) $(appcflags) -Fo$@ $?

$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
	$(CCAPPCMD) $?

$(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c
	$(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip -Fo$@ $?

$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
	$(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -Fo$@ $?

$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
	$(cc32) $(pkgcflags) \
	-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\""	\
	-DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\""     \
	-DCFG_RUNTIME_DLLFILE="\"$(CFG_RUNTIME_DLLFILE:\=\\)\""     \
	-DCFG_RUNTIME_ZIPFILE="\"$(CFG_RUNTIME_ZIPFILE:\=\\)\""     \
	-Fo$@ $?

$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
	$(cc32) $(appcflags) \
	    -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
	    -Fo$@ $?

Changes to win/tcl.m4.
247
248
249
250
251
252
253

254
255
256
257
258
259
260
#
# Results:
#
#	Substitutes the following vars:
#		TCL_BIN_DIR
#		TCL_SRC_DIR
#		TCL_LIB_FILE

#
#------------------------------------------------------------------------

AC_DEFUN([SC_LOAD_TCLCONFIG], [
    AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh])

    if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then







>







247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
#
# Results:
#
#	Substitutes the following vars:
#		TCL_BIN_DIR
#		TCL_SRC_DIR
#		TCL_LIB_FILE
#		TCL_ZIP_FILE
#
#------------------------------------------------------------------------

AC_DEFUN([SC_LOAD_TCLCONFIG], [
    AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh])

    if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then
279
280
281
282
283
284
285

286
287
288
289
290
291
292
293
294
295
296
297

298
299
300
301
302
303
304
        TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH}
    fi

    #
    # eval is required to do the TCL_DBGX substitution
    #


    eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
    eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
    eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""

    eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
    eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
    eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""

    AC_SUBST(TCL_VERSION)
    AC_SUBST(TCL_BIN_DIR)
    AC_SUBST(TCL_SRC_DIR)


    AC_SUBST(TCL_LIB_FILE)
    AC_SUBST(TCL_LIB_FLAG)
    AC_SUBST(TCL_LIB_SPEC)

    AC_SUBST(TCL_STUB_LIB_FILE)
    AC_SUBST(TCL_STUB_LIB_FLAG)
    AC_SUBST(TCL_STUB_LIB_SPEC)







>












>







280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
        TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH}
    fi

    #
    # eval is required to do the TCL_DBGX substitution
    #

    eval "TCL_ZIP_FILE=\"${TCL_ZIP_FILE}\""
    eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
    eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
    eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""

    eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
    eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
    eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""

    AC_SUBST(TCL_VERSION)
    AC_SUBST(TCL_BIN_DIR)
    AC_SUBST(TCL_SRC_DIR)

    AC_SUBST(TCL_ZIP_FILE)
    AC_SUBST(TCL_LIB_FILE)
    AC_SUBST(TCL_LIB_FLAG)
    AC_SUBST(TCL_LIB_SPEC)

    AC_SUBST(TCL_STUB_LIB_FILE)
    AC_SUBST(TCL_STUB_LIB_FLAG)
    AC_SUBST(TCL_STUB_LIB_SPEC)
376
377
378
379
380
381
382

383
384
385
386
387
388
389
	AC_MSG_RESULT([shared])
	SHARED_BUILD=1
    else
	AC_MSG_RESULT([static])
	SHARED_BUILD=0
	AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
    fi

])

#------------------------------------------------------------------------
# SC_ENABLE_SYMBOLS --
#
#	Specify if debugging symbols should be used.
#	Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging







>







379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
	AC_MSG_RESULT([shared])
	SHARED_BUILD=1
    else
	AC_MSG_RESULT([static])
	SHARED_BUILD=0
	AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
    fi
    AC_SUBST(SHARED_BUILD)
])

#------------------------------------------------------------------------
# SC_ENABLE_SYMBOLS --
#
#	Specify if debugging symbols should be used.
#	Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging
509
510
511
512
513
514
515

516
517
518
519
520
521
522
    AC_MSG_RESULT($do64bit)

    # Set some defaults (may get changed below)
    EXTRA_CFLAGS=""
	AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])

    AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo)


    SHLIB_SUFFIX=".dll"

    # MACHINE is IX86 for LINK, but this is used by the manifest,
    # which requires x86|amd64|ia64.
    MACHINE="X86"








>







513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
    AC_MSG_RESULT($do64bit)

    # Set some defaults (may get changed below)
    EXTRA_CFLAGS=""
	AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])

    AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo)
    AC_CHECK_PROG(WINE, wine, wine,)

    SHLIB_SUFFIX=".dll"

    # MACHINE is IX86 for LINK, but this is used by the manifest,
    # which requires x86|amd64|ia64.
    MACHINE="X86"

1155
1156
1157
1158
1159
1160
1161



























































































































	fi
	])
    fi
    AC_MSG_RESULT([$result])
    AC_SUBST(VC_MANIFEST_EMBED_DLL)
    AC_SUBST(VC_MANIFEST_EMBED_EXE)
])


































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
	fi
	])
    fi
    AC_MSG_RESULT([$result])
    AC_SUBST(VC_MANIFEST_EMBED_DLL)
    AC_SUBST(VC_MANIFEST_EMBED_EXE)
])

#------------------------------------------------------------------------
# SC_CC_FOR_BUILD
#	For cross compiles, locate a C compiler that can generate native binaries.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		CC_FOR_BUILD
#		EXEEXT_FOR_BUILD
#------------------------------------------------------------------------

dnl Get a default for CC_FOR_BUILD to put into Makefile.
AC_DEFUN([AX_CC_FOR_BUILD],
[# Put a plausible default for CC_FOR_BUILD in Makefile.
if test -z "$CC_FOR_BUILD"; then
  if test "x$cross_compiling" = "xno"; then
    CC_FOR_BUILD='$(CC)'
  else
    AC_MSG_CHECKING([for gcc])
    AC_CACHE_VAL(ac_cv_path_cc, [
	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
	for dir in $search_path ; do
	    for j in `ls -r $dir/gcc 2> /dev/null` \
		    `ls -r $dir/gcc 2> /dev/null` ; do
		if test x"$ac_cv_path_cc" = x ; then
		    if test -f "$j" ; then
			ac_cv_path_cc=$j
			break
		    fi
		fi
	    done
	done
    ])
  fi
fi
AC_SUBST(CC_FOR_BUILD)
# Also set EXEEXT_FOR_BUILD.
if test "x$cross_compiling" = "xno"; then
  EXEEXT_FOR_BUILD='$(EXEEXT)'
  OBJEXT_FOR_BUILD='$(OBJEXT)'
else
  OBJEXT_FOR_BUILD='.no'
  AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext,
    [rm -f conftest*
     echo 'int main () { return 0; }' > conftest.c
     bfd_cv_build_exeext=
     ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
     for file in conftest.*; do
       case $file in
       *.c | *.o | *.obj | *.ilk | *.pdb) ;;
       *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
       esac
     done
     rm -f conftest*
     test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no])
  EXEEXT_FOR_BUILD=""
  test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
fi
AC_SUBST(EXEEXT_FOR_BUILD)])dnl
AC_SUBST(OBJEXT_FOR_BUILD)])dnl



#------------------------------------------------------------------------
# SC_ZIPFS_SUPPORT
#	Locate a zip encoder installed on the system path, or none.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		ZIP_PROG
#       ZIP_PROG_OPTIONS
#       ZIP_PROG_VFSSEARCH
#       ZIP_INSTALL_OBJS
#------------------------------------------------------------------------

AC_DEFUN([SC_ZIPFS_SUPPORT], [
    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    AC_MSG_CHECKING([for zip])
    AC_CACHE_VAL(ac_cv_path_zip, [
    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
        for j in `ls -r $dir/zip 2> /dev/null` \
            `ls -r $dir/zip 2> /dev/null` ; do
        if test x"$ac_cv_path_zip" = x ; then
            if test -f "$j" ; then
            ac_cv_path_zip=$j
            break
            fi
        fi
        done
    done
    ])
    if test -f "$ac_cv_path_zip" ; then
        ZIP_PROG="$ac_cv_path_zip "
        AC_MSG_RESULT([$ZIP_PROG])
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="."
        AC_MSG_RESULT([Found INFO Zip in environment])
        # Use standard arguments for zip
    else
        # It is not an error if an installed version of Zip can't be located.
        # We can use the locally distributed minizip instead
        ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
        ZIP_PROG_OPTIONS="-o -r"
        ZIP_PROG_VFSSEARCH="."
        ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
        AC_MSG_RESULT([No zip found on PATH building minizip])
    fi
    AC_SUBST(ZIP_PROG)
    AC_SUBST(ZIP_PROG_OPTIONS)
    AC_SUBST(ZIP_PROG_VFSSEARCH)
    AC_SUBST(ZIP_INSTALL_OBJS)
])
Changes to win/tclAppInit.c.
31
32
33
34
35
36
37
38
39


40
41
42
43
44
45
46

#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
extern Tcl_PackageInitProc Registry_Init;
extern Tcl_PackageInitProc Dde_Init;
extern Tcl_PackageInitProc Dde_SafeInit;
#endif

#ifdef TCL_BROKEN_MAINARGS
int _CRT_glob = 0;


static void setargv(int *argcPtr, TCHAR ***argvPtr);
#endif /* TCL_BROKEN_MAINARGS */

/*
 * The following #if block allows you to change the AppInit function by using
 * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
 * #if checks for that #define and uses Tcl_AppInit if it does not exist.







|

>
>







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
extern Tcl_PackageInitProc Registry_Init;
extern Tcl_PackageInitProc Dde_Init;
extern Tcl_PackageInitProc Dde_SafeInit;
#endif

#if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS)
int _CRT_glob = 0;
#endif /* __GNUC__ || TCL_BROKEN_MAINARGS */
#ifdef TCL_BROKEN_MAINARGS
static void setargv(int *argcPtr, TCHAR ***argvPtr);
#endif /* TCL_BROKEN_MAINARGS */

/*
 * The following #if block allows you to change the AppInit function by using
 * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
 * #if checks for that #define and uses Tcl_AppInit if it does not exist.
120
121
122
123
124
125
126



127
128
129
130
131
132
133
	if (*p == '\\') {
	    *p = '/';
	}
    }

#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);



#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*







>
>
>







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
	if (*p == '\\') {
	    *p = '/';
	}
    }

#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif !defined(_WIN32) || defined(UNICODE)
    /* This doesn't work on Windows without UNICODE */
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
	    }
	    if (*p == '\0') {
		break;
	    }
	}
    }

    /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
#   undef Tcl_Alloc
#   undef Tcl_DbCkalloc

    argSpace = ckalloc(size * sizeof(char *)
	    + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
    argv = (TCHAR **) argSpace;
    argSpace += size * (sizeof(char *)/sizeof(TCHAR));
    size--;

    p = cmdLine;
    for (argc = 0; argc < size; argc++) {







|

<

|







263
264
265
266
267
268
269
270
271

272
273
274
275
276
277
278
279
280
	    }
	    if (*p == '\0') {
		break;
	    }
	}
    }

    /* Make sure we don't call Tcl_Alloc through the (not yet initialized) stub table */
#   undef Tcl_Alloc


    argSpace = Tcl_Alloc(size * sizeof(char *)
	    + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
    argv = (TCHAR **) argSpace;
    argSpace += size * (sizeof(char *)/sizeof(TCHAR));
    size--;

    p = cmdLine;
    for (argc = 0; argc < size; argc++) {
Changes to win/tclConfig.sh.in.
36
37
38
39
40
41
42



43
44
45
46
47
48
49
TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@'

# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=@TCL_SHARED_BUILD@

# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='@TCL_LIB_FILE@'




# Flag to indicate whether shared libraries need export files.
TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@

# String that can be evaluated to generate the part of the export file
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed).  May depend on the variables







>
>
>







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@'

# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=@TCL_SHARED_BUILD@

# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='@TCL_LIB_FILE@'

# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library):
TCL_ZIP_FILE='@TCL_ZIP_FILE@'

# Flag to indicate whether shared libraries need export files.
TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@

# String that can be evaluated to generate the part of the export file
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed).  May depend on the variables
Changes to win/tclWin32Dll.c.
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
     * Clean up the mount point map.
     */

    Tcl_MutexLock(&mountPointMap);
    dlIter = driveLetterLookup;
    while (dlIter != NULL) {
	dlIter2 = dlIter->nextPtr;
	ckfree(dlIter->volumeName);
	ckfree(dlIter);
	dlIter = dlIter2;
    }
    Tcl_MutexUnlock(&mountPointMap);
}

/*
 *--------------------------------------------------------------------







|
|







251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
     * Clean up the mount point map.
     */

    Tcl_MutexLock(&mountPointMap);
    dlIter = driveLetterLookup;
    while (dlIter != NULL) {
	dlIter2 = dlIter->nextPtr;
	Tcl_Free(dlIter->volumeName);
	Tcl_Free(dlIter);
	dlIter = dlIter2;
    }
    Tcl_MutexUnlock(&mountPointMap);
}

/*
 *--------------------------------------------------------------------
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
		}
	    }

	    /*
	     * Now dlPtr2 points to the structure to free.
	     */

	    ckfree(dlPtr2->volumeName);
	    ckfree(dlPtr2);

	    /*
	     * Restart the loop - we could try to be clever and continue half
	     * way through, but the logic is a bit messy, so it's cleanest
	     * just to restart.
	     */








|
|







345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
		}
	    }

	    /*
	     * Now dlPtr2 points to the structure to free.
	     */

	    Tcl_Free(dlPtr2->volumeName);
	    Tcl_Free(dlPtr2);

	    /*
	     * Restart the loop - we could try to be clever and continue half
	     * way through, but the logic is a bit messy, so it's cleanest
	     * just to restart.
	     */

381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
		    dlIter = dlIter->nextPtr) {
		if (_tcscmp(dlIter->volumeName, Target) == 0) {
		    alreadyStored = 1;
		    break;
		}
	    }
	    if (!alreadyStored) {
		dlPtr2 = ckalloc(sizeof(MountPointMap));
		dlPtr2->volumeName = TclNativeDupInternalRep(Target);
		dlPtr2->driveLetter = (char) drive[0];
		dlPtr2->nextPtr = driveLetterLookup;
		driveLetterLookup = dlPtr2;
	    }
	}
    }







|







381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
		    dlIter = dlIter->nextPtr) {
		if (_tcscmp(dlIter->volumeName, Target) == 0) {
		    alreadyStored = 1;
		    break;
		}
	    }
	    if (!alreadyStored) {
		dlPtr2 = Tcl_Alloc(sizeof(MountPointMap));
		dlPtr2->volumeName = TclNativeDupInternalRep(Target);
		dlPtr2->driveLetter = (char) drive[0];
		dlPtr2->nextPtr = driveLetterLookup;
		driveLetterLookup = dlPtr2;
	    }
	}
    }
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
    }

    /*
     * The volume doesn't appear to correspond to a drive letter - we remember
     * that fact and store '-1' so we don't have to look it up each time.
     */

    dlPtr2 = ckalloc(sizeof(MountPointMap));
    dlPtr2->volumeName = TclNativeDupInternalRep((ClientData) mountPoint);
    dlPtr2->driveLetter = -1;
    dlPtr2->nextPtr = driveLetterLookup;
    driveLetterLookup = dlPtr2;
    Tcl_MutexUnlock(&mountPointMap);
    return -1;
}







|







407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
    }

    /*
     * The volume doesn't appear to correspond to a drive letter - we remember
     * that fact and store '-1' so we don't have to look it up each time.
     */

    dlPtr2 = Tcl_Alloc(sizeof(MountPointMap));
    dlPtr2->volumeName = TclNativeDupInternalRep((ClientData) mountPoint);
    dlPtr2->driveLetter = -1;
    dlPtr2->nextPtr = driveLetterLookup;
    driveLetterLookup = dlPtr2;
    Tcl_MutexUnlock(&mountPointMap);
    return -1;
}
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484


485
486
487
488
489
490
491
492
493
494
495
496

497
498


499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
 *
 *---------------------------------------------------------------------------
 */

TCHAR *
Tcl_WinUtfToTChar(
    const char *string,		/* Source string in UTF-8. */
    int len,			/* Source string length in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    TCHAR *wp;
    int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);

    Tcl_DStringInit(dsPtr);
    Tcl_DStringSetLength(dsPtr, 2*size+2);
    wp = (TCHAR *)Tcl_DStringValue(dsPtr);
    MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1);
    if (len == -1) --size; /* account for 0-byte at string end */
    Tcl_DStringSetLength(dsPtr, 2*size);
    wp[size] = 0;
    return wp;


}

char *
Tcl_WinTCharToUtf(
    const TCHAR *string,	/* Source string in Unicode. */
    int len,			/* Source string length in bytes, or -1 for
				 * platform-specific string length. */
    Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    char *p;
    int size;


    if (len > 0) {


	len /= 2;
    }
    size = WideCharToMultiByte(CP_UTF8, 0, string, len, 0, 0, NULL, NULL);
    Tcl_DStringInit(dsPtr);
    Tcl_DStringSetLength(dsPtr, size+1);
    p = (char *)Tcl_DStringValue(dsPtr);
    WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL);
    if (len == -1) --size; /* account for 0-byte at string end */
    Tcl_DStringSetLength(dsPtr, size);
    p[size] = 0;
    return p;
}

/*
 *------------------------------------------------------------------------
 *
 * TclWinCPUID --
 *







|
|



<
<
<

|
<
<
<
<
<
|
>
>





|
|



|
|
>
|
|
>
>


<
<
<
<
<
<
<
<
|







462
463
464
465
466
467
468
469
470
471
472
473



474
475





476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497








498
499
500
501
502
503
504
505
 *
 *---------------------------------------------------------------------------
 */

TCHAR *
Tcl_WinUtfToTChar(
    const char *string,		/* Source string in UTF-8. */
    size_t len,			/* Source string length in bytes, or -1
				 * for strlen(). */
    Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
				 * converted string is stored. */
{



    Tcl_DStringInit(dsPtr);
    if (!string) {





	return NULL;
    }
    return Tcl_UtfToUniCharDString(string, len, dsPtr);
}

char *
Tcl_WinTCharToUtf(
    const TCHAR *string,	/* Source string in Unicode. */
    size_t len,			/* Source string length in bytes, or -1
				 * for platform-specific string length. */
    Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_DStringInit(dsPtr);
    if (!string) {
	return NULL;
    }
    if (len == TCL_AUTO_LENGTH) {
	len = wcslen(string);
    } else {
	len /= 2;
    }








    return Tcl_UniCharToUtfDString(string, len, dsPtr);
}

/*
 *------------------------------------------------------------------------
 *
 * TclWinCPUID --
 *
Changes to win/tclWinChan.c.
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
     * (caused by persistent states that won't generate WinSock events).
     */

    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) {
	    SET_FLAG(infoPtr->flags, FILE_PENDING);
	    evPtr = ckalloc(sizeof(FileEvent));
	    evPtr->header.proc = FileEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}








|







263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
     * (caused by persistent states that won't generate WinSock events).
     */

    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) {
	    SET_FLAG(infoPtr->flags, FILE_PENDING);
	    evPtr = Tcl_Alloc(sizeof(FileEvent));
	    evPtr->header.proc = FileEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}

430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
	     * pointer on the thread local list.
	     */

	    FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
	    break;
	}
    }
    ckfree(fileInfoPtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * FileSeekProc --







|







430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
	     * pointer on the thread local list.
	     */

	    FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
	    break;
	}
    }
    Tcl_Free(fileInfoPtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * FileSeekProc --
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
	moveMethod = FILE_BEGIN;
    } else if (mode == SEEK_CUR) {
	moveMethod = FILE_CURRENT;
    } else {
	moveMethod = FILE_END;
    }

    newPosHigh = Tcl_WideAsLong(offset >> 32);
    newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset),
	    &newPosHigh, moveMethod);
    if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
	DWORD winError = GetLastError();

	if (winError != NO_ERROR) {
	    TclWinConvertError(winError);
	    *errorCodePtr = errno;
	    return -1;
	}
    }
    return (((Tcl_WideInt)((unsigned)newPos))
	    | (Tcl_LongAsWide(newPosHigh) << 32));
}

/*
 *----------------------------------------------------------------------
 *
 * FileTruncateProc --
 *







|
|











|







550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
	moveMethod = FILE_BEGIN;
    } else if (mode == SEEK_CUR) {
	moveMethod = FILE_CURRENT;
    } else {
	moveMethod = FILE_END;
    }

    newPosHigh = (LONG)(offset >> 32);
    newPos = SetFilePointer(infoPtr->handle, (LONG)offset,
	    &newPosHigh, moveMethod);
    if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
	DWORD winError = GetLastError();

	if (winError != NO_ERROR) {
	    TclWinConvertError(winError);
	    *errorCodePtr = errno;
	    return -1;
	}
    }
    return (((Tcl_WideInt)((unsigned)newPos))
	    | ((Tcl_WideInt)newPosHigh << 32));
}

/*
 *----------------------------------------------------------------------
 *
 * FileTruncateProc --
 *
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
	}
    }

    /*
     * Move to where we want to truncate
     */

    newPosHigh = Tcl_WideAsLong(length >> 32);
    newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length),
	    &newPosHigh, FILE_BEGIN);
    if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
	DWORD winError = GetLastError();

	if (winError != NO_ERROR) {
	    TclWinConvertError(winError);
	    return errno;







|
|







609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
	}
    }

    /*
     * Move to where we want to truncate
     */

    newPosHigh = (LONG)(length >> 32);
    newPos = SetFilePointer(infoPtr->handle, (LONG)length,
	    &newPosHigh, FILE_BEGIN);
    if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
	DWORD winError = GetLastError();

	if (winError != NO_ERROR) {
	    TclWinConvertError(winError);
	    return errno;
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->handle == (HANDLE) handle) {
	    return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL;
	}
    }

    infoPtr = ckalloc(sizeof(FileInfo));

    /*
     * TIP #218. Removed the code inserting the new structure into the global
     * list. This is now handled in the thread action callbacks, and only
     * there.
     */








|







1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->handle == (HANDLE) handle) {
	    return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL;
	}
    }

    infoPtr = Tcl_Alloc(sizeof(FileInfo));

    /*
     * TIP #218. Removed the code inserting the new structure into the global
     * list. This is now handled in the thread action callbacks, and only
     * there.
     */

Changes to win/tclWinConsole.c.
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
	if (infoPtr->watchMask & TCL_READABLE) {
	    if (WaitForRead(infoPtr, 0) >= 0) {
		needEvent = 1;
	    }
	}

	if (needEvent) {
	    ConsoleEvent *evPtr = ckalloc(sizeof(ConsoleEvent));

	    infoPtr->flags |= CONSOLE_PENDING;
	    evPtr->header.proc = ConsoleEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }







|







451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
	if (infoPtr->watchMask & TCL_READABLE) {
	    if (WaitForRead(infoPtr, 0) >= 0) {
		needEvent = 1;
	    }
	}

	if (needEvent) {
	    ConsoleEvent *evPtr = Tcl_Alloc(sizeof(ConsoleEvent));

	    infoPtr->flags |= CONSOLE_PENDING;
	    evPtr->header.proc = ConsoleEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
	    nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
	if (infoPtr == (ConsoleInfo *) consolePtr) {
	    *nextPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }
    if (consolePtr->writeBuf != NULL) {
	ckfree(consolePtr->writeBuf);
	consolePtr->writeBuf = 0;
    }
    ckfree(consolePtr);

    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *







|


|







595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
	    nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
	if (infoPtr == (ConsoleInfo *) consolePtr) {
	    *nextPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }
    if (consolePtr->writeBuf != NULL) {
	Tcl_Free(consolePtr->writeBuf);
	consolePtr->writeBuf = 0;
    }
    Tcl_Free(consolePtr);

    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674

    if (infoPtr->readFlags & CONSOLE_BUFFERED) {
	/*
	 * Data is stored in the buffer.
	 */

	if (bufSize < (infoPtr->bytesRead - infoPtr->offset)) {
	    memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
	    bytesRead = bufSize;
	    infoPtr->offset += bufSize;
	} else {
	    memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
	    bytesRead = infoPtr->bytesRead - infoPtr->offset;

	    /*
	     * Reset the buffer.
	     */

	    infoPtr->readFlags &= ~CONSOLE_BUFFERED;







|



|







656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674

    if (infoPtr->readFlags & CONSOLE_BUFFERED) {
	/*
	 * Data is stored in the buffer.
	 */

	if (bufSize < (infoPtr->bytesRead - infoPtr->offset)) {
	    memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize);
	    bytesRead = bufSize;
	    infoPtr->offset += bufSize;
	} else {
	    memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize);
	    bytesRead = infoPtr->bytesRead - infoPtr->offset;

	    /*
	     * Reset the buffer.
	     */

	    infoPtr->readFlags &= ~CONSOLE_BUFFERED;
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = ckalloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(threadInfo->readyEvent);
	TclPipeThreadSignal(&threadInfo->TI);
	bytesWritten = toWrite;
    } else {
	/*
	 * In the blocking case, just try to write the buffer directly. This







|


|

|







762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		Tcl_Free(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = Tcl_Alloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(threadInfo->readyEvent);
	TclPipeThreadSignal(&threadInfo->TI);
	bytesWritten = toWrite;
    } else {
	/*
	 * In the blocking case, just try to write the buffer directly. This
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313

    ConsoleInit();

    /*
     * See if a channel with this handle already exists.
     */

    infoPtr = ckalloc(sizeof(ConsoleInfo));
    memset(infoPtr, 0, sizeof(ConsoleInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;

    wsprintfA(encoding, "cp%d", GetConsoleCP());







|







1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313

    ConsoleInit();

    /*
     * See if a channel with this handle already exists.
     */

    infoPtr = Tcl_Alloc(sizeof(ConsoleInfo));
    memset(infoPtr, 0, sizeof(ConsoleInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;

    wsprintfA(encoding, "cp%d", GetConsoleCP());
Changes to win/tclWinDde.c.
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
	}
    }

    /*
     * We have found a unique name. Now add it to the registry.
     */

    riPtr = ckalloc(sizeof(RegisteredInterp));
    riPtr->interp = interp;
    riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
    riPtr->nextPtr = tsdPtr->interpListPtr;
    riPtr->handlerPtr = handlerPtr;
    if (riPtr->handlerPtr != NULL) {
	Tcl_IncrRefCount(riPtr->handlerPtr);
    }
    tsdPtr->interpListPtr = riPtr;
    _tcscpy(riPtr->name, actualName);







|

|







387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
	}
    }

    /*
     * We have found a unique name. Now add it to the registry.
     */

    riPtr = Tcl_Alloc(sizeof(RegisteredInterp));
    riPtr->interp = interp;
    riPtr->name = Tcl_Alloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
    riPtr->nextPtr = tsdPtr->interpListPtr;
    riPtr->handlerPtr = handlerPtr;
    if (riPtr->handlerPtr != NULL) {
	Tcl_IncrRefCount(riPtr->handlerPtr);
    }
    tsdPtr->interpListPtr = riPtr;
    _tcscpy(riPtr->name, actualName);
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
    if (searchPtr != NULL) {
	if (prevPtr == NULL) {
	    tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = searchPtr->nextPtr;
	}
    }
    ckfree(riPtr->name);
    if (riPtr->handlerPtr) {
	Tcl_DecrRefCount(riPtr->handlerPtr);
    }
    Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
}

/*







|







490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
    if (searchPtr != NULL) {
	if (prevPtr == NULL) {
	    tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = searchPtr->nextPtr;
	}
    }
    Tcl_Free(riPtr->name);
    if (riPtr->handlerPtr) {
	Tcl_DecrRefCount(riPtr->handlerPtr);
    }
    Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
}

/*
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
	Tcl_DStringSetLength(&dString,  (len + 1) * sizeof(TCHAR) - 1);
	utilString = (TCHAR *) Tcl_DStringValue(&dString);
	DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
		CP_WINUNICODE);
	for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
		riPtr = riPtr->nextPtr) {
	    if (_tcsicmp(riPtr->name, utilString) == 0) {
		convPtr = ckalloc(sizeof(Conversation));
		convPtr->nextPtr = tsdPtr->currentConversations;
		convPtr->returnPackagePtr = NULL;
		convPtr->hConv = hConv;
		convPtr->riPtr = riPtr;
		tsdPtr->currentConversations = convPtr;
		break;
	    }







|







668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
	Tcl_DStringSetLength(&dString,  (len + 1) * sizeof(TCHAR) - 1);
	utilString = (TCHAR *) Tcl_DStringValue(&dString);
	DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
		CP_WINUNICODE);
	for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
		riPtr = riPtr->nextPtr) {
	    if (_tcsicmp(riPtr->name, utilString) == 0) {
		convPtr = Tcl_Alloc(sizeof(Conversation));
		convPtr->nextPtr = tsdPtr->currentConversations;
		convPtr->returnPackagePtr = NULL;
		convPtr->hConv = hConv;
		convPtr->riPtr = riPtr;
		tsdPtr->currentConversations = convPtr;
		break;
	    }
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
		    tsdPtr->currentConversations = convPtr->nextPtr;
		} else {
		    prevConvPtr->nextPtr = convPtr->nextPtr;
		}
		if (convPtr->returnPackagePtr != NULL) {
		    Tcl_DecrRefCount(convPtr->returnPackagePtr);
		}
		ckfree(convPtr);
		break;
	    }
	}
	return (HDDEDATA) TRUE;

    case XTYP_REQUEST:
	/*







|







698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
		    tsdPtr->currentConversations = convPtr->nextPtr;
		} else {
		    prevConvPtr->nextPtr = convPtr->nextPtr;
		}
		if (convPtr->returnPackagePtr != NULL) {
		    Tcl_DecrRefCount(convPtr->returnPackagePtr);
		}
		Tcl_Free(convPtr);
		break;
	    }
	}
	return (HDDEDATA) TRUE;

    case XTYP_REQUEST:
	/*
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
		 * is TCL_ERROR, then the third element is the value of the
		 * variable "errorCode", and the fourth is the value of the
		 * variable "errorInfo".
		 */

		resultPtr = Tcl_NewObj();
		length = DdeGetData(ddeData, NULL, 0, 0);
		ddeDataString = ckalloc(length);
		DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
		length = (length >> 1) - 1;
		resultPtr = Tcl_NewUnicodeObj(ddeDataString, length);
		ckfree(ddeDataString);

		if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
		    goto invalidServerResponse;
		}
		if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);







|



|







1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
		 * is TCL_ERROR, then the third element is the value of the
		 * variable "errorCode", and the fourth is the value of the
		 * variable "errorInfo".
		 */

		resultPtr = Tcl_NewObj();
		length = DdeGetData(ddeData, NULL, 0, 0);
		ddeDataString = Tcl_Alloc(length);
		DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
		length = (length >> 1) - 1;
		resultPtr = Tcl_NewUnicodeObj(ddeDataString, length);
		Tcl_Free(ddeDataString);

		if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
		    goto invalidServerResponse;
		}
		if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
Changes to win/tclWinFCmd.c.
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347

	    /*
	     * Check whether the destination path is actually inside the
	     * source path. This is true if the prefix matches, and the next
	     * character is either end-of-string or a directory separator
	     */

	    if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0)
		    && (dst[Tcl_DStringLength(&srcString)] == '\\'
		    || dst[Tcl_DStringLength(&srcString)] == '/'
		    || dst[Tcl_DStringLength(&srcString)] == '\0')) {
		/*
		 * Trying to move a directory into itself.
		 */








|







333
334
335
336
337
338
339
340
341
342
343
344
345
346
347

	    /*
	     * Check whether the destination path is actually inside the
	     * source path. This is true if the prefix matches, and the next
	     * character is either end-of-string or a directory separator
	     */

	    if ((strncmp(src, dst, Tcl_DStringLength(&srcString))==0)
		    && (dst[Tcl_DStringLength(&srcString)] == '\\'
		    || dst[Tcl_DStringLength(&srcString)] == '/'
		    || dst[Tcl_DStringLength(&srcString)] == '\0')) {
		/*
		 * Trying to move a directory into itself.
		 */

372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
		 * The MoveFile system call already handles the case of moving
		 * a file between filesystems.
		 */

		Tcl_SetErrno(EXDEV);
	    }

	    ckfree(srcArgv);
	    ckfree(dstArgv);
	}

	/*
	 * Other types of access failure is that dst is a read-only
	 * filesystem, that an open file referred to src or dest, or that src
	 * or dest specified the current working directory on the current
	 * filesystem. EACCES is returned for those cases.







|
|







372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
		 * The MoveFile system call already handles the case of moving
		 * a file between filesystems.
		 */

		Tcl_SetErrno(EXDEV);
	    }

	    Tcl_Free(srcArgv);
	    Tcl_Free(dstArgv);
	}

	/*
	 * Other types of access failure is that dst is a read-only
	 * filesystem, that an open file referred to src or dest, or that src
	 * or dest specified the current working directory on the current
	 * filesystem. EACCES is returned for those cases.
1022
1023
1024
1025
1026
1027
1028
1029

1030
1031
1032
1033
1034
1035
1036
    /*
     * The RemoveDirectory API acts differently under Win95/98 and NT WRT NULL
     * and "". Avoid passing these values.
     */

    if (nativePath == NULL || nativePath[0] == '\0') {
	Tcl_SetErrno(ENOENT);
	goto end;

    }

    attr = GetFileAttributes(nativePath);

    if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
	/*
	 * It is a symbolic link - remove it.







|
>







1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
    /*
     * The RemoveDirectory API acts differently under Win95/98 and NT WRT NULL
     * and "". Avoid passing these values.
     */

    if (nativePath == NULL || nativePath[0] == '\0') {
	Tcl_SetErrno(ENOENT);
	Tcl_DStringInit(errorPtr);
	return TCL_ERROR;
    }

    attr = GetFileAttributes(nativePath);

    if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
	/*
	 * It is a symbolic link - remove it.
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
	 * don't want to initialise the errorPtr yet.
	 */
	return TCL_ERROR;
    }

  end:
    if (errorPtr != NULL) {
	char *p;
	Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
	p = Tcl_DStringValue(errorPtr);
	for (; *p; ++p) {
	    if (*p == '\\') *p = '/';
	}
    }
    return TCL_ERROR;

}







<
|
<







1105
1106
1107
1108
1109
1110
1111

1112

1113
1114
1115
1116
1117
1118
1119
	 * don't want to initialise the errorPtr yet.
	 */
	return TCL_ERROR;
    }

  end:
    if (errorPtr != NULL) {

	char *p = Tcl_WinTCharToUtf(nativePath, -1, errorPtr);

	for (; *p; ++p) {
	    if (*p == '\\') *p = '/';
	}
    }
    return TCL_ERROR;

}
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
	    Tcl_IncrRefCount(tempPath);

	    /*
	     * We'd like to call Tcl_FSGetNativePath(tempPath) but that is
	     * likely to lead to infinite loops.
	     */

	    Tcl_DStringInit(&ds);
	    tempString = TclGetString(tempPath);
	    nativeName = Tcl_WinUtfToTChar(tempString, tempPath->length, &ds);
	    Tcl_DecrRefCount(tempPath);
	    handle = FindFirstFile(nativeName, &data);
	    if (handle == INVALID_HANDLE_VALUE) {
		/*
		 * FindFirstFile() doesn't like root directories. We would







<







1645
1646
1647
1648
1649
1650
1651

1652
1653
1654
1655
1656
1657
1658
	    Tcl_IncrRefCount(tempPath);

	    /*
	     * We'd like to call Tcl_FSGetNativePath(tempPath) but that is
	     * likely to lead to infinite loops.
	     */


	    tempString = TclGetString(tempPath);
	    nativeName = Tcl_WinUtfToTChar(tempString, tempPath->length, &ds);
	    Tcl_DecrRefCount(tempPath);
	    handle = FindFirstFile(nativeName, &data);
	    if (handle == INVALID_HANDLE_VALUE) {
		/*
		 * FindFirstFile() doesn't like root directories. We would
Changes to win/tclWinFile.c.
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
	 * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames */
	len = MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, 0, 0);
	if (len==0) {
	    goto done;
	}
    }
    /* Overallocate 6 chars, making some room for extended paths */
    wp = nativePathPtr = ckalloc( (len+6) * sizeof(WCHAR) );
    if (nativePathPtr==0) {
      goto done;
    }
    MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len+1);
    /*
    ** If path starts with "//?/" or "\\?\" (extended path), translate
    ** any slashes to backslashes but leave the '?' intact







|







2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
	 * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames */
	len = MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, 0, 0);
	if (len==0) {
	    goto done;
	}
    }
    /* Overallocate 6 chars, making some room for extended paths */
    wp = nativePathPtr = Tcl_Alloc( (len+6) * sizeof(WCHAR) );
    if (nativePathPtr==0) {
      goto done;
    }
    MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len+1);
    /*
    ** If path starts with "//?/" or "\\?\" (extended path), translate
    ** any slashes to backslashes but leave the '?' intact
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095

    if (clientData == NULL) {
	return NULL;
    }

    len = sizeof(TCHAR) * (_tcslen((const TCHAR *) clientData) + 1);

    copy = ckalloc(len);
    memcpy(copy, clientData, len);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *







|







3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095

    if (clientData == NULL) {
	return NULL;
    }

    len = sizeof(TCHAR) * (_tcslen((const TCHAR *) clientData) + 1);

    copy = Tcl_Alloc(len);
    memcpy(copy, clientData, len);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
     * a process can *always* look up its own token.
     */
    if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) {
        /* Find out how big the buffer needs to be */
        bufsz = 0;
        GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
        if (bufsz) {
            buf = ckalloc(bufsz);
            if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) {
                owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid);
            }
        }
        CloseHandle(token);
    }

    /* Free allocations and be done */
    if (secd)
        LocalFree(secd);            /* Also frees ownerSid */
    if (buf)
        ckfree(buf);

    return (owned != 0);        /* Convert non-0 to 1 */
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|











|











3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
     * a process can *always* look up its own token.
     */
    if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) {
        /* Find out how big the buffer needs to be */
        bufsz = 0;
        GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
        if (bufsz) {
            buf = Tcl_Alloc(bufsz);
            if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) {
                owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid);
            }
        }
        CloseHandle(token);
    }

    /* Free allocations and be done */
    if (secd)
        LocalFree(secd);            /* Also frees ownerSid */
    if (buf)
        Tcl_Free(buf);

    return (owned != 0);        /* Convert non-0 to 1 */
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to win/tclWinInit.c.
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220

    Tcl_ListObjAppendElement(NULL, pathPtr,
	    TclGetProcessGlobalValue(&sourceLibraryDir));

    *encodingPtr = NULL;
    bytes = TclGetString(pathPtr);
    *lengthPtr = pathPtr->length;
    *valuePtr = ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, bytes, *lengthPtr + 1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *







|







206
207
208
209
210
211
212
213
214
215
216
217
218
219
220

    Tcl_ListObjAppendElement(NULL, pathPtr,
	    TclGetProcessGlobalValue(&sourceLibraryDir));

    *encodingPtr = NULL;
    bytes = TclGetString(pathPtr);
    *lengthPtr = pathPtr->length;
    *valuePtr = Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, bytes, *lengthPtr + 1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
	    Tcl_DStringInit(&ds);
	    (void) Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = TclDStringToObj(&ds);
	} else {
	    objPtr = Tcl_NewStringObj(buf, -1);
	}
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	ckfree(pathv);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * InitializeDefaultLibraryDir --







|







297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
	    Tcl_DStringInit(&ds);
	    (void) Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = TclDStringToObj(&ds);
	} else {
	    objPtr = Tcl_NewStringObj(buf, -1);
	}
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	Tcl_Free(pathv);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * InitializeDefaultLibraryDir --
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "lib/tcl%s", TCL_VERSION);
    *lengthPtr = strlen(name);
    *valuePtr = ckalloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *







|







343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "lib/tcl%s", TCL_VERSION);
    *lengthPtr = strlen(name);
    *valuePtr = Tcl_Alloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "../library");
    *lengthPtr = strlen(name);
    *valuePtr = ckalloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *







|







391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "../library");
    *lengthPtr = strlen(name);
    *valuePtr = Tcl_Alloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensitive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"name", or -1 if there is no such entry. The integer at *lengthPtr is
 *	filled in with the length of name (if a matching entry is found) or
 *	the length of the environ array (if no matching entry is found).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (UTF-8). */
    int *lengthPtr)		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    int i, length, result = -1;
    register const char *env, *p1, *p2;
    char *envUpper, *nameUpper;
    Tcl_DString envString;

    /*
     * Convert the name to all upper case for the case insensitive comparison.
     */

    length = strlen(name);
    nameUpper = ckalloc(length + 1);
    memcpy(nameUpper, name, (size_t) length+1);
    Tcl_UtfToUpper(nameUpper);

    Tcl_DStringInit(&envString);
    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
	/*
	 * Chop the env string off after the equal sign, then Convert the name
	 * to all upper case, so we do not have to convert all the characters
	 * after the equal sign.
	 */

	envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
	p1 = strchr(envUpper, '=');
	if (p1 == NULL) {
	    continue;
	}
	length = (int) (p1 - envUpper);
	Tcl_DStringSetLength(&envString, length+1);
	Tcl_UtfToUpper(envUpper);

	p1 = envUpper;
	p2 = nameUpper;
	for (; *p2 == *p1; p1++, p2++) {
	    /* NULL loop body. */







|









|



|




|









|
|















|







588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensitive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"name", or (size_t)-1 if there is no such entry. The integer at *lengthPtr is
 *	filled in with the length of name (if a matching entry is found) or
 *	the length of the environ array (if no matching entry is found).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (UTF-8). */
    size_t *lengthPtr)		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    size_t i, length, result = (size_t)-1;
    register const char *env, *p1, *p2;
    char *envUpper, *nameUpper;
    Tcl_DString envString;

    /*
     * Convert the name to all upper case for the case insensitive comparison.
     */

    length = strlen(name);
    nameUpper = Tcl_Alloc(length + 1);
    memcpy(nameUpper, name, length+1);
    Tcl_UtfToUpper(nameUpper);

    Tcl_DStringInit(&envString);
    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
	/*
	 * Chop the env string off after the equal sign, then Convert the name
	 * to all upper case, so we do not have to convert all the characters
	 * after the equal sign.
	 */

	envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
	p1 = strchr(envUpper, '=');
	if (p1 == NULL) {
	    continue;
	}
	length = p1 - envUpper;
	Tcl_DStringSetLength(&envString, length+1);
	Tcl_UtfToUpper(envUpper);

	p1 = envUpper;
	p2 = nameUpper;
	for (; *p2 == *p1; p1++, p2++) {
	    /* NULL loop body. */
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
	Tcl_DStringFree(&envString);
    }

    *lengthPtr = i;

  done:
    Tcl_DStringFree(&envString);
    ckfree(nameUpper);
    return result;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|










656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
	Tcl_DStringFree(&envString);
    }

    *lengthPtr = i;

  done:
    Tcl_DStringFree(&envString);
    Tcl_Free(nameUpper);
    return result;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to win/tclWinInt.h.
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105

typedef struct TclPipeThreadInfo {
    HANDLE evControl;		/* Auto-reset event used by the main thread to
				 * signal when the pipe thread should attempt
				 * to do read/write operation. Additionally
				 * used as signal to stop (state set to -1) */
    volatile LONG state;	/* Indicates current state of the thread */
    ClientData clientData;	/* Referenced data of the main thread */
    HANDLE evWakeUp;		/* Optional wake-up event worker set by shutdown */
} TclPipeThreadInfo;


/* If pipe-workers will use some tcl subsystem, we can use ckalloc without
 * more overhead for finalize thread (should be executed anyway)
 *
 * #define _PTI_USE_CKALLOC 1
 */

/*
 * State of the pipe-worker.







|




|







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105

typedef struct TclPipeThreadInfo {
    HANDLE evControl;		/* Auto-reset event used by the main thread to
				 * signal when the pipe thread should attempt
				 * to do read/write operation. Additionally
				 * used as signal to stop (state set to -1) */
    volatile LONG state;	/* Indicates current state of the thread */
    void *clientData;	/* Referenced data of the main thread */
    HANDLE evWakeUp;		/* Optional wake-up event worker set by shutdown */
} TclPipeThreadInfo;


/* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without
 * more overhead for finalize thread (should be executed anyway)
 *
 * #define _PTI_USE_CKALLOC 1
 */

/*
 * State of the pipe-worker.
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
#define PTI_STATE_STOP	2	/* thread should stop work (owns TI structure) */
#define PTI_STATE_END	4	/* thread should stop work (worker is busy) */
#define PTI_STATE_DOWN  8	/* worker is down */


MODULE_SCOPE
TclPipeThreadInfo *	TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr,
			    ClientData clientData, HANDLE wakeEvent);
MODULE_SCOPE int	TclPipeThreadWaitForSignal(TclPipeThreadInfo **pipeTIPtr);

static inline void
TclPipeThreadSignal(
    TclPipeThreadInfo **pipeTIPtr)
{
    TclPipeThreadInfo *pipeTI = *pipeTIPtr;







|







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
#define PTI_STATE_STOP	2	/* thread should stop work (owns TI structure) */
#define PTI_STATE_END	4	/* thread should stop work (worker is busy) */
#define PTI_STATE_DOWN  8	/* worker is down */


MODULE_SCOPE
TclPipeThreadInfo *	TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr,
			    void *clientData, HANDLE wakeEvent);
MODULE_SCOPE int	TclPipeThreadWaitForSignal(TclPipeThreadInfo **pipeTIPtr);

static inline void
TclPipeThreadSignal(
    TclPipeThreadInfo **pipeTIPtr)
{
    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
Changes to win/tclWinLoad.c.
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
	return TCL_ERROR;
    }

    /*
     * Succeded; package everything up for Tcl.
     */

    handlePtr = ckalloc(sizeof(struct Tcl_LoadHandle_));
    handlePtr->clientData = (ClientData) hInstance;
    handlePtr->findSymbolProcPtr = &FindSymbol;
    handlePtr->unloadFileProcPtr = &UnloadFile;
    *loadHandle = handlePtr;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}







|







166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
	return TCL_ERROR;
    }

    /*
     * Succeded; package everything up for Tcl.
     */

    handlePtr = Tcl_Alloc(sizeof(struct Tcl_LoadHandle_));
    handlePtr->clientData = (ClientData) hInstance;
    handlePtr->findSymbolProcPtr = &FindSymbol;
    handlePtr->unloadFileProcPtr = &UnloadFile;
    *loadHandle = handlePtr;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;

    FreeLibrary(hInstance);
    ckfree(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *







|







251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;

    FreeLibrary(hInstance);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
    return TCL_ERROR;

    /*
     * Store our computed value in the global.
     */

  copyToGlobalBuffer:
    dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR));
    wcscpy(dllDirectoryName, name);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|











412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
    return TCL_ERROR;

    /*
     * Store our computed value in the global.
     */

  copyToGlobalBuffer:
    dllDirectoryName = Tcl_Alloc((nameLen+1) * sizeof(WCHAR));
    wcscpy(dllDirectoryName, name);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to win/tclWinNotify.c.
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
    DWORD thread;		/* Identifier for thread associated with this
				 * notifier. */
    HANDLE event;		/* Event object used to wake up the notifier
				 * thread. */
    int pending;		/* Alert message pending, this field is locked
				 * by the notifierMutex. */
    HWND hwnd;			/* Messaging window. */
    int timeout;		/* Current timeout value. */
    int timerActive;		/* 1 if interval timer is running. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The following static indicates the number of threads that have initialized







<







32
33
34
35
36
37
38

39
40
41
42
43
44
45
    DWORD thread;		/* Identifier for thread associated with this
				 * notifier. */
    HANDLE event;		/* Event object used to wake up the notifier
				 * thread. */
    int pending;		/* Alert message pending, this field is locked
				 * by the notifierMutex. */
    HWND hwnd;			/* Messaging window. */

    int timerActive;		/* 1 if interval timer is running. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The following static indicates the number of threads that have initialized
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
	     */

	    timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
	    if (timeout == 0) {
		timeout = 1;
	    }
	}
	tsdPtr->timeout = timeout;
	if (timeout != 0) {
	    tsdPtr->timerActive = 1;
	    SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
		    (unsigned long) tsdPtr->timeout, NULL);
	} else {
	    tsdPtr->timerActive = 0;
	    KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
	}
    }
}








<



|







304
305
306
307
308
309
310

311
312
313
314
315
316
317
318
319
320
321
	     */

	    timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
	    if (timeout == 0) {
		timeout = 1;
	    }
	}

	if (timeout != 0) {
	    tsdPtr->timerActive = 1;
	    SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
		    timeout, NULL);
	} else {
	    tsdPtr->timerActive = 0;
	    KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
	}
    }
}

Changes to win/tclWinPipe.c.
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

/*
 * This list is used to map from pids to process handles.
 */

typedef struct ProcInfo {
    HANDLE hProcess;
    DWORD dwProcessId;
    struct ProcInfo *nextPtr;
} ProcInfo;

static ProcInfo *procList;

/*
 * Bit masks used in the flags field of the PipeInfo structure below.







|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

/*
 * This list is used to map from pids to process handles.
 */

typedef struct ProcInfo {
    HANDLE hProcess;
    size_t dwProcessId;
    struct ProcInfo *nextPtr;
} ProcInfo;

static ProcInfo *procList;

/*
 * Bit masks used in the flags field of the PipeInfo structure below.
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
	if ((infoPtr->watchMask & TCL_READABLE) &&
		(WaitForRead(infoPtr, 0) >= 0)) {
	    needEvent = 1;
	}

	if (needEvent) {
	    infoPtr->flags |= PIPE_PENDING;
	    evPtr = ckalloc(sizeof(PipeEvent));
	    evPtr->header.proc = PipeEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}








|







399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
	if ((infoPtr->watchMask & TCL_READABLE) &&
		(WaitForRead(infoPtr, 0) >= 0)) {
	    needEvent = 1;
	}

	if (needEvent) {
	    infoPtr->flags |= PIPE_PENDING;
	    evPtr = Tcl_Alloc(sizeof(PipeEvent));
	    evPtr->header.proc = PipeEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}

430
431
432
433
434
435
436
437
438
439
440
441
442
443
444

TclFile
TclWinMakeFile(
    HANDLE handle)		/* Type-specific data. */
{
    WinFile *filePtr;

    filePtr = ckalloc(sizeof(WinFile));
    filePtr->type = WIN_FILE;
    filePtr->handle = handle;

    return (TclFile)filePtr;
}

/*







|







430
431
432
433
434
435
436
437
438
439
440
441
442
443
444

TclFile
TclWinMakeFile(
    HANDLE handle)		/* Type-specific data. */
{
    WinFile *filePtr;

    filePtr = Tcl_Alloc(sizeof(WinFile));
    filePtr->type = WIN_FILE;
    filePtr->handle = handle;

    return (TclFile)filePtr;
}

/*
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
	if (!TclInThreadExit()
		|| ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
		    && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
		    && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
	    if (filePtr->handle != NULL &&
		    CloseHandle(filePtr->handle) == FALSE) {
		TclWinConvertError(GetLastError());
		ckfree(filePtr);
		return -1;
	    }
	}
	break;

    default:
	Tcl_Panic("TclpCloseFile: unexpected file type");
    }

    ckfree(filePtr);
    return 0;
}

/*
 *--------------------------------------------------------------------------
 *
 * TclpGetPid --
 *
 *	Given a HANDLE to a child process, return the process id for that
 *	child process.
 *
 * Results:
 *	Returns the process id for the child process. If the pid was not known
 *	by Tcl, either because the pid was not created by Tcl or the child
 *	process has already been reaped, -1 is returned.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------------------
 */

int
TclpGetPid(
    Tcl_Pid pid)		/* The HANDLE of the child process. */
{
    ProcInfo *infoPtr;

    PipeInit();

    Tcl_MutexLock(&pipeMutex);
    for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
	if (infoPtr->dwProcessId == (DWORD) pid) {
	    Tcl_MutexUnlock(&pipeMutex);
	    return infoPtr->dwProcessId;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);
    return (unsigned long) -1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCreateProcess --
 *







|









|














|







|









|





|







822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
	if (!TclInThreadExit()
		|| ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
		    && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
		    && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
	    if (filePtr->handle != NULL &&
		    CloseHandle(filePtr->handle) == FALSE) {
		TclWinConvertError(GetLastError());
		Tcl_Free(filePtr);
		return -1;
	    }
	}
	break;

    default:
	Tcl_Panic("TclpCloseFile: unexpected file type");
    }

    Tcl_Free(filePtr);
    return 0;
}

/*
 *--------------------------------------------------------------------------
 *
 * TclpGetPid --
 *
 *	Given a HANDLE to a child process, return the process id for that
 *	child process.
 *
 * Results:
 *	Returns the process id for the child process. If the pid was not known
 *	by Tcl, either because the pid was not created by Tcl or the child
 *	process has already been reaped, (size_t)-1 is returned.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------------------
 */

size_t
TclpGetPid(
    Tcl_Pid pid)		/* The HANDLE of the child process. */
{
    ProcInfo *infoPtr;

    PipeInit();

    Tcl_MutexLock(&pipeMutex);
    for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
	if (infoPtr->dwProcessId == (size_t) pid) {
	    Tcl_MutexUnlock(&pipeMutex);
	    return infoPtr->dwProcessId;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);
    return (size_t)-1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCreateProcess --
 *
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
     * CreateProcess() and CloseHandle(), the problem does not occur." PSS ID
     * Number: Q124121
     */

    WaitForInputIdle(procInfo.hProcess, 5000);
    CloseHandle(procInfo.hThread);

    *pidPtr = (Tcl_Pid) procInfo.dwProcessId;
    if (*pidPtr != 0) {
	TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);
    }
    result = TCL_OK;

  end:
    Tcl_DStringFree(&cmdLine);







|







1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
     * CreateProcess() and CloseHandle(), the problem does not occur." PSS ID
     * Number: Q124121
     */

    WaitForInputIdle(procInfo.hProcess, 5000);
    CloseHandle(procInfo.hThread);

    *pidPtr = (Tcl_Pid) (size_t) procInfo.dwProcessId;
    if (*pidPtr != 0) {
	TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);
    }
    result = TCL_OK;

  end:
    Tcl_DStringFree(&cmdLine);
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
    Tcl_DString nameBuf, ds;
    const TCHAR *nativeName;
    TCHAR nativeFullPath[MAX_PATH];
    static const char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"};

    /*
     * Look for the program as an external program. First try the name as it
     * is, then try adding .com, .exe, and .bat, in that order, to the name,
     * looking for an executable.
     *
     * Using the raw SearchPath() function doesn't do quite what is necessary.
     * If the name of the executable already contains a '.' character, it will
     * not try appending the specified extension when searching (in other
     * words, SearchPath will not find the program "a.b.exe" if the arguments
     * specified "a.b" and ".exe"). So, first look for the file as it is







|







1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
    Tcl_DString nameBuf, ds;
    const TCHAR *nativeName;
    TCHAR nativeFullPath[MAX_PATH];
    static const char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"};

    /*
     * Look for the program as an external program. First try the name as it
     * is, then try adding .com, .exe, .bat and .cmd, in that order, to the name,
     * looking for an executable.
     *
     * Using the raw SearchPath() function doesn't do quite what is necessary.
     * If the name of the executable already contains a '.' character, it will
     * not try appending the specified extension when searching (in other
     * words, SearchPath will not find the program "a.b.exe" if the arguments
     * specified "a.b" and ".exe"). So, first look for the file as it is
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
    if (applType == APPL_NONE) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
		originalName, Tcl_PosixError(interp)));
	return APPL_NONE;
    }

    if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) {
	/*
	 * Replace long path name of executable with short path name for
	 * 16-bit applications. Otherwise the application may not be able to
	 * correctly parse its own command line to separate off the
	 * application name from the arguments.
	 */








|







1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
    if (applType == APPL_NONE) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
		originalName, Tcl_PosixError(interp)));
	return APPL_NONE;
    }

    if (applType == APPL_WIN3X) {
	/*
	 * Replace long path name of executable with short path name for
	 * 16-bit applications. Otherwise the application may not be able to
	 * correctly parse its own command line to separate off the
	 * application name from the arguments.
	 */

1420
1421
1422
1423
1424
1425
1426
1427















1428

































































1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439












1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460

1461
1462
1463
1464
1465
1466


1467

1468

1469


















1470
1471
1472

1473
1474


1475

1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492


1493
1494
1495

1496
1497
1498
1499

1500
1501
1502

1503


1504


1505
1506

1507








1508



1509
1510


1511
1512

1513


1514

1515
1516
1517
1518
1519
1520
1521
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
















static void

































































BuildCommandLine(
    const char *executable,	/* Full path of executable (including
				 * extension). Replacement for argv[0]. */
    int argc,			/* Number of arguments. */
    const char **argv,		/* Argument strings in UTF. */
    Tcl_DString *linePtr)	/* Initialized Tcl_DString that receives the
				 * command line (TCHAR). */
{
    const char *arg, *start, *special;
    int quote, i;
    Tcl_DString ds;













    Tcl_DStringInit(&ds);

    /*
     * Prime the path. Add a space separator if we were primed with something.
     */

    TclDStringAppendDString(&ds, linePtr);
    if (Tcl_DStringLength(linePtr) > 0) {
	TclDStringAppendLiteral(&ds, " ");
    }

    for (i = 0; i < argc; i++) {
	if (i == 0) {
	    arg = executable;
	} else {
	    arg = argv[i];
	    TclDStringAppendLiteral(&ds, " ");
	}

	quote = 0;

	if (arg[0] == '\0') {
	    quote = 1;
	} else {
	    int count;
	    Tcl_UniChar ch = 0;



	    for (start = arg; *start != '\0'; start += count) {

		count = TclUtfToUniChar(start, &ch);

		if (Tcl_UniCharIsSpace(ch)) {	/* INTL: ISO space. */


















		    quote = 1;
		    break;
		}

	    }
	}


	if (quote) {

	    TclDStringAppendLiteral(&ds, "\"");
	}
	start = arg;
	for (special = arg; ; ) {
	    if ((*special == '\\') && (special[1] == '\\' ||
		    special[1] == '"' || (quote && special[1] == '\0'))) {
		Tcl_DStringAppend(&ds, start, (int) (special - start));
		start = special;
		while (1) {
		    special++;
		    if (*special == '"' || (quote && *special == '\0')) {
			/*
			 * N backslashes followed a quote -> insert N * 2 + 1
			 * backslashes then a quote.
			 */

			Tcl_DStringAppend(&ds, start,


				(int) (special - start));
			break;
		    }

		    if (*special != '\\') {
			break;
		    }
		}

		Tcl_DStringAppend(&ds, start, (int) (special - start));
		start = special;
	    }

	    if (*special == '"') {


		Tcl_DStringAppend(&ds, start, (int) (special - start));


		TclDStringAppendLiteral(&ds, "\\\"");
		start = special + 1;

	    }








	    if (*special == '\0') {



		break;
	    }


	    special++;
	}

	Tcl_DStringAppend(&ds, start, (int) (special - start));


	if (quote) {

	    TclDStringAppendLiteral(&ds, "\"");
	}
    }
    Tcl_DStringFree(linePtr);
    Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
    Tcl_DStringFree(&ds);
}








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








|
|

>
>
>
>
>
>
>
>
>
>
>
>




















|
>

|


|
|
>
>
|
>
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
>
|
|
>
>
|
>


<
<
<
<
<
<
<
<
<
<
<
|
<
|
|
>
>
|
<
<
>
|
<
<
<
>
|
|
|
>
|
>
>
|
>
>
|
|
>
|
>
>
>
>
>
>
>
>
|
>
>
>
|
|
>
>
|
|
>
|
>
>
|
>







1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596











1597

1598
1599
1600
1601
1602


1603
1604



1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static const char *
BuildCmdLineBypassBS(
    const char *current,
    const char **bspos
) {
    /* mark first backslash possition */
    if (!*bspos) {
	*bspos = current;
    }
    do {
	current++;
    } while (*current == '\\');
    return current;
}

static void
QuoteCmdLineBackslash(
    Tcl_DString *dsPtr,
    const char *start,
    const char *current,
    const char *bspos
) {
    if (!bspos) {
	if (current > start) { /* part before current (special) */
	    Tcl_DStringAppend(dsPtr, start, (int) (current - start));
	}
    } else {
    	if (bspos > start) { /* part before first backslash */
	    Tcl_DStringAppend(dsPtr, start, (int) (bspos - start));
	}
	while (bspos++ < current) { /* each backslash twice */
	    TclDStringAppendLiteral(dsPtr, "\\\\");
	}
    }
}

static const char *
QuoteCmdLinePart(
    Tcl_DString *dsPtr,
    const char *start,
    const char *special,
    const char *specMetaChars,
    const char **bspos
) {
    if (!*bspos) {
	/* rest before special (before quote) */
	QuoteCmdLineBackslash(dsPtr, start, special, NULL);
	start = special;
    } else {
	/* rest before first backslash and backslashes into new quoted block */
	QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
	start = *bspos;
    }
    /*
     * escape all special chars enclosed in quotes like `"..."`, note that here we
     * don't must escape `\` (with `\`), because it's outside of the main quotes,
     * so `\` remains `\`, but important - not at end of part, because results as
     * before the quote,  so `%\%\` should be escaped as `"%\%"\\`).
     */
    TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */
    do {
    	*bspos = NULL;
	special++;
	if (*special == '\\') {
	    /* bypass backslashes (and mark first backslash possition)*/
	    special = BuildCmdLineBypassBS(special, bspos);
	    if (*special == '\0') break;
	}
    } while (*special && strchr(specMetaChars, *special));
    if (!*bspos) {
	/* unescaped rest before quote */
	QuoteCmdLineBackslash(dsPtr, start, special, NULL);
    } else {
	/* unescaped rest before first backslash (rather belongs to the main block) */
	QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
    }
    TclDStringAppendLiteral(dsPtr, "\""); /* closing escape quote-char */
    return special;
}

static void
BuildCommandLine(
    const char *executable,	/* Full path of executable (including
				 * extension). Replacement for argv[0]. */
    int argc,			/* Number of arguments. */
    const char **argv,		/* Argument strings in UTF. */
    Tcl_DString *linePtr)	/* Initialized Tcl_DString that receives the
				 * command line (TCHAR). */
{
    const char *arg, *start, *special, *bspos;
    int quote = 0, i;
    Tcl_DString ds;

    /* characters to enclose in quotes if unpaired quote flag set */
    const static char *specMetaChars = "&|^<>!()%";
    /* characters to enclose in quotes in any case (regardless unpaired-flag) */
    const static char *specMetaChars2 = "%";

    /* Quote flags:
     *   CL_ESCAPE   - escape argument;
     *   CL_QUOTE    - enclose in quotes;
     *   CL_UNPAIRED - previous arguments chain contains unpaired quote-char;
     */
    enum {CL_ESCAPE = 1, CL_QUOTE = 2, CL_UNPAIRED = 4};

    Tcl_DStringInit(&ds);

    /*
     * Prime the path. Add a space separator if we were primed with something.
     */

    TclDStringAppendDString(&ds, linePtr);
    if (Tcl_DStringLength(linePtr) > 0) {
	TclDStringAppendLiteral(&ds, " ");
    }

    for (i = 0; i < argc; i++) {
	if (i == 0) {
	    arg = executable;
	} else {
	    arg = argv[i];
	    TclDStringAppendLiteral(&ds, " ");
	}

	quote &= ~(CL_ESCAPE|CL_QUOTE); /* reset escape flags */
	bspos = NULL;
	if (arg[0] == '\0') {
	    quote = CL_QUOTE;
	} else {
	    int count;
	    Tcl_UniChar ch;
	    for (start = arg;
		*start != '\0' &&
		    (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE);
		start += count
	    ) {
		count = Tcl_UtfToUniChar(start, &ch);
		if (count > 1) continue;
		if (Tcl_UniCharIsSpace(ch)) {
		    quote |= CL_QUOTE; /* quote only */
		    if (bspos) { /* if backslash found - escape & quote */
			quote |= CL_ESCAPE;
			break;
		    }
		    continue;
		}
		if (strchr(specMetaChars, *start)) {
		    quote |= (CL_ESCAPE|CL_QUOTE); /*escape & quote */
		    break;
		}
		if (*start == '"') {
		    quote |= CL_ESCAPE; /* escape only */
		    continue;
		}
		if (*start == '\\') {
		    bspos = start;
		    if (quote & CL_QUOTE) { /* if quote - escape & quote */
			quote |= CL_ESCAPE;
			break;
		    }
		    continue;
		}
	    }
	    bspos = NULL;
	}
	if (quote & CL_QUOTE) {
	    /* start of argument (main opening quote-char) */
	    TclDStringAppendLiteral(&ds, "\"");
	}











	if (!(quote & CL_ESCAPE)) {

	    /* nothing to escape */
	    Tcl_DStringAppend(&ds, arg, -1);
	} else {
	    start = arg;
	    for (special = arg; *special != '\0'; ) {


		/* position of `\` is important before quote or at end (equal `\"` because quoted) */
		if (*special == '\\') {



		    /* bypass backslashes (and mark first backslash possition)*/
		    special = BuildCmdLineBypassBS(special, &bspos);
		    if (*special == '\0') break;
		}
		/* ["] */
		if (*special == '"') {
		    quote ^= CL_UNPAIRED; /* invert unpaired flag - observe unpaired quotes */
		    /* add part before (and escape backslashes before quote) */
		    QuoteCmdLineBackslash(&ds, start, special, bspos);
		    bspos = NULL;
		    /* escape using backslash */
		    TclDStringAppendLiteral(&ds, "\\\"");
		    start = ++special;
		    continue;
		}
		/* unpaired (escaped) quote causes special handling on meta-chars */
		if ((quote & CL_UNPAIRED) && strchr(specMetaChars, *special)) {
		    special = QuoteCmdLinePart(&ds, start, special, specMetaChars, &bspos);
		    /* start to current or first backslash */
		    start = !bspos ? special : bspos;
		    continue;
		}
		/* special case for % - should be enclosed always (paired also) */
		if (strchr(specMetaChars2, *special)) {
		    special = QuoteCmdLinePart(&ds, start, special, specMetaChars2, &bspos);
		    /* start to current or first backslash */
		    start = !bspos ? special : bspos;
		    continue;
		}
		/* other not special (and not meta) character */
		bspos = NULL; /* reset last backslash possition (not interesting) */
		special++;
	    }
	    /* rest of argument (and escape backslashes before closing main quote) */
	    QuoteCmdLineBackslash(&ds, start, special,
	    	(quote & CL_QUOTE) ? bspos : NULL);
	}
	if (quote & CL_QUOTE) {
	    /* end of argument (main closing quote-char) */
	    TclDStringAppendLiteral(&ds, "\"");
	}
    }
    Tcl_DStringFree(linePtr);
    Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
    Tcl_DStringFree(&ds);
}
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
    TclFile writeFile,		/* If non-null, gives the file for writing. */
    TclFile errorFile,		/* If non-null, gives the file where errors
				 * can be read. */
    int numPids,		/* The number of pids in the pid array. */
    Tcl_Pid *pidPtr)		/* An array of process identifiers. */
{
    char channelName[16 + TCL_INTEGER_SPACE];
    PipeInfo *infoPtr = ckalloc(sizeof(PipeInfo));

    PipeInit();

    infoPtr->watchMask = 0;
    infoPtr->flags = 0;
    infoPtr->readFlags = 0;
    infoPtr->readFile = readFile;







|







1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
    TclFile writeFile,		/* If non-null, gives the file for writing. */
    TclFile errorFile,		/* If non-null, gives the file where errors
				 * can be read. */
    int numPids,		/* The number of pids in the pid array. */
    Tcl_Pid *pidPtr)		/* An array of process identifiers. */
{
    char channelName[16 + TCL_INTEGER_SPACE];
    PipeInfo *infoPtr = Tcl_Alloc(sizeof(PipeInfo));

    PipeInit();

    infoPtr->watchMask = 0;
    infoPtr->flags = 0;
    infoPtr->readFlags = 0;
    infoPtr->readFile = readFile;
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
	Tcl_ListObjAppendElement(NULL, pidsObj,
		Tcl_NewWideIntObj((unsigned)
			TclpGetPid(pipePtr->pidPtr[i])));
	Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
	ckfree(pipePtr->pidPtr);
	pipePtr->numPids = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
	Tcl_ListObjAppendElement(NULL, pidsObj,
		Tcl_NewWideIntObj((unsigned)
			TclpGetPid(pipePtr->pidPtr[i])));
	Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
	Tcl_Free(pipePtr->pidPtr);
	pipePtr->numPids = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
	 */

	if (pipePtr->errorFile) {
	    WinFile *filePtr = (WinFile *) pipePtr->errorFile;

	    errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
		    TCL_READABLE);
	    ckfree(filePtr);
	} else {
	    errChan = NULL;
	}

	result = TclCleanupChildren(interp, pipePtr->numPids,
		pipePtr->pidPtr, errChan);
    }

    if (pipePtr->numPids > 0) {
	ckfree(pipePtr->pidPtr);
    }

    if (pipePtr->writeBuf != NULL) {
	ckfree(pipePtr->writeBuf);
    }

    ckfree(pipePtr);

    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}








|









|



|


|







2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
	 */

	if (pipePtr->errorFile) {
	    WinFile *filePtr = (WinFile *) pipePtr->errorFile;

	    errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
		    TCL_READABLE);
	    Tcl_Free(filePtr);
	} else {
	    errChan = NULL;
	}

	result = TclCleanupChildren(interp, pipePtr->numPids,
		pipePtr->pidPtr, errChan);
    }

    if (pipePtr->numPids > 0) {
	Tcl_Free(pipePtr->pidPtr);
    }

    if (pipePtr->writeBuf != NULL) {
	Tcl_Free(pipePtr->writeBuf);
    }

    Tcl_Free(pipePtr);

    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}

2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = ckalloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->writable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	bytesWritten = toWrite;
    } else {







|


|







2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		Tcl_Free(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = Tcl_Alloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->writable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	bytesWritten = toWrite;
    } else {
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
     * Find the process and cut it from the process list.
     */

    Tcl_MutexLock(&pipeMutex);
    prevPtrPtr = &procList;
    for (infoPtr = procList; infoPtr != NULL;
	    prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
	 if (infoPtr->dwProcessId == (DWORD) pid) {
	    *prevPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);

    /*







|







2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
     * Find the process and cut it from the process list.
     */

    Tcl_MutexLock(&pipeMutex);
    prevPtrPtr = &procList;
    for (infoPtr = procList; infoPtr != NULL;
	    prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
	 if (infoPtr->dwProcessId == (size_t) pid) {
	    *prevPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);

    /*
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
    }

    /*
     * Officially close the process handle.
     */

    CloseHandle(infoPtr->hProcess);
    ckfree(infoPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *







|







2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
    }

    /*
     * Officially close the process handle.
     */

    CloseHandle(infoPtr->hProcess);
    Tcl_Free(infoPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
 *
 *----------------------------------------------------------------------
 */

void
TclWinAddProcess(
    void *hProcess,		/* Handle to process */
    unsigned long id)		/* Global process identifier */
{
    ProcInfo *procPtr = ckalloc(sizeof(ProcInfo));

    PipeInit();

    procPtr->hProcess = hProcess;
    procPtr->dwProcessId = id;
    Tcl_MutexLock(&pipeMutex);
    procPtr->nextPtr = procList;







|

|







2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
 *
 *----------------------------------------------------------------------
 */

void
TclWinAddProcess(
    void *hProcess,		/* Handle to process */
    size_t id)		/* Global process identifier */
{
    ProcInfo *procPtr = Tcl_Alloc(sizeof(ProcInfo));

    PipeInit();

    procPtr->hProcess = hProcess;
    procPtr->dwProcessId = id;
    Tcl_MutexLock(&pipeMutex);
    procPtr->nextPtr = procList;
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
    ClientData clientData,
    HANDLE wakeEvent)
{
    TclPipeThreadInfo *pipeTI;
#ifndef _PTI_USE_CKALLOC
    pipeTI = malloc(sizeof(TclPipeThreadInfo));
#else
    pipeTI = ckalloc(sizeof(TclPipeThreadInfo));
#endif
    pipeTI->evControl = CreateEvent(NULL, FALSE, FALSE, NULL);
    pipeTI->state = PTI_STATE_IDLE;
    pipeTI->clientData = clientData;
    pipeTI->evWakeUp = wakeEvent;
    return (*pipeTIPtr = pipeTI);
}







|







3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
    ClientData clientData,
    HANDLE wakeEvent)
{
    TclPipeThreadInfo *pipeTI;
#ifndef _PTI_USE_CKALLOC
    pipeTI = malloc(sizeof(TclPipeThreadInfo));
#else
    pipeTI = Tcl_Alloc(sizeof(TclPipeThreadInfo));
#endif
    pipeTI->evControl = CreateEvent(NULL, FALSE, FALSE, NULL);
    pipeTI->state = PTI_STATE_IDLE;
    pipeTI->clientData = clientData;
    pipeTI->evWakeUp = wakeEvent;
    return (*pipeTIPtr = pipeTI);
}
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
	if (pipeTI->evWakeUp) {
	    SetEvent(pipeTI->evWakeUp);
	}
	CloseHandle(pipeTI->evControl);
#   ifndef _PTI_USE_CKALLOC
	free(pipeTI);
#   else
	ckfree(pipeTI);
#   endif
    }
}

/*
 *----------------------------------------------------------------------
 *







|







3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
	if (pipeTI->evWakeUp) {
	    SetEvent(pipeTI->evWakeUp);
	}
	CloseHandle(pipeTI->evControl);
#   ifndef _PTI_USE_CKALLOC
	free(pipeTI);
#   else
	Tcl_Free(pipeTI);
#   endif
    }
}

/*
 *----------------------------------------------------------------------
 *
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
	CloseHandle(pipeTI->evControl);
	if (pipeTI->evWakeUp) {
	    SetEvent(pipeTI->evWakeUp);
	}
#   ifndef _PTI_USE_CKALLOC
	free(pipeTI);
#   else
	ckfree(pipeTI);
	/* be sure all subsystems used are finalized */
	Tcl_FinalizeThread();
#   endif
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|













3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
	CloseHandle(pipeTI->evControl);
	if (pipeTI->evWakeUp) {
	    SetEvent(pipeTI->evWakeUp);
	}
#   ifndef _PTI_USE_CKALLOC
	free(pipeTI);
#   else
	Tcl_Free(pipeTI);
	/* be sure all subsystems used are finalized */
	Tcl_FinalizeThread();
#   endif
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to win/tclWinPort.h.
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561


/*
 * The following macros have trivial definitions, allowing generic code to
 * address platform-specific issues.
 */

#define TclpReleaseFile(file)	ckfree(file)

/*
 * The following macros and declarations wrap the C runtime library
 * functions.
 */

#define TclpExit		exit







|







547
548
549
550
551
552
553
554
555
556
557
558
559
560
561


/*
 * The following macros have trivial definitions, allowing generic code to
 * address platform-specific issues.
 */

#define TclpReleaseFile(file)	Tcl_Free(file)

/*
 * The following macros and declarations wrap the C runtime library
 * functions.
 */

#define TclpExit		exit
Changes to win/tclWinReg.c.
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
	return TCL_ERROR;
    }

    cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
	    interp, DeleteCmd);
    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
    return Tcl_PkgProvide(interp, "registry", "1.3.2");
}

/*
 *----------------------------------------------------------------------
 *
 * Registry_Unload --
 *







|







152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
	return TCL_ERROR;
    }

    cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
	    interp, DeleteCmd);
    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
    return Tcl_PkgProvide(interp, "registry", "1.3.3");
}

/*
 *----------------------------------------------------------------------
 *
 * Registry_Unload --
 *
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
    REGSAM saveMode = mode;

    /*
     * Find the parent of the key being deleted and open it.
     */

    keyName = Tcl_GetString(keyNameObj);
    buffer = ckalloc(keyNameObj->length + 1);
    strcpy(buffer, keyName);

    if (ParseKeyName(interp, buffer, &hostName, &rootKey,
	    &keyName) != TCL_OK) {
	ckfree(buffer);
	return TCL_ERROR;
    }

    if (*keyName == '\0') {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("bad key: cannot delete root keys", -1));
	Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
	ckfree(buffer);
	return TCL_ERROR;
    }

    tail = strrchr(keyName, '\\');
    if (tail) {
	*tail++ = '\0';
    } else {
	tail = keyName;
	keyName = NULL;
    }

    mode |= KEY_ENUMERATE_SUB_KEYS | DELETE;
    result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
    if (result != ERROR_SUCCESS) {
	ckfree(buffer);
	if (result == ERROR_FILE_NOT_FOUND) {
	    return TCL_OK;
	}
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to delete key: ", -1));
	AppendSystemError(interp, result);
	return TCL_ERROR;







|




|







|














|







403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
    REGSAM saveMode = mode;

    /*
     * Find the parent of the key being deleted and open it.
     */

    keyName = Tcl_GetString(keyNameObj);
    buffer = Tcl_Alloc(keyNameObj->length + 1);
    strcpy(buffer, keyName);

    if (ParseKeyName(interp, buffer, &hostName, &rootKey,
	    &keyName) != TCL_OK) {
	Tcl_Free(buffer);
	return TCL_ERROR;
    }

    if (*keyName == '\0') {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("bad key: cannot delete root keys", -1));
	Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
	Tcl_Free(buffer);
	return TCL_ERROR;
    }

    tail = strrchr(keyName, '\\');
    if (tail) {
	*tail++ = '\0';
    } else {
	tail = keyName;
	keyName = NULL;
    }

    mode |= KEY_ENUMERATE_SUB_KEYS | DELETE;
    result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
    if (result != ERROR_SUCCESS) {
	Tcl_Free(buffer);
	if (result == ERROR_FILE_NOT_FOUND) {
	    return TCL_OK;
	}
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to delete key: ", -1));
	AppendSystemError(interp, result);
	return TCL_ERROR;
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
	AppendSystemError(interp, result);
	result = TCL_ERROR;
    } else {
	result = TCL_OK;
    }

    RegCloseKey(subkey);
    ckfree(buffer);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteValue --







|







459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
	AppendSystemError(interp, result);
	result = TCL_ERROR;
    } else {
	result = TCL_OK;
    }

    RegCloseKey(subkey);
    Tcl_Free(buffer);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteValue --
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
			"unable to enumerate subkeys of \"%s\": ",
			Tcl_GetString(keyNameObj)));
		AppendSystemError(interp, result);
		result = TCL_ERROR;
	    }
	    break;
	}
	Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
	name = Tcl_DStringValue(&ds);
	if (pattern && !Tcl_StringMatch(name, pattern)) {
	    Tcl_DStringFree(&ds);
	    continue;
	}
	result = Tcl_ListObjAppendElement(interp, resultPtr,
		Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
	Tcl_DStringFree(&ds);







|
<







592
593
594
595
596
597
598
599

600
601
602
603
604
605
606
			"unable to enumerate subkeys of \"%s\": ",
			Tcl_GetString(keyNameObj)));
		AppendSystemError(interp, result);
		result = TCL_ERROR;
	    }
	    break;
	}
	name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);

	if (pattern && !Tcl_StringMatch(name, pattern)) {
	    Tcl_DStringFree(&ds);
	    continue;
	}
	result = Tcl_ListObjAppendElement(interp, resultPtr,
		Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
	Tcl_DStringFree(&ds);
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
    char *keyName, *buffer, *hostName;
    size_t length;
    HKEY rootKey;
    DWORD result;

    keyName = Tcl_GetString(keyNameObj);
    length = keyNameObj->length;
    buffer = ckalloc(length + 1);
    strcpy(buffer, keyName);

    result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
    if (result == TCL_OK) {
	result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
	if (result != ERROR_SUCCESS) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("unable to open key: ", -1));
	    AppendSystemError(interp, result);
	    result = TCL_ERROR;
	} else {
	    result = TCL_OK;
	}
    }

    ckfree(buffer);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * OpenSubKey --







|















|







938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
    char *keyName, *buffer, *hostName;
    size_t length;
    HKEY rootKey;
    DWORD result;

    keyName = Tcl_GetString(keyNameObj);
    length = keyNameObj->length;
    buffer = Tcl_Alloc(length + 1);
    strcpy(buffer, keyName);

    result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
    if (result == TCL_OK) {
	result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
	if (result != ERROR_SUCCESS) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("unable to open key: ", -1));
	    AppendSystemError(interp, result);
	    result = TCL_ERROR;
	} else {
	    result = TCL_OK;
	}
    }

    Tcl_Free(buffer);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * OpenSubKey --
1008
1009
1010
1011
1012
1013
1014

1015

1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032

1033

1034
1035
1036
1037
1038
1039
1040
    }

    /*
     * Now open the specified key with the requested permissions. Note that
     * this key must be closed by the caller.
     */


    keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);

    if (flags & REG_CREATE) {
	DWORD create;

	result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL,
		REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
    } else if (rootKey == HKEY_PERFORMANCE_DATA) {
	/*
	 * Here we fudge it for this special root key. See MSDN for more info
	 * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it.
	 */

	*keyPtr = HKEY_PERFORMANCE_DATA;
	result = ERROR_SUCCESS;
    } else {
	result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
		keyPtr);
    }

    Tcl_DStringFree(&buf);


    /*
     * Be sure to close the root key since we are done with it now.
     */

    if (hostName) {
	RegCloseKey(rootKey);







>
|
>

















>
|
>







1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
    }

    /*
     * Now open the specified key with the requested permissions. Note that
     * this key must be closed by the caller.
     */

    if (keyName) {
	keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
    }
    if (flags & REG_CREATE) {
	DWORD create;

	result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL,
		REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
    } else if (rootKey == HKEY_PERFORMANCE_DATA) {
	/*
	 * Here we fudge it for this special root key. See MSDN for more info
	 * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it.
	 */

	*keyPtr = HKEY_PERFORMANCE_DATA;
	result = ERROR_SUCCESS;
    } else {
	result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
		keyPtr);
    }
    if (keyName) {
	Tcl_DStringFree(&buf);
    }

    /*
     * Be sure to close the root key since we are done with it now.
     */

    if (hostName) {
	RegCloseKey(rootKey);
Changes to win/tclWinSerial.c.
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532

	/*
	 * Queue an event if the serial is signaled for reading or writing.
	 */

	if (needEvent) {
	    infoPtr->flags |= SERIAL_PENDING;
	    evPtr = ckalloc(sizeof(SerialEvent));
	    evPtr->header.proc = SerialEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}








|







518
519
520
521
522
523
524
525
526
527
528
529
530
531
532

	/*
	 * Queue an event if the serial is signaled for reading or writing.
	 */

	if (needEvent) {
	    infoPtr->flags |= SERIAL_PENDING;
	    evPtr = Tcl_Alloc(sizeof(SerialEvent));
	    evPtr->header.proc = SerialEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}

650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
    }

    /*
     * Wrap the error file into a channel and give it to the cleanup routine.
     */

    if (serialPtr->writeBuf != NULL) {
	ckfree(serialPtr->writeBuf);
	serialPtr->writeBuf = NULL;
    }
    ckfree(serialPtr);

    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}








|


|







650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
    }

    /*
     * Wrap the error file into a channel and give it to the cleanup routine.
     */

    if (serialPtr->writeBuf != NULL) {
	Tcl_Free(serialPtr->writeBuf);
	serialPtr->writeBuf = NULL;
    }
    Tcl_Free(serialPtr);

    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}

1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = ckalloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->evWritable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	bytesWritten = (DWORD) toWrite;

    } else {
	/*







|


|

|







1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		Tcl_Free(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = Tcl_Alloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->evWritable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	bytesWritten = (DWORD) toWrite;

    } else {
	/*
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
    char *channelName,
    int permissions)
{
    SerialInfo *infoPtr;

    SerialInit();

    infoPtr = ckalloc(sizeof(SerialInfo));
    memset(infoPtr, 0, sizeof(SerialInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;
    infoPtr->readable = 0;
    infoPtr->writable = 1;







|







1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
    char *channelName,
    int permissions)
{
    SerialInfo *infoPtr;

    SerialInit();

    infoPtr = Tcl_Alloc(sizeof(SerialInfo));
    memset(infoPtr, 0, sizeof(SerialInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;
    infoPtr->readable = 0;
    infoPtr->writable = 1;
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
	badXchar:
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -xchar: should be a list of"
			" two elements with each a single character", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	/*
	 * These dereferences are safe, even in the zero-length string cases,
	 * because that just makes the xon/xoff character into NUL. When the
	 * character looks like it is UTF-8 encoded, decode it before casting







|







1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
	badXchar:
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -xchar: should be a list of"
			" two elements with each a single character", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
	    }
	    Tcl_Free(argv);
	    return TCL_ERROR;
	}

	/*
	 * These dereferences are safe, even in the zero-length string cases,
	 * because that just makes the xon/xoff character into NUL. When the
	 * character looks like it is UTF-8 encoded, decode it before casting
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
	    dcb.XonChar = (char) character;
	    charLen = Tcl_UtfToUniChar(argv[1], &character);
	    if (argv[1][charLen]) {
		goto badXchar;
	    }
	    dcb.XoffChar = (char) character;
	}
	ckfree(argv);

	if (!SetCommState(infoPtr->handle, &dcb)) {
	    goto setStateFailed;
	}
	return TCL_OK;
    }








|







1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
	    dcb.XonChar = (char) character;
	    charLen = Tcl_UtfToUniChar(argv[1], &character);
	    if (argv[1][charLen]) {
		goto badXchar;
	    }
	    dcb.XoffChar = (char) character;
	}
	Tcl_Free(argv);

	if (!SetCommState(infoPtr->handle, &dcb)) {
	    goto setStateFailed;
	}
	return TCL_OK;
    }

1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
	if ((argc % 2) == 1) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad value \"%s\" for -ttycontrol: should be "
			"a list of signal,value pairs", value));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	for (i = 0; i < argc - 1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
		result = TCL_ERROR;
		break;







|







1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
	if ((argc % 2) == 1) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad value \"%s\" for -ttycontrol: should be "
			"a list of signal,value pairs", value));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
	    }
	    Tcl_Free(argv);
	    return TCL_ERROR;
	}

	for (i = 0; i < argc - 1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
		result = TCL_ERROR;
		break;
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
			    NULL);
		}
		result = TCL_ERROR;
		break;
	    }
	}

	ckfree(argv);
	return result;
    }

    /*
     * Option -sysbuffer {read_size write_size}
     * Option -sysbuffer read_size
     */







|







1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
			    NULL);
		}
		result = TCL_ERROR;
		break;
	    }
	}

	Tcl_Free(argv);
	return result;
    }

    /*
     * Option -sysbuffer {read_size write_size}
     * Option -sysbuffer read_size
     */
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
	if (argc == 1) {
	    inSize = atoi(argv[0]);
	    outSize = infoPtr->sysBufWrite;
	} else if (argc == 2) {
	    inSize  = atoi(argv[0]);
	    outSize = atoi(argv[1]);
	}
	ckfree(argv);

	if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad value \"%s\" for -sysbuffer: should be "
			"a list of one or two integers > 0", value));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);







|







1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
	if (argc == 1) {
	    inSize = atoi(argv[0]);
	    outSize = infoPtr->sysBufWrite;
	} else if (argc == 2) {
	    inSize  = atoi(argv[0]);
	    outSize = atoi(argv[1]);
	}
	Tcl_Free(argv);

	if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad value \"%s\" for -sysbuffer: should be "
			"a list of one or two integers > 0", value));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
Changes to win/tclWinSock.c.
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);
    *valuePtr = ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *







|







393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);
    *valuePtr = Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
	    TcpFdList *thisfd = statePtr->sockets;

	    statePtr->sockets = thisfd->next;
	    if (closesocket(thisfd->fd) == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		errorCode = Tcl_GetErrno();
	    }
	    ckfree(thisfd);
	}
    }

    if (statePtr->addrlist != NULL) {
        freeaddrinfo(statePtr->addrlist);
    }
    if (statePtr->myaddrlist != NULL) {







|







1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
	    TcpFdList *thisfd = statePtr->sockets;

	    statePtr->sockets = thisfd->next;
	    if (closesocket(thisfd->fd) == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		errorCode = Tcl_GetErrno();
	    }
	    Tcl_Free(thisfd);
	}
    }

    if (statePtr->addrlist != NULL) {
        freeaddrinfo(statePtr->addrlist);
    }
    if (statePtr->myaddrlist != NULL) {
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
    /*
     * TIP #218. Removed the code removing the structure from the global
     * socket list. This is now done by the thread action callbacks, and only
     * there. This happens before this code is called. We can free without
     * fear of damaging the list.
     */

    ckfree(statePtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpClose2Proc --







|







1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
    /*
     * TIP #218. Removed the code removing the structure from the global
     * socket list. This is now done by the thread action callbacks, and only
     * there. This happens before this code is called. We can free without
     * fear of damaging the list.
     */

    Tcl_Free(statePtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpClose2Proc --
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
    for (statePtr = tsdPtr->socketList; statePtr != NULL;
	    statePtr = statePtr->nextPtr) {
	if (GOT_BITS(statePtr->readyEvents,
		statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
                && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) {
	    SET_BITS(statePtr->flags, SOCKET_PENDING);
	    evPtr = ckalloc(sizeof(SocketEvent));
	    evPtr->header.proc = SocketEventProc;
	    evPtr->socket = statePtr->sockets->fd;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
    SetEvent(tsdPtr->socketListLock);
}







|







2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
    for (statePtr = tsdPtr->socketList; statePtr != NULL;
	    statePtr = statePtr->nextPtr) {
	if (GOT_BITS(statePtr->readyEvents,
		statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
                && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) {
	    SET_BITS(statePtr->flags, SOCKET_PENDING);
	    evPtr = Tcl_Alloc(sizeof(SocketEvent));
	    evPtr->header.proc = SocketEventProc;
	    evPtr->socket = statePtr->sockets->fd;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
    SetEvent(tsdPtr->socketListLock);
}
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
    TcpFdList *fds = statePtr->sockets;

    if (fds == NULL) {
	/*
         * Add the first FD.
         */

	statePtr->sockets = ckalloc(sizeof(TcpFdList));
	fds = statePtr->sockets;
    } else {
	/*
         * Find end of list and append FD.
         */

	while (fds->next != NULL) {
	    fds = fds->next;
	}

	fds->next = ckalloc(sizeof(TcpFdList));
	fds = fds->next;
    }

    /*
     * Populate new FD.
     */








|










|







2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
    TcpFdList *fds = statePtr->sockets;

    if (fds == NULL) {
	/*
         * Add the first FD.
         */

	statePtr->sockets = Tcl_Alloc(sizeof(TcpFdList));
	fds = statePtr->sockets;
    } else {
	/*
         * Find end of list and append FD.
         */

	while (fds->next != NULL) {
	    fds = fds->next;
	}

	fds->next = Tcl_Alloc(sizeof(TcpFdList));
	fds = fds->next;
    }

    /*
     * Populate new FD.
     */

3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
 *
 *----------------------------------------------------------------------
 */

static TcpState *
NewSocketInfo(SOCKET socket)
{
    TcpState *statePtr = ckalloc(sizeof(TcpState));

    memset(statePtr, 0, sizeof(TcpState));

    /*
     * TIP #218. Removed the code inserting the new structure into the global
     * list. This is now handled in the thread action callbacks, and only
     * there.







|







3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
 *
 *----------------------------------------------------------------------
 */

static TcpState *
NewSocketInfo(SOCKET socket)
{
    TcpState *statePtr = Tcl_Alloc(sizeof(TcpState));

    memset(statePtr, 0, sizeof(TcpState));

    /*
     * TIP #218. Removed the code inserting the new structure into the global
     * list. This is now handled in the thread action callbacks, and only
     * there.
Changes to win/tclWinTest.c.
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
    if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
	DWORD secDescLen2 = 0;

	if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
	    goto done;
	}

	secDesc = ckalloc(secDescLen);
	if (!GetFileSecurityA(nativePath, infoBits,
		(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
		|| (secDescLen < secDescLen2)) {
	    goto done;
	}
    }

    /*
     * Get the World SID.
     */

    userSid = ckalloc(GetSidLengthRequired((UCHAR) 1));
    InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
    *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;

    /*
     * If curAclPresent == false then curAcl and curAclDefaulted not valid.
     */








|











|







459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
    if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
	DWORD secDescLen2 = 0;

	if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
	    goto done;
	}

	secDesc = Tcl_Alloc(secDescLen);
	if (!GetFileSecurityA(nativePath, infoBits,
		(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
		|| (secDescLen < secDescLen2)) {
	    goto done;
	}
    }

    /*
     * Get the World SID.
     */

    userSid = Tcl_Alloc(GetSidLengthRequired((UCHAR) 1));
    InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
    *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;

    /*
     * If curAclPresent == false then curAcl and curAclDefaulted not valid.
     */

497
498
499
500
501
502
503
504
505
506
507
508
509
510
511

    /*
     * Allocate memory for the new ACL.
     */

    newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
	    + GetLengthSid(userSid) - sizeof(DWORD);
    newAcl = ckalloc(newAclSize);

    /*
     * Initialize the new ACL.
     */

    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
	goto done;







|







497
498
499
500
501
502
503
504
505
506
507
508
509
510
511

    /*
     * Allocate memory for the new ACL.
     */

    newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
	    + GetLengthSid(userSid) - sizeof(DWORD);
    newAcl = Tcl_Alloc(newAclSize);

    /*
     * Initialize the new ACL.
     */

    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
	goto done;
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
	    (LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION,
	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
	res = 0;
    }

  done:
    if (secDesc) {
	ckfree(secDesc);
    }
    if (newAcl) {
	ckfree(newAcl);
    }
    if (userSid) {
	ckfree(userSid);
    }
    if (userDomain) {
	ckfree(userDomain);
    }

    if (res != 0) {
	return res;
    }

    /*







|


|


|


|







572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
	    (LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION,
	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
	res = 0;
    }

  done:
    if (secDesc) {
	Tcl_Free(secDesc);
    }
    if (newAcl) {
	Tcl_Free(newAcl);
    }
    if (userSid) {
	Tcl_Free(userSid);
    }
    if (userDomain) {
	Tcl_Free(userDomain);
    }

    if (res != 0) {
	return res;
    }

    /*
Changes to win/tclWinThrd.c.
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
	    | _MCW_PC
#endif
    );

    lpOrigStartAddress = winThreadPtr->lpStartAddress;
    lpOrigParameter = winThreadPtr->lpParameter;

    ckfree(winThreadPtr);
    return lpOrigStartAddress(lpOrigParameter);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --







|







174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
	    | _MCW_PC
#endif
    );

    lpOrigStartAddress = winThreadPtr->lpStartAddress;
    lpOrigParameter = winThreadPtr->lpParameter;

    Tcl_Free(winThreadPtr);
    return lpOrigStartAddress(lpOrigParameter);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread. */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread. */
    ClientData clientData,	/* The one argument to Main(). */
    int stackSize,		/* Size of stack for the new thread. */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
    WinThread *winThreadPtr;		/* Per-thread startup info */
    HANDLE tHandle;

    winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread));
    winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
    winThreadPtr->lpParameter = clientData;
    winThreadPtr->fpControl = _controlfp(0, 0);

    EnterCriticalSection(&joinLock);

    *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and







|






|







200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread. */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread. */
    ClientData clientData,	/* The one argument to Main(). */
    size_t stackSize,		/* Size of stack for the new thread. */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
    WinThread *winThreadPtr;		/* Per-thread startup info */
    HANDLE tHandle;

    winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread));
    winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
    winThreadPtr->lpParameter = clientData;
    winThreadPtr->fpControl = _controlfp(0, 0);

    EnterCriticalSection(&joinLock);

    *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
	TclpMasterLock();

	/*
	 * Double inside master lock check to avoid a race.
	 */

	if (*mutexPtr == NULL) {
	    csPtr = ckalloc(sizeof(CRITICAL_SECTION));
	    InitializeCriticalSection(csPtr);
	    *mutexPtr = (Tcl_Mutex)csPtr;
	    TclRememberMutex(mutexPtr);
	}
	TclpMasterUnlock();
    }
    csPtr = *((CRITICAL_SECTION **)mutexPtr);







|







564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
	TclpMasterLock();

	/*
	 * Double inside master lock check to avoid a race.
	 */

	if (*mutexPtr == NULL) {
	    csPtr = Tcl_Alloc(sizeof(CRITICAL_SECTION));
	    InitializeCriticalSection(csPtr);
	    *mutexPtr = (Tcl_Mutex)csPtr;
	    TclRememberMutex(mutexPtr);
	}
	TclpMasterUnlock();
    }
    csPtr = *((CRITICAL_SECTION **)mutexPtr);
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;

    if (csPtr != NULL) {
	DeleteCriticalSection(csPtr);
	ckfree(csPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;

    if (csPtr != NULL) {
	DeleteCriticalSection(csPtr);
	Tcl_Free(csPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
	TclpMasterLock();

	/*
	 * Initialize the per-condition queue pointers and Mutex.
	 */

	if (*condPtr == NULL) {
	    winCondPtr = ckalloc(sizeof(WinCondition));
	    InitializeCriticalSection(&winCondPtr->condLock);
	    winCondPtr->firstPtr = NULL;
	    winCondPtr->lastPtr = NULL;
	    *condPtr = (Tcl_Condition) winCondPtr;
	    TclRememberCondition(condPtr);
	}
	TclpMasterUnlock();







|







707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
	TclpMasterLock();

	/*
	 * Initialize the per-condition queue pointers and Mutex.
	 */

	if (*condPtr == NULL) {
	    winCondPtr = Tcl_Alloc(sizeof(WinCondition));
	    InitializeCriticalSection(&winCondPtr->condLock);
	    winCondPtr->firstPtr = NULL;
	    winCondPtr->lastPtr = NULL;
	    *condPtr = (Tcl_Condition) winCondPtr;
	    TclRememberCondition(condPtr);
	}
	TclpMasterUnlock();
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
     * The per-thread condition waiting event is reclaimed earlier in a
     * per-thread exit handler, which is called before thread local storage is
     * reclaimed.
     */

    if (winCondPtr != NULL) {
	DeleteCriticalSection(&winCondPtr->condLock);
	ckfree(winCondPtr);
	*condPtr = NULL;
    }
}











|







918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
     * The per-thread condition waiting event is reclaimed earlier in a
     * per-thread exit handler, which is called before thread local storage is
     * reclaimed.
     */

    if (winCondPtr != NULL) {
	DeleteCriticalSection(&winCondPtr->condLock);
	Tcl_Free(winCondPtr);
	*condPtr = NULL;
    }
}




Changes to win/tclWinTime.c.
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

unsigned long
TclpGetSeconds(void)
{
    Tcl_Time t;

    tclGetTimeProcPtr(&t, tclTimeClientData);	/* Tcl_GetTime inlined. */
    return t.sec;
}







|







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetSeconds(void)
{
    Tcl_Time t;

    tclGetTimeProcPtr(&t, tclTimeClientData);	/* Tcl_GetTime inlined. */
    return t.sec;
}
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

unsigned long
TclpGetClicks(void)
{
    /*
     * Use the Tcl_GetTime abstraction to get the time in microseconds, as
     * nearly as we can, and return it.
     */

    Tcl_Time now;		/* Current Tcl time */
    unsigned long retval;	/* Value to return */

    tclGetTimeProcPtr(&now, tclTimeClientData);	/* Tcl_GetTime inlined */

    retval = (now.sec * 1000000) + now.usec;
    return retval;

}

/*
 *----------------------------------------------------------------------
 *







|












|







151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetClicks(void)
{
    /*
     * Use the Tcl_GetTime abstraction to get the time in microseconds, as
     * nearly as we can, and return it.
     */

    Tcl_Time now;		/* Current Tcl time */
    unsigned long retval;	/* Value to return */

    tclGetTimeProcPtr(&now, tclTimeClientData);	/* Tcl_GetTime inlined */

    retval = ((Tcl_WideUInt) now.sec * 1000000) + now.usec;
    return retval;

}

/*
 *----------------------------------------------------------------------
 *