Tcl Source Code

Check-in [1f0f096bc0]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dgp-refactor
Files: files | file ages | folders
SHA1: 1f0f096bc02dc55f554cfa6456b45ef24b1b4da8
User & Date: dgp 2014-05-08 16:28:55
Context
2014-05-08
17:46
merge trunk check-in: e34a130b6f user: dgp tags: dgp-refactor
16:28
merge trunk check-in: 1f0f096bc0 user: dgp tags: dgp-refactor
16:21
silence compiler warning check-in: 1b033660ab user: dgp tags: trunk
2014-04-16
19:11
merge trunk check-in: 7d6ac7cc9a user: dgp tags: dgp-refactor
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/fcopy.n.

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
...
145
146
147
148
149
150
151


















152
153
154
155
error string associated with the error.
With a background copy,
it is not necessary to put \fIinchan\fR or \fIoutchan\fR into
non-blocking mode; the \fBfcopy\fR command takes care of that automatically.
However, it is necessary to enter the event loop by using
the \fBvwait\fR command or by using Tk.
.PP
You are not allowed to do other I/O operations with
\fIinchan\fR or \fIoutchan\fR during a background \fBfcopy\fR.



If either \fIinchan\fR or \fIoutchan\fR get closed
while the copy is in progress, the current copy is stopped
and the command callback is \fInot\fR made.
If \fIinchan\fR is closed,
then all data already queued for \fIoutchan\fR is written out.
.PP
Note that \fIinchan\fR can become readable during a background copy.
You should turn off any \fBfileevent\fR handlers during a background
copy so those handlers do not interfere with the copy.
Any I/O attempted by a \fBfileevent\fR handler will get a
.QW "channel busy"
error.
.PP
\fBFcopy\fR translates end-of-line sequences in \fIinchan\fR and \fIoutchan\fR
according to the \fB\-translation\fR option
for these channels.
See the manual entry for \fBfconfigure\fR for details on the
................................................................................
set out [socket $server $port]
set chunk 1024
set total 0
\fBfcopy\fR $in $out -size $chunk \e
        -command [list CopyMore $in $out $chunk]
vwait done
.CE


















.SH "SEE ALSO"
eof(n), fblocked(n), fconfigure(n), file(n)
.SH KEYWORDS
blocking, channel, end of line, end of file, nonblocking, read, translation






|
|
>
>
>









|







 







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




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
...
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
error string associated with the error.
With a background copy,
it is not necessary to put \fIinchan\fR or \fIoutchan\fR into
non-blocking mode; the \fBfcopy\fR command takes care of that automatically.
However, it is necessary to enter the event loop by using
the \fBvwait\fR command or by using Tk.
.PP
You are not allowed to do other input operations with \fIinchan\fR, or
output operations with \fIoutchan\fR, during a background
\fBfcopy\fR. The converse is entirely legitimate, as exhibited by the
bidirectional fcopy example below.
.PP
If either \fIinchan\fR or \fIoutchan\fR get closed
while the copy is in progress, the current copy is stopped
and the command callback is \fInot\fR made.
If \fIinchan\fR is closed,
then all data already queued for \fIoutchan\fR is written out.
.PP
Note that \fIinchan\fR can become readable during a background copy.
You should turn off any \fBfileevent\fR handlers during a background
copy so those handlers do not interfere with the copy.
Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will get a
.QW "channel busy"
error.
.PP
\fBFcopy\fR translates end-of-line sequences in \fIinchan\fR and \fIoutchan\fR
according to the \fB\-translation\fR option
for these channels.
See the manual entry for \fBfconfigure\fR for details on the
................................................................................
set out [socket $server $port]
set chunk 1024
set total 0
\fBfcopy\fR $in $out -size $chunk \e
        -command [list CopyMore $in $out $chunk]
vwait done
.CE
.PP
The fourth example starts an asynchronous, bidirectional fcopy between
two sockets. Those could also be pipes from two [open "|hal 9000" r+]
(though their conversation would remain secret to the script, since
all four fileevent slots are busy).
.PP
.CS
set flows 2
proc Done {dir args} {
     global flows done
     puts "$dir is over."
     incr flows -1
     if {$flows<=0} {set done 1}
}
\fBfcopy\fR $sok1 $sok2 -command [list Done UP]
\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN]
vwait done
.CE
.SH "SEE ALSO"
eof(n), fblocked(n), fconfigure(n), file(n)
.SH KEYWORDS
blocking, channel, end of line, end of file, nonblocking, read, translation

Changes to doc/tclvars.n.

343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
If this variable exists, then the interpreter
was compiled with threads enabled.
.TP
\fBuser\fR
.
This identifies the
current user based on the login information available on the platform.
This comes from the USER or LOGNAME environment variable on Unix,
and the value from GetUserName on Windows.
.TP
\fBwordSize\fR
.
This gives the size of the native-machine word in bytes (strictly, it
is same as the result of evaluating \fIsizeof(long)\fR in C.)
.RE
.TP






|
|







343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
If this variable exists, then the interpreter
was compiled with threads enabled.
.TP
\fBuser\fR
.
This identifies the
current user based on the login information available on the platform.
This value comes from the getuid() and getpwuid() system calls on Unix,
and the value from the GetUserName() system call on Windows.
.TP
\fBwordSize\fR
.
This gives the size of the native-machine word in bytes (strictly, it
is same as the result of evaluating \fIsizeof(long)\fR in C.)
.RE
.TP

Changes to generic/tcl.h.

2429
2430
2431
2432
2433
2434
2435
2436

2437





2438
2439
2440
2441
2442
2443
2444
 * table.
 */

#include "tclDecls.h"

/*
 * Include platform specific public function declarations that are accessible
 * via the stubs table.

 */






#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






|
>

>
>
>
>
>







2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
 * table.
 */

#include "tclDecls.h"

/*
 * Include platform specific public function declarations that are accessible
 * via the stubs table. Make all TclOO symbols MODULE_SCOPE (which only
 * has effect on building it as a shared library). See ticket [3010352].
 */

#if defined(BUILD_tcl)
#   undef TCLAPI
#   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

Changes to generic/tclExecute.c.

5698
5699
5700
5701
5702
5703
5704
5705







5706
5707
5708
5709




5710
5711
5712
5713
5714
5715
5716
	} else if (Tcl_IsShared(value3Ptr)) {
	    objResultPtr = Tcl_DuplicateObj(value3Ptr);
	    if (toIdx < length) {
		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
			length - toIdx);
	    }
	} else {
	    objResultPtr = value3Ptr;







	    if (toIdx < length) {
		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
			length - toIdx);
	    }




	}
	TclDecrRefCount(value3Ptr);
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_MAP:
	valuePtr = OBJ_AT_TOS;		/* "Main" string. */






<
>
>
>
>
>
>
>

|


>
>
>
>







5698
5699
5700
5701
5702
5703
5704

5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
	} else if (Tcl_IsShared(value3Ptr)) {
	    objResultPtr = Tcl_DuplicateObj(value3Ptr);
	    if (toIdx < length) {
		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
			length - toIdx);
	    }
	} else {

	    /*
	     * Be careful with splicing the stack in this case; we have a
	     * refCount:1 object in value3Ptr and we want to append to it and
	     * make it be the refCount:1 object at the top of the stack
	     * afterwards. [Bug 82e7f67325]
	     */

	    if (toIdx < length) {
		Tcl_AppendUnicodeToObj(value3Ptr, ustring1 + toIdx + 1,
			length - toIdx);
	    }
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    TclDecrRefCount(valuePtr);
	    OBJ_AT_TOS = value3Ptr;	/* Tricky! */
	    NEXT_INST_F(1, 0, 0);
	}
	TclDecrRefCount(value3Ptr);
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_MAP:
	valuePtr = OBJ_AT_TOS;		/* "Main" string. */

Changes to generic/tclIO.c.

158
159
160
161
162
163
164



165
166
167
168
169
170
171
...
383
384
385
386
387
388
389

390
391
392
393
394
395
396
....
1739
1740
1741
1742
1743
1744
1745




1746
1747
1748
1749
1750
1751
1752
....
1868
1869
1870
1871
1872
1873
1874







1875
1876
1877
1878
1879
1880
1881
....
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
....
2284
2285
2286
2287
2288
2289
2290

2291
2292



























2293
2294
2295
2296
2297
2298
2299
....
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
....
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
....
2540
2541
2542
2543
2544
2545
2546

2547
2548
2549
2550
2551
2552
2553
....
2561
2562
2563
2564
2565
2566
2567

2568
2569
2570
2571
2572
2573
2574
....
2582
2583
2584
2585
2586
2587
2588

2589
2590
2591
2592
2593
2594
2595
....
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
....
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
....
3176
3177
3178
3179
3180
3181
3182
3183

3184
3185
3186
3187
3188
3189
3190
....
3973
3974
3975
3976
3977
3978
3979






3980
3981
3982
3983
3984
3985
3986
....
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
....
4148
4149
4150
4151
4152
4153
4154

4155
4156
4157
4158
4159
4160
4161

4162
4163
4164
4165
4166
4167
4168
....
4500
4501
4502
4503
4504
4505
4506
4507



4508
4509


4510
4511
4512
4513
4514
4515
4516
....
4536
4537
4538
4539
4540
4541
4542
4543


4544
4545


4546
4547
4548
4549
4550

4551

4552
4553
4554
4555
4556
4557
4558
4559
....
4578
4579
4580
4581
4582
4583
4584
4585


4586
4587


4588
4589
4590
4591
4592
4593
4594
....
4686
4687
4688
4689
4690
4691
4692



4693
4694
4695
4696
4697
4698
4699
....
4798
4799
4800
4801
4802
4803
4804
4805
4806

4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
....
4958
4959
4960
4961
4962
4963
4964





4965
4966
4967
4968
4969
4970
4971
....
5576
5577
5578
5579
5580
5581
5582





5583
5584
5585
5586
5587
5588
5589
....
5606
5607
5608
5609
5610
5611
5612
5613


5614
5615


5616
5617
5618
5619
5620
5621
5622
....
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
....
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
....
6521
6522
6523
6524
6525
6526
6527

6528
6529
6530
6531

6532
6533
6534
6535
6536
6537
6538
....
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
....
7696
7697
7698
7699
7700
7701
7702
7703

7704
7705
7706
7707
7708
7709
7710
....
9706
9707
9708
9709
9710
9711
9712

9713
9714
9715


9716
9717
9718
9719
9720
9721
9722
9723
9724
9725
} CloseCallback;

/*
 * Static functions in this file:
 */

static ChannelBuffer *	AllocChannelBuffer(int length);



static void		ChannelTimerProc(ClientData clientData);
static int		CheckChannelErrors(ChannelState *statePtr,
			    int direction);
static int		CheckForDeadChannel(Tcl_Interp *interp,
			    ChannelState *statePtr);
static void		CheckForStdChannelsBeingClosed(Tcl_Channel chan);
static void		CleanupChannelHandlers(Tcl_Interp *interp,
................................................................................
ChanRead(
    Channel *chanPtr,
    char *dst,
    int dstSize,
    int *errnoPtr)
{
    if (WillRead(chanPtr) < 0) {

        return -1;
    }

    return chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize,
	    errnoPtr);
}

................................................................................
    if ((mask & TCL_WRITABLE) != 0) {
	CopyState *csPtrR = statePtr->csPtrR;
	CopyState *csPtrW = statePtr->csPtrW;

	statePtr->csPtrR = NULL;
	statePtr->csPtrW = NULL;





	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
	    statePtr->csPtrR = csPtrR;
	    statePtr->csPtrW = csPtrW;
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "could not flush channel \"%s\"",
			Tcl_GetChannelName(prevChan)));
................................................................................
	/*
	 * Instead of manipulating the per-thread / per-interp list/hashtable
	 * of registered channels we wind down the state of the
	 * transformation, and then restore the state of underlying channel
	 * into the old structure.
	 */








	Channel *downChanPtr = chanPtr->downChanPtr;

	/*
	 * Flush the buffers. This ensures that any data still in them at this
	 * time _is_ handled by the transformation we are unstacking right
	 * now. Restrict this to writable channels. Take care to hide a
	 * possible bg-copy in progress from Tcl_Flush and the
................................................................................
	chanPtr->typePtr = NULL;

	/*
	 * AK: Tcl_NotifyChannel may hold a reference to this block of memory
	 */

	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
	UpdateInterest(downChanPtr);

	if (result != 0) {
	    Tcl_SetErrno(result);

	    /*
	     * TIP #219, Tcl Channel Reflection API.
	     * Move error messages put by the driver into the chan/ip bypass
................................................................................

    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;

    return bufPtr;
}



























 
/*
 *----------------------------------------------------------------------
 *
 * RecycleBuffer --
 *
 *	Helper function to recycle input and output buffers. Ensures that two
................................................................................
    ChannelBuffer *bufPtr,	/* The buffer to recycle. */
    int mustDiscard)		/* If nonzero, free the buffer to the OS,
				 * always. */
{
    /*
     * Do we have to free the buffer to the OS?
     */




    if (mustDiscard) {
	ckfree(bufPtr);
	return;
    }

    /*
     * Only save buffers which are at least as big as the requested buffersize
     * for the channel. This is to honor dynamic changes of the buffersize
     * made by the user.
     */

    if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
	ckfree(bufPtr);
	return;
    }

    /*
     * Only save buffers for the input queue if the channel is readable.
     */

................................................................................
	}
    }

    /*
     * If we reached this code we return the buffer to the OS.
     */

    ckfree(bufPtr);
    return;

  keepBuffer:
    bufPtr->nextRemoved = BUFFER_PADDING;
    bufPtr->nextAdded = BUFFER_PADDING;
    bufPtr->nextPtr = NULL;
}
................................................................................
	    break;		/* Out of the "while (1)". */
	}

	/*
	 * Produce the output on the channel.
	 */


	toWrite = BytesLeft(bufPtr);
	if (toWrite == 0) {
            written = 0;
	} else {
	    written = ChanWrite(chanPtr, RemovePoint(bufPtr), toWrite,
		    &errorCode);
	}
................................................................................
	if (written < 0) {
	    /*
	     * If the last attempt to write was interrupted, simply retry.
	     */

	    if (errorCode == EINTR) {
		errorCode = 0;

		continue;
	    }

	    /*
	     * If the channel is non-blocking and we would have blocked, start
	     * a background flushing handler and break out of the loop.
	     */
................................................................................
		 */

		if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED) && !TclInExit()) {
		    SetFlag(statePtr, BG_FLUSH_SCHEDULED);
		    UpdateInterest(chanPtr);
		}
		errorCode = 0;

		break;
	    }

	    /*
	     * Decide whether to report the error upwards or defer it.
	     */

................................................................................

	    /*
	     * When we get an error we throw away all the output currently
	     * queued.
	     */

	    DiscardOutputQueued(statePtr);

	    continue;
	} else {
	    wroteSome = 1;
	}

	if (!IsBufferEmpty(bufPtr)) {
	    bufPtr->nextRemoved += written;
	}

	/*
	 * If this buffer is now empty, recycle it.
	 */

	if (IsBufferEmpty(bufPtr)) {
	    statePtr->outQueueHead = bufPtr->nextPtr;
	    if (statePtr->outQueueHead == NULL) {
		statePtr->outQueueTail = NULL;
	    }
	    RecycleBuffer(statePtr, bufPtr, 0);
	}

    }	/* Closes "while (1)". */

    /*
     * If we wrote some data while flushing in the background, we are done.
     * We can't finish the background flush until we run out of data and the
     * channel becomes writable again. This ensures that all of the pending
     * data has been flushed at the system level.
................................................................................
    DiscardInputQueued(statePtr, 1);

    /*
     * Discard a leftover buffer in the current output buffer field.
     */

    if (statePtr->curOutPtr != NULL) {
	ckfree(statePtr->curOutPtr);
	statePtr->curOutPtr = NULL;
    }

    /*
     * The caller guarantees that there are no more buffers queued for output.
     */

................................................................................
    /*
     * When the channel has an escape sequence driven encoding such as
     * iso2022, the terminated escape sequence must write to the buffer.
     */

    stickyError = 0;

    if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)

	    && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
	statePtr->outputEncodingFlags |= TCL_ENCODING_END;
	if (WriteChars(chanPtr, "", 0) < 0) {
	    stickyError = Tcl_GetErrno();
	}

	/*
................................................................................
    }
}
 
static int
WillRead(
    Channel *chanPtr)
{






    if ((chanPtr->typePtr->seekProc != NULL)
            && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
        if ((chanPtr->state->curOutPtr != NULL)
                && IsBufferReady(chanPtr->state->curOutPtr)) {
            SetFlag(chanPtr->state, BUFFER_READY);
        }
        if (FlushChannel(NULL, chanPtr, 0) != 0) {
................................................................................
	     * that we need to stick at the beginning of this buffer.
	     */

	    memcpy(InsertPoint(bufPtr), safe, (size_t) saved);
	    bufPtr->nextAdded += saved;
	    saved = 0;
	}

	dst = InsertPoint(bufPtr);
	dstLen = SpaceLeft(bufPtr);

	result = Tcl_UtfToExternal(NULL, encoding, src, srcLimit,
		statePtr->outputEncodingFlags,
		&statePtr->outputEncodingState, dst,
		dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);

	/* See chan-io-1.[89]. Tcl Bug 506297. */
	statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
	
	if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
	    /* We're reading from invalid/incomplete UTF-8 */

	    if (total == 0) {
		Tcl_SetErrno(EINVAL);
		return -1;
	    }
	    break;
	}

................................................................................

	if ((srcLen + saved == 0) && (result == TCL_OK)) {
	    endEncoding = 0;
	}

	if (IsBufferFull(bufPtr)) {
	    if (FlushChannel(NULL, chanPtr, 0) != 0) {

		return -1;
	    }
	    flushed += statePtr->bufSize;
	    if (saved == 0 || src[-1] != '\n') {
		needNlFlush = 0;
	    }
	}

    }
    if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
	    (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
	SetFlag(statePtr, BUFFER_READY);
	if (FlushChannel(NULL, chanPtr, 0) != 0) {
	    return -1;
	}
................................................................................
     */

  gotEOL:
    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */
    /*



    chanPtr = statePtr->topChanPtr;
     */



    bufPtr = gs.bufPtr;
    if (bufPtr == NULL) {
	Tcl_Panic("Tcl_GetsObj: gotEOL reached with bufPtr==NULL");
    }
    statePtr->inputEncodingState = gs.state;
    Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead,
................................................................................
     */

  restore:
    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */
    /*


    chanPtr = statePtr->topChanPtr;
     */


    bufPtr = statePtr->inQueueHead;
    if (bufPtr == NULL) {
	Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL");
    }
    bufPtr->nextRemoved = oldRemoved;



    for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
	bufPtr->nextRemoved = BUFFER_PADDING;
    }
    CommonGetsCleanup(chanPtr);

    statePtr->inputEncodingState = oldState;
    statePtr->inputEncodingFlags = oldFlags;
    Tcl_SetObjLength(objPtr, oldLength);
................................................................................
     */

  done:
    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */
    /*


    chanPtr = statePtr->topChanPtr;
     */


    UpdateInterest(chanPtr);
    Tcl_Release(chanPtr);
    return copiedTotal;
}
 
/*
 *---------------------------------------------------------------------------
................................................................................
		}
		ResetFlag(statePtr, CHANNEL_BLOCKED);
	    }
	    if (GetInput(chanPtr) != 0) {
		goto restore;
	    }
	    bufPtr = statePtr->inQueueTail;



	}

	dst = (unsigned char *) RemovePoint(bufPtr);
	dstEnd = dst + BytesLeft(bufPtr);

	/*
	 * Remember if EOF char is seen, then look for EOL anyhow, because the
................................................................................
     * Couldn't get a complete line. This only happens if we get a error
     * reading from the channel or we are non-blocking and there wasn't an EOL
     * or EOF in the data available.
     */

  restore:
    bufPtr = statePtr->inQueueHead;
    if (bufPtr == NULL) {
	Tcl_Panic("TclGetsObjBinary: restore reached with bufPtr==NULL");

    }
    bufPtr->nextRemoved = oldRemoved;

    for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
	bufPtr->nextRemoved = BUFFER_PADDING;
    }
    CommonGetsCleanup(chanPtr);

    statePtr->inputEncodingFlags = oldFlags;
    byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);

................................................................................
	if (GetInput(chanPtr) != 0) {
	    gsPtr->charsWrote = 0;
	    gsPtr->rawRead = 0;
	    return -1;
	}
	bufPtr = statePtr->inQueueTail;
	gsPtr->bufPtr = bufPtr;





    }

    /*
     * Convert some of the bytes from the channel buffer to UTF-8. Space in
     * objPtr's string rep is used to hold the UTF-8 characters. Grow the
     * string rep if we need more space.
     */
................................................................................
	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
		    break;
		}
		ResetFlag(statePtr, CHANNEL_BLOCKED);
	    }
	    result = GetInput(chanPtr);





	    if (result != 0) {
		if (result == EAGAIN) {
		    break;
		}
		copied = -1;
		goto done;
	    }
................................................................................
     */

  done:
    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */
    /*


    chanPtr = statePtr->topChanPtr;
     */


    UpdateInterest(chanPtr);
    Tcl_Release(chanPtr);
    return copied;
}
 
/*
 *---------------------------------------------------------------------------
................................................................................

    /*
     * If discardSavedBuffers is nonzero, must also discard any previously
     * saved buffer in the saveInBufPtr field.
     */

    if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
	ckfree(statePtr->saveInBufPtr);
	statePtr->saveInBufPtr = NULL;
    }
}
 
/*
 *---------------------------------------------------------------------------
 *
................................................................................
	 * Check the actual buffersize against the requested buffersize.
	 * Buffers which are smaller than requested are squashed. This is done
	 * to honor dynamic changes of the buffersize made by the user.
	 */

	if ((bufPtr != NULL)
		&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
	    ckfree(bufPtr);
	    bufPtr = NULL;
	}

	if (bufPtr == NULL) {
	    bufPtr = AllocChannelBuffer(statePtr->bufSize);
	}
	bufPtr->nextPtr = NULL;
................................................................................
	 */

	nread = -1;
	result = EWOULDBLOCK;
    } else
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
    {

	nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
    }

    if (nread > 0) {

	bufPtr->nextAdded += nread;

	/*
	 * 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.
................................................................................
	     * [Bug 943274]: We have read the available data, clear flag.
	     */

	    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
	}
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
    } else if (nread == 0) {

	SetFlag(statePtr, CHANNEL_EOF);
	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
    } else if (nread < 0) {
	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
	    SetFlag(statePtr, CHANNEL_BLOCKED);
	    result = EAGAIN;
	}
	Tcl_SetErrno(result);
	return result;
    }
    return 0;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Seek --
 *
................................................................................
	}

	/*
	 * When the channel has an escape sequence driven encoding such as
	 * iso2022, the terminated escape sequence must write to the buffer.
	 */

	if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)

		&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
	    statePtr->outputEncodingFlags |= TCL_ENCODING_END;
	    WriteChars(chanPtr, "", 0);
	}
	Tcl_FreeEncoding(statePtr->encoding);
	statePtr->encoding = encoding;
	statePtr->inputEncodingState = NULL;
................................................................................
StackSetBlockMode(
    Channel *chanPtr,		/* Channel to modify. */
    int mode)			/* One of TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    int result = 0;
    Tcl_DriverBlockModeProc *blockModeProc;


    /*
     * Start at the top of the channel stack


     */

    chanPtr = chanPtr->state->topChanPtr;
    while (chanPtr != NULL) {
	blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
	if (blockModeProc != NULL) {
	    result = blockModeProc(chanPtr->instanceData, mode);
	    if (result != 0) {
		Tcl_SetErrno(result);
		return result;






>
>
>







 







>







 







>
>
>
>







 







>
>
>
>
>
>
>







 







|







 







>


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







 







>
>
|
>

|










|







 







|







 







>







 







>







 







>







 







>





<
|
<












>







 







|







 







|
>







 







>
>
>
>
>
>







 







>













>







 







>







>







 







<
>
>
>
|
<
>
>







 







<
>
>
|
<
>
>

|
<
<
|
>
|
>
|







 







<
>
>
|
<
>
>







 







>
>
>







 







|
|
>

<

|







 







>
>
>
>
>







 







>
>
>
>
>







 







<
>
>
|
<
>
>







 







|







 







|







 







>




>







 







>








|
|
|







 







|
>







 







>



>
>


|







158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
...
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
....
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
....
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
....
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
....
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
....
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
....
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
....
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
....
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
....
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
....
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
....
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
....
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
....
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
....
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
....
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
....
4560
4561
4562
4563
4564
4565
4566

4567
4568
4569
4570

4571
4572
4573
4574
4575
4576
4577
4578
4579
....
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
....
4643
4644
4645
4646
4647
4648
4649

4650
4651
4652

4653
4654
4655
4656
4657
4658
4659
4660
4661
....
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
....
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878

4879
4880
4881
4882
4883
4884
4885
4886
4887
....
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
....
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
....
5686
5687
5688
5689
5690
5691
5692

5693
5694
5695

5696
5697
5698
5699
5700
5701
5702
5703
5704
....
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
....
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
....
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
....
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
....
7781
7782
7783
7784
7785
7786
7787
7788
7789
7790
7791
7792
7793
7794
7795
7796
....
9792
9793
9794
9795
9796
9797
9798
9799
9800
9801
9802
9803
9804
9805
9806
9807
9808
9809
9810
9811
9812
9813
9814
} CloseCallback;

/*
 * Static functions in this file:
 */

static ChannelBuffer *	AllocChannelBuffer(int length);
static void		PreserveChannelBuffer(ChannelBuffer *bufPtr);
static void		ReleaseChannelBuffer(ChannelBuffer *bufPtr);
static int		IsShared(ChannelBuffer *bufPtr);
static void		ChannelTimerProc(ClientData clientData);
static int		CheckChannelErrors(ChannelState *statePtr,
			    int direction);
static int		CheckForDeadChannel(Tcl_Interp *interp,
			    ChannelState *statePtr);
static void		CheckForStdChannelsBeingClosed(Tcl_Channel chan);
static void		CleanupChannelHandlers(Tcl_Interp *interp,
................................................................................
ChanRead(
    Channel *chanPtr,
    char *dst,
    int dstSize,
    int *errnoPtr)
{
    if (WillRead(chanPtr) < 0) {
	*errnoPtr = Tcl_GetErrno();
        return -1;
    }

    return chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize,
	    errnoPtr);
}

................................................................................
    if ((mask & TCL_WRITABLE) != 0) {
	CopyState *csPtrR = statePtr->csPtrR;
	CopyState *csPtrW = statePtr->csPtrW;

	statePtr->csPtrR = NULL;
	statePtr->csPtrW = NULL;

	/*
	 * TODO: Examine what can go wrong if Tcl_Flush() call disturbs
	 * the stacking state of this channel during its operations.
	 */
	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
	    statePtr->csPtrR = csPtrR;
	    statePtr->csPtrW = csPtrW;
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "could not flush channel \"%s\"",
			Tcl_GetChannelName(prevChan)));
................................................................................
	/*
	 * Instead of manipulating the per-thread / per-interp list/hashtable
	 * of registered channels we wind down the state of the
	 * transformation, and then restore the state of underlying channel
	 * into the old structure.
	 */

	/*
	 * TODO: Figure out how to handle the situation where the chan
	 * operations called below by this unstacking operation cause
	 * another unstacking recursively.  In that case the downChanPtr
	 * value we're holding on to will not be the right thing.
	 */

	Channel *downChanPtr = chanPtr->downChanPtr;

	/*
	 * Flush the buffers. This ensures that any data still in them at this
	 * time _is_ handled by the transformation we are unstacking right
	 * now. Restrict this to writable channels. Take care to hide a
	 * possible bg-copy in progress from Tcl_Flush and the
................................................................................
	chanPtr->typePtr = NULL;

	/*
	 * AK: Tcl_NotifyChannel may hold a reference to this block of memory
	 */

	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
	UpdateInterest(statePtr->topChanPtr);

	if (result != 0) {
	    Tcl_SetErrno(result);

	    /*
	     * TIP #219, Tcl Channel Reflection API.
	     * Move error messages put by the driver into the chan/ip bypass
................................................................................

    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;
}

static void
PreserveChannelBuffer(
    ChannelBuffer *bufPtr)
{
    if (bufPtr->refCount == 0) {
	Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr);
    }
    bufPtr->refCount++;
}

static void
ReleaseChannelBuffer(
    ChannelBuffer *bufPtr)
{
    if (--bufPtr->refCount) {
	return;
    }
    ckfree(bufPtr);
}

static int
IsShared(
    ChannelBuffer *bufPtr)
{
    return bufPtr->refCount > 1;
}
 
/*
 *----------------------------------------------------------------------
 *
 * RecycleBuffer --
 *
 *	Helper function to recycle input and output buffers. Ensures that two
................................................................................
    ChannelBuffer *bufPtr,	/* The buffer to recycle. */
    int mustDiscard)		/* If nonzero, free the buffer to the OS,
				 * always. */
{
    /*
     * Do we have to free the buffer to the OS?
     */
    if (IsShared(bufPtr)) {
	mustDiscard = 1;
    }

    if (mustDiscard) {
	ReleaseChannelBuffer(bufPtr);
	return;
    }

    /*
     * Only save buffers which are at least as big as the requested buffersize
     * for the channel. This is to honor dynamic changes of the buffersize
     * made by the user.
     */

    if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
	ReleaseChannelBuffer(bufPtr);
	return;
    }

    /*
     * Only save buffers for the input queue if the channel is readable.
     */

................................................................................
	}
    }

    /*
     * If we reached this code we return the buffer to the OS.
     */

    ReleaseChannelBuffer(bufPtr);
    return;

  keepBuffer:
    bufPtr->nextRemoved = BUFFER_PADDING;
    bufPtr->nextAdded = BUFFER_PADDING;
    bufPtr->nextPtr = NULL;
}
................................................................................
	    break;		/* Out of the "while (1)". */
	}

	/*
	 * Produce the output on the channel.
	 */

	PreserveChannelBuffer(bufPtr);
	toWrite = BytesLeft(bufPtr);
	if (toWrite == 0) {
            written = 0;
	} else {
	    written = ChanWrite(chanPtr, RemovePoint(bufPtr), toWrite,
		    &errorCode);
	}
................................................................................
	if (written < 0) {
	    /*
	     * If the last attempt to write was interrupted, simply retry.
	     */

	    if (errorCode == EINTR) {
		errorCode = 0;
		ReleaseChannelBuffer(bufPtr);
		continue;
	    }

	    /*
	     * If the channel is non-blocking and we would have blocked, start
	     * a background flushing handler and break out of the loop.
	     */
................................................................................
		 */

		if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED) && !TclInExit()) {
		    SetFlag(statePtr, BG_FLUSH_SCHEDULED);
		    UpdateInterest(chanPtr);
		}
		errorCode = 0;
		ReleaseChannelBuffer(bufPtr);
		break;
	    }

	    /*
	     * Decide whether to report the error upwards or defer it.
	     */

................................................................................

	    /*
	     * When we get an error we throw away all the output currently
	     * queued.
	     */

	    DiscardOutputQueued(statePtr);
	    ReleaseChannelBuffer(bufPtr);
	    continue;
	} else {
	    wroteSome = 1;
	}


	bufPtr->nextRemoved += written;


	/*
	 * If this buffer is now empty, recycle it.
	 */

	if (IsBufferEmpty(bufPtr)) {
	    statePtr->outQueueHead = bufPtr->nextPtr;
	    if (statePtr->outQueueHead == NULL) {
		statePtr->outQueueTail = NULL;
	    }
	    RecycleBuffer(statePtr, bufPtr, 0);
	}
	ReleaseChannelBuffer(bufPtr);
    }	/* Closes "while (1)". */

    /*
     * If we wrote some data while flushing in the background, we are done.
     * We can't finish the background flush until we run out of data and the
     * channel becomes writable again. This ensures that all of the pending
     * data has been flushed at the system level.
................................................................................
    DiscardInputQueued(statePtr, 1);

    /*
     * Discard a leftover buffer in the current output buffer field.
     */

    if (statePtr->curOutPtr != NULL) {
	ReleaseChannelBuffer(statePtr->curOutPtr);
	statePtr->curOutPtr = NULL;
    }

    /*
     * The caller guarantees that there are no more buffers queued for output.
     */

................................................................................
    /*
     * When the channel has an escape sequence driven encoding such as
     * iso2022, the terminated escape sequence must write to the buffer.
     */

    stickyError = 0;

    if ((statePtr->encoding != NULL)
	    && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
	    && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
	statePtr->outputEncodingFlags |= TCL_ENCODING_END;
	if (WriteChars(chanPtr, "", 0) < 0) {
	    stickyError = Tcl_GetErrno();
	}

	/*
................................................................................
    }
}
 
static int
WillRead(
    Channel *chanPtr)
{
    if (chanPtr->typePtr == NULL) {
	/* Prevent read attempts on a closed channel */
        DiscardInputQueued(chanPtr->state, 0);
	Tcl_SetErrno(EINVAL);
	return -1;
    }
    if ((chanPtr->typePtr->seekProc != NULL)
            && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
        if ((chanPtr->state->curOutPtr != NULL)
                && IsBufferReady(chanPtr->state->curOutPtr)) {
            SetFlag(chanPtr->state, BUFFER_READY);
        }
        if (FlushChannel(NULL, chanPtr, 0) != 0) {
................................................................................
	     * that we need to stick at the beginning of this buffer.
	     */

	    memcpy(InsertPoint(bufPtr), safe, (size_t) saved);
	    bufPtr->nextAdded += saved;
	    saved = 0;
	}
	PreserveChannelBuffer(bufPtr);
	dst = InsertPoint(bufPtr);
	dstLen = SpaceLeft(bufPtr);

	result = Tcl_UtfToExternal(NULL, encoding, src, srcLimit,
		statePtr->outputEncodingFlags,
		&statePtr->outputEncodingState, dst,
		dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);

	/* See chan-io-1.[89]. Tcl Bug 506297. */
	statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
	
	if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
	    /* We're reading from invalid/incomplete UTF-8 */
	    ReleaseChannelBuffer(bufPtr);
	    if (total == 0) {
		Tcl_SetErrno(EINVAL);
		return -1;
	    }
	    break;
	}

................................................................................

	if ((srcLen + saved == 0) && (result == TCL_OK)) {
	    endEncoding = 0;
	}

	if (IsBufferFull(bufPtr)) {
	    if (FlushChannel(NULL, chanPtr, 0) != 0) {
		ReleaseChannelBuffer(bufPtr);
		return -1;
	    }
	    flushed += statePtr->bufSize;
	    if (saved == 0 || src[-1] != '\n') {
		needNlFlush = 0;
	    }
	}
	ReleaseChannelBuffer(bufPtr);
    }
    if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
	    (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
	SetFlag(statePtr, BUFFER_READY);
	if (FlushChannel(NULL, chanPtr, 0) != 0) {
	    return -1;
	}
................................................................................
     */

  gotEOL:
    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */


    if (chanPtr != statePtr->topChanPtr) {
	Tcl_Release(chanPtr);
	chanPtr = statePtr->topChanPtr;

	Tcl_Preserve(chanPtr);
    }

    bufPtr = gs.bufPtr;
    if (bufPtr == NULL) {
	Tcl_Panic("Tcl_GetsObj: gotEOL reached with bufPtr==NULL");
    }
    statePtr->inputEncodingState = gs.state;
    Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead,
................................................................................
     */

  restore:
    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */

    if (chanPtr != statePtr->topChanPtr) {
	Tcl_Release(chanPtr);
	chanPtr = statePtr->topChanPtr;

	Tcl_Preserve(chanPtr);
    }
    bufPtr = statePtr->inQueueHead;
    if (bufPtr != NULL) {


	bufPtr->nextRemoved = oldRemoved;
	bufPtr = bufPtr->nextPtr;
    }

    for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
	bufPtr->nextRemoved = BUFFER_PADDING;
    }
    CommonGetsCleanup(chanPtr);

    statePtr->inputEncodingState = oldState;
    statePtr->inputEncodingFlags = oldFlags;
    Tcl_SetObjLength(objPtr, oldLength);
................................................................................
     */

  done:
    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */

    if (chanPtr != statePtr->topChanPtr) {
	Tcl_Release(chanPtr);
	chanPtr = statePtr->topChanPtr;

	Tcl_Preserve(chanPtr);
    }
    UpdateInterest(chanPtr);
    Tcl_Release(chanPtr);
    return copiedTotal;
}
 
/*
 *---------------------------------------------------------------------------
................................................................................
		}
		ResetFlag(statePtr, CHANNEL_BLOCKED);
	    }
	    if (GetInput(chanPtr) != 0) {
		goto restore;
	    }
	    bufPtr = statePtr->inQueueTail;
	    if (bufPtr == NULL) {
		goto restore;
	    }
	}

	dst = (unsigned char *) RemovePoint(bufPtr);
	dstEnd = dst + BytesLeft(bufPtr);

	/*
	 * Remember if EOF char is seen, then look for EOL anyhow, because the
................................................................................
     * Couldn't get a complete line. This only happens if we get a error
     * reading from the channel or we are non-blocking and there wasn't an EOL
     * or EOF in the data available.
     */

  restore:
    bufPtr = statePtr->inQueueHead;
    if (bufPtr) {
	bufPtr->nextRemoved = oldRemoved;
	bufPtr = bufPtr->nextPtr;
    }


    for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
	bufPtr->nextRemoved = BUFFER_PADDING;
    }
    CommonGetsCleanup(chanPtr);

    statePtr->inputEncodingFlags = oldFlags;
    byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);

................................................................................
	if (GetInput(chanPtr) != 0) {
	    gsPtr->charsWrote = 0;
	    gsPtr->rawRead = 0;
	    return -1;
	}
	bufPtr = statePtr->inQueueTail;
	gsPtr->bufPtr = bufPtr;
	if (bufPtr == NULL) {
	    gsPtr->charsWrote = 0;
	    gsPtr->rawRead = 0;
	    return -1;
	}
    }

    /*
     * Convert some of the bytes from the channel buffer to UTF-8. Space in
     * objPtr's string rep is used to hold the UTF-8 characters. Grow the
     * string rep if we need more space.
     */
................................................................................
	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
		    break;
		}
		ResetFlag(statePtr, CHANNEL_BLOCKED);
	    }
	    result = GetInput(chanPtr);
	    if (chanPtr != statePtr->topChanPtr) {
		Tcl_Release(chanPtr);
		chanPtr = statePtr->topChanPtr;
		Tcl_Preserve(chanPtr);
	    }
	    if (result != 0) {
		if (result == EAGAIN) {
		    break;
		}
		copied = -1;
		goto done;
	    }
................................................................................
     */

  done:
    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */

    if (chanPtr != statePtr->topChanPtr) {
	Tcl_Release(chanPtr);
	chanPtr = statePtr->topChanPtr;

	Tcl_Preserve(chanPtr);
    }
    UpdateInterest(chanPtr);
    Tcl_Release(chanPtr);
    return copied;
}
 
/*
 *---------------------------------------------------------------------------
................................................................................

    /*
     * If discardSavedBuffers is nonzero, must also discard any previously
     * saved buffer in the saveInBufPtr field.
     */

    if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
	ReleaseChannelBuffer(statePtr->saveInBufPtr);
	statePtr->saveInBufPtr = NULL;
    }
}
 
/*
 *---------------------------------------------------------------------------
 *
................................................................................
	 * Check the actual buffersize against the requested buffersize.
	 * Buffers which are smaller than requested are squashed. This is done
	 * to honor dynamic changes of the buffersize made by the user.
	 */

	if ((bufPtr != NULL)
		&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
	    ReleaseChannelBuffer(bufPtr);
	    bufPtr = NULL;
	}

	if (bufPtr == NULL) {
	    bufPtr = AllocChannelBuffer(statePtr->bufSize);
	}
	bufPtr->nextPtr = NULL;
................................................................................
	 */

	nread = -1;
	result = EWOULDBLOCK;
    } else
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
    {
	PreserveChannelBuffer(bufPtr);
	nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
    }

    if (nread > 0) {
	result = 0;
	bufPtr->nextAdded += nread;

	/*
	 * 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.
................................................................................
	     * [Bug 943274]: We have read the available data, clear flag.
	     */

	    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
	}
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
    } else if (nread == 0) {
	result = 0;
	SetFlag(statePtr, CHANNEL_EOF);
	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
    } else if (nread < 0) {
	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
	    SetFlag(statePtr, CHANNEL_BLOCKED);
	    result = EAGAIN;
	}
	Tcl_SetErrno(result);
    }
    ReleaseChannelBuffer(bufPtr);
    return result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Seek --
 *
................................................................................
	}

	/*
	 * When the channel has an escape sequence driven encoding such as
	 * iso2022, the terminated escape sequence must write to the buffer.
	 */

	if ((statePtr->encoding != NULL)
		&& !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
		&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
	    statePtr->outputEncodingFlags |= TCL_ENCODING_END;
	    WriteChars(chanPtr, "", 0);
	}
	Tcl_FreeEncoding(statePtr->encoding);
	statePtr->encoding = encoding;
	statePtr->inputEncodingState = NULL;
................................................................................
StackSetBlockMode(
    Channel *chanPtr,		/* Channel to modify. */
    int mode)			/* One of TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    int result = 0;
    Tcl_DriverBlockModeProc *blockModeProc;
    ChannelState *statePtr = chanPtr->state;

    /*
     * Start at the top of the channel stack
     * TODO: Examine what can go wrong when blockModeProc calls
     * disturb the stacking state of the channel.
     */

    chanPtr = statePtr->topChanPtr;
    while (chanPtr != NULL) {
	blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
	if (blockModeProc != NULL) {
	    result = blockModeProc(chanPtr->instanceData, mode);
	    if (result != 0) {
		Tcl_SetErrno(result);
		return result;

Changes to generic/tclIO.h.

32
33
34
35
36
37
38

39
40
41
42
43
44
45
/*
 * struct ChannelBuffer:
 *
 * Buffers data being sent to or from a channel.
 */

typedef struct ChannelBuffer {

    int nextAdded;		/* The next position into which a character
				 * will be put in the buffer. */
    int nextRemoved;		/* Position of next byte to be removed from
				 * the buffer. */
    int bufLength;		/* How big is the buffer? */
    struct ChannelBuffer *nextPtr;
    				/* Next buffer in chain. */






>







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
/*
 * struct ChannelBuffer:
 *
 * Buffers data being sent to or from a channel.
 */

typedef struct ChannelBuffer {
    int refCount;		/* Current uses count */
    int nextAdded;		/* The next position into which a character
				 * will be put in the buffer. */
    int nextRemoved;		/* Position of next byte to be removed from
				 * the buffer. */
    int bufLength;		/* How big is the buffer? */
    struct ChannelBuffer *nextPtr;
    				/* Next buffer in chain. */

Changes to generic/tclIOCmd.c.

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
...
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
...
295
296
297
298
299
300
301

302
303
304
305
306
307
308
...
311
312
313
314
315
316
317

318
319
320
321
322
323
324
...
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
...
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
...
481
482
483
484
485
486
487

488
489
490
491
492
493
494
...
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
...
586
587
588
589
590
591
592

593
594
595
596
597
598
599
...
601
602
603
604
605
606
607

608
609
610
611
612
613
614
615

616


617
618
619
620
621
622
623
    if (!(mode & TCL_WRITABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for writing",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }


    result = Tcl_WriteObj(chan, string);
    if (result < 0) {
	goto error;
    }
    if (newline != 0) {
	result = Tcl_WriteChars(chan, "\n", 1);
	if (result < 0) {
	    goto error;
	}
    }

    return TCL_OK;

    /*
     * 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.
................................................................................
     */

  error:
    if (!TclChanCaughtErrorBypass(interp, chan)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
		TclGetString(chanObjPtr), Tcl_PosixError(interp)));
    }

    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_FlushObjCmd --
................................................................................
    if (!(mode & TCL_WRITABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for writing",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }


    if (Tcl_Flush(chan) != TCL_OK) {
	/*
	 * 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.
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error flushing \"%s\": %s",
		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	}

	return TCL_ERROR;
    }

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetsObjCmd --
................................................................................
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    int lineLen;		/* Length of line just read. */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *linePtr, *chanObjPtr;


    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
	return TCL_ERROR;
    }
    chanObjPtr = objv[1];
    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
................................................................................
    if (!(mode & TCL_READABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for reading",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }


    linePtr = Tcl_NewObj();
    lineLen = Tcl_GetsObj(chan, linePtr);
    if (lineLen < 0) {
	if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
	    Tcl_DecrRefCount(linePtr);

	    /*
................................................................................
	     */

	    if (!TclChanCaughtErrorBypass(interp, chan)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading \"%s\": %s",
			TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;

	}
	lineLen = -1;
    }
    if (objc == 3) {
	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;

	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
    } else {
	Tcl_SetObjResult(interp, linePtr);
    }


    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ReadObjCmd --
 *
................................................................................
	    newline = 1;
#endif
	}
    }

    resultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(resultPtr);

    charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
    if (charactersRead < 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.
................................................................................
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error reading \"%s\": %s",
		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	}

	Tcl_DecrRefCount(resultPtr);
	return TCL_ERROR;
    }

    /*
     * If requested, remove the last newline in the channel if at EOF.
     */
................................................................................

	result = TclGetStringFromObj(resultPtr, &length);
	if (result[length - 1] == '\n') {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);

    Tcl_DecrRefCount(resultPtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0,
		&optionIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	mode = modeArray[optionIndex];
    }


    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.
................................................................................
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error during seek on \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	}

	return TCL_ERROR;
    }

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_TellObjCmd --
................................................................................
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to tell on. */
    Tcl_WideInt newLoc;


    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
	return TCL_ERROR;
    }

    /*
................................................................................
     * channel table of this interpreter.
     */

    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
	return TCL_ERROR;
    }


    newLoc = Tcl_Tell(chan);

    /*
     * TIP #219.
     * Capture error messages put by the driver into the bypass area and put
     * them into the regular interpreter result.
     */


    if (TclChanCaughtErrorBypass(interp, chan)) {


	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(newLoc));
    return TCL_OK;
}
 






>










>







 







>







 







>













>


>







 







>







 







>







 







|
>






|
>





>
>
|







 







>







 







>







 







>







 







>







 







>


>







 







>







 







>








>
|
>
>







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
...
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
...
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
...
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
...
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
...
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
...
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
...
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
...
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
...
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
    if (!(mode & TCL_WRITABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for writing",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    Tcl_Preserve(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;
	}
    }
    Tcl_Release(chan);
    return TCL_OK;

    /*
     * 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.
................................................................................
     */

  error:
    if (!TclChanCaughtErrorBypass(interp, chan)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
		TclGetString(chanObjPtr), Tcl_PosixError(interp)));
    }
    Tcl_Release(chan);
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_FlushObjCmd --
................................................................................
    if (!(mode & TCL_WRITABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for writing",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    Tcl_Preserve(chan);
    if (Tcl_Flush(chan) != TCL_OK) {
	/*
	 * 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.
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error flushing \"%s\": %s",
		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	}
	Tcl_Release(chan);
	return TCL_ERROR;
    }
    Tcl_Release(chan);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetsObjCmd --
................................................................................
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    int lineLen;		/* Length of line just read. */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *linePtr, *chanObjPtr;
    int code = TCL_OK;

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
	return TCL_ERROR;
    }
    chanObjPtr = objv[1];
    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
................................................................................
    if (!(mode & TCL_READABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for reading",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    Tcl_Preserve(chan);
    linePtr = Tcl_NewObj();
    lineLen = Tcl_GetsObj(chan, linePtr);
    if (lineLen < 0) {
	if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
	    Tcl_DecrRefCount(linePtr);

	    /*
................................................................................
	     */

	    if (!TclChanCaughtErrorBypass(interp, chan)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading \"%s\": %s",
			TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	    }
	    code = TCL_ERROR;
	    goto done;
	}
	lineLen = -1;
    }
    if (objc == 3) {
	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    code = TCL_ERROR;
	    goto done;
	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
    } else {
	Tcl_SetObjResult(interp, linePtr);
    }
  done:
    Tcl_Release(chan);
    return code;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ReadObjCmd --
 *
................................................................................
	    newline = 1;
#endif
	}
    }

    resultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(resultPtr);
    Tcl_Preserve(chan);
    charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
    if (charactersRead < 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.
................................................................................
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error reading \"%s\": %s",
		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	}
	Tcl_Release(chan);
	Tcl_DecrRefCount(resultPtr);
	return TCL_ERROR;
    }

    /*
     * If requested, remove the last newline in the channel if at EOF.
     */
................................................................................

	result = TclGetStringFromObj(resultPtr, &length);
	if (result[length - 1] == '\n') {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    Tcl_Release(chan);
    Tcl_DecrRefCount(resultPtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0,
		&optionIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	mode = modeArray[optionIndex];
    }

    Tcl_Preserve(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.
................................................................................
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error during seek on \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	}
	Tcl_Release(chan);
	return TCL_ERROR;
    }
    Tcl_Release(chan);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_TellObjCmd --
................................................................................
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to tell on. */
    Tcl_WideInt newLoc;
    int code;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
	return TCL_ERROR;
    }

    /*
................................................................................
     * channel table of this interpreter.
     */

    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_Preserve(chan);
    newLoc = Tcl_Tell(chan);

    /*
     * TIP #219.
     * Capture error messages put by the driver into the bypass area and put
     * them into the regular interpreter result.
     */


    code  = TclChanCaughtErrorBypass(interp, chan);
    Tcl_Release(chan);
    if (code) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(newLoc));
    return TCL_OK;
}
 

Changes to generic/tclIOGT.c.

206
207
208
209
210
211
212

213



















214
215
216
217
218
219
220
...
236
237
238
239
240
241
242

243
244
245
246
247
248






249
250
251
252
253
254
255
...
257
258
259
260
261
262
263

264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
...
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
...
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
...
531
532
533
534
535
536
537

538
539
540
541
542
543
544
...
550
551
552
553
554
555
556

557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
...
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608

609
610
611
612
613
614
615
...
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
...
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
...
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
...
759
760
761
762
763
764
765

766
767
768
769
770

771
772
773
774
775
776
777
...
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
...
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
....
1052
1053
1054
1055
1056
1057
1058



1059
1060
1061
1062
1063
1064
1065
				 * the transformation. Used to execute the
				 * code below. */
    Tcl_Obj *command;		/* Tcl code to execute for a buffer */
    ResultBuffer result;	/* Internal buffer used to store the result of
				 * a transformation of incoming data. Also
				 * serves as buffer of all data not yet
				 * consumed by the reader. */

};



















 
/*
 *----------------------------------------------------------------------
 *
 * TclChannelTransform --
 *
 *	Implements the Tcl "testchannel transform" debugging command. This is
................................................................................
    Tcl_Interp *interp,		/* Interpreter for result. */
    Tcl_Channel chan,		/* Channel to transform. */
    Tcl_Obj *cmdObjPtr)		/* Script to use for transform. */
{
    Channel *chanPtr;		/* The actual channel. */
    ChannelState *statePtr;	/* State info for channel. */
    int mode;			/* Read/write mode of the channel. */

    TransformChannelData *dataPtr;
    Tcl_DString ds;

    if (chan == NULL) {
	return TCL_ERROR;
    }







    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;
    chanPtr = statePtr->topChanPtr;
    chan = (Tcl_Channel) chanPtr;
    mode = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));

................................................................................
     * 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));


    Tcl_DStringInit(&ds);
    Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
    dataPtr->readIsFlushed = 0;
    dataPtr->flags = 0;
    if (ds.string[0] == '0') {
	dataPtr->flags |= CHANNEL_ASYNC;
    }
    Tcl_DStringFree(&ds);

    dataPtr->self = chan;
    dataPtr->watchMask = 0;
    dataPtr->mode = mode;
    dataPtr->timer = NULL;
    dataPtr->maxRead = 4096;	/* Initial value not relevant. */
    dataPtr->interp = interp;
    dataPtr->command = cmdObjPtr;
    Tcl_IncrRefCount(dataPtr->command);
................................................................................
    ResultInit(&dataPtr->result);

    dataPtr->self = Tcl_StackChannel(interp, &transformChannelType, dataPtr,
	    mode, chan);
    if (dataPtr->self == NULL) {
	Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
		"\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));
	Tcl_DecrRefCount(dataPtr->command);
	ResultClear(&dataPtr->result);
	ckfree(dataPtr);
	return TCL_ERROR;
    }


    /*
     * At last initialize the transformation at the script level.
     */


    if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
	    A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
	Tcl_UnstackChannel(interp, chan);

	return TCL_ERROR;
    }

    if ((dataPtr->mode & TCL_READABLE) && ExecuteCallback(dataPtr, NULL,
	    A_CREATE_READ, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK) {
	ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
		P_NO_PRESERVE);
	Tcl_UnstackChannel(interp, chan);

	return TCL_ERROR;
    }


    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * ExecuteCallback --
................................................................................
				 * interpreters. */
{
    Tcl_Obj *resObj;		/* See below, switch (transmit). */
    int resLen;
    unsigned char *resBuf;
    Tcl_InterpState state = NULL;
    int res = TCL_OK;
    Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);




    /*
     * Step 1, create the complete command to execute. Do this by appending
     * operation and buffer to operate upon to a copy of the callback
     * definition. We *cannot* create a list containing 3 objects and then use
     * 'Tcl_EvalObjv', because the command may contain additional prefixed
     * arguments. Feather's curried commands would come in handy here.
     */

    if (preserve == P_PRESERVE) {
	state = Tcl_SaveInterpState(dataPtr->interp, res);
    }

    Tcl_IncrRefCount(command);
    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
	    Tcl_NewStringObj((char *) op, -1));
    if (res != TCL_OK) {
	goto cleanup;
    }

    /*
     * Use a byte-array to prevent the misinterpretation of binary data coming
     * through as UTF while at the tcl level.
     */

    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
	    Tcl_NewByteArrayObj(buf, bufLen));
    if (res != TCL_OK) {
	goto cleanup;
    }

    /*
     * Step 2, execute the command at the global level of the interpreter used
     * to create the transformation. Destroy the command afterward. If an
     * error occured and the current interpreter is defined and not equal to
     * the interpreter for the callback, then copy the error message into
     * current interpreter. Don't copy if in preservation mode.
     */

    res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount(command);
    command = NULL;

    if ((res != TCL_OK) && (interp != NULL) && (dataPtr->interp != interp)
	    && (preserve == P_NO_PRESERVE)) {
	Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));

	return res;
    }

    /*
     * Step 3, transmit a possible conversion result to the underlying
     * channel, or ourselves.
     */
................................................................................

    switch (transmit) {
    case TRANSMIT_DONT:
	/* nothing to do */
	break;

    case TRANSMIT_DOWN:



	resObj = Tcl_GetObjResult(dataPtr->interp);
	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
	Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
		resLen);
	break;

    case TRANSMIT_SELF:



	resObj = Tcl_GetObjResult(dataPtr->interp);
	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
	break;

    case TRANSMIT_IBUF:
	resObj = Tcl_GetObjResult(dataPtr->interp);
	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
	ResultAdd(&dataPtr->result, resBuf, resLen);
	break;

    case TRANSMIT_NUM:
	/*
	 * Interpret result as integer number.
	 */

	resObj = Tcl_GetObjResult(dataPtr->interp);
	TclGetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
	break;
    }

    Tcl_ResetResult(dataPtr->interp);
    if (preserve == P_PRESERVE) {
	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
    }
    return res;

  cleanup:
    if (preserve == P_PRESERVE) {
	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
    }
    if (command != NULL) {
	Tcl_DecrRefCount(command);
    }
    return res;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TransformBlockModeProc --
................................................................................
    /*
     * Now flush data waiting in internal buffers to output and input. The
     * input must be done despite the fact that there is no real receiver for
     * it anymore. But the scripts might have sideeffects other parts of the
     * system rely on (f.e. signaling the close to interested parties).
     */


    if (dataPtr->mode & TCL_WRITABLE) {
	ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
		TRANSMIT_DOWN, P_PRESERVE);
    }

    if ((dataPtr->mode & TCL_READABLE) && !dataPtr->readIsFlushed) {
	dataPtr->readIsFlushed = 1;
................................................................................
	ExecuteCallback(dataPtr, interp, A_DELETE_WRITE, NULL, 0,
		TRANSMIT_DONT, P_PRESERVE);
    }
    if (dataPtr->mode & TCL_READABLE) {
	ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
		TRANSMIT_DONT, P_PRESERVE);
    }


    /*
     * General cleanup.
     */

    ResultClear(&dataPtr->result);
    Tcl_DecrRefCount(dataPtr->command);
    ckfree(dataPtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TransformInputProc --
................................................................................
    int gotBytes, read, copied;
    Tcl_Channel downChan;

    /*
     * Should assert(dataPtr->mode & TCL_READABLE);
     */

    if (toRead == 0) {
	/*
	 * Catch a no-op.
	 */
	return 0;
    }

    gotBytes = 0;
    downChan = Tcl_GetStackedChannel(dataPtr->self);


    while (toRead > 0) {
	/*
	 * Loop until the request is satisfied (or no data is available from
	 * below, possibly EOF).
	 */

	copied = ResultCopy(&dataPtr->result, UCHARP(buf), toRead);
................................................................................

	if (toRead == 0) {
	    /*
	     * The request was completely satisfied from our buffers. We can
	     * break out of the loop and return to the caller.
	     */

	    return gotBytes;
	}

	/*
	 * Length (dataPtr->result) == 0, toRead > 0 here. Use the incoming
	 * 'buf'! as target to store the intermediary information read from
	 * the underlying channel.
	 *
................................................................................

	if (dataPtr->maxRead >= 0) {
	    if (dataPtr->maxRead < toRead) {
		toRead = dataPtr->maxRead;
	    }
	} /* else: 'maxRead < 0' == Accept the current value of toRead. */
	if (toRead <= 0) {
	    return gotBytes;
	}

	/*
	 * Get bytes from the underlying channel.
	 */

	read = Tcl_ReadRaw(downChan, buf, toRead);
................................................................................
	     * Report errors to caller. EAGAIN is a special situation. If we
	     * had some data before we report that instead of the request to
	     * re-try.
	     */
		int error = Tcl_GetErrno();

	    if ((error == EAGAIN) && (gotBytes > 0)) {
		return gotBytes;
	    }

	    *errorCodePtr = error;
	    return -1;

	} else if (read == 0) {
	    /*
	     * Check wether we hit on EOF in the underlying channel or not. If
	     * not differentiate between blocking and non-blocking modes. In
	     * non-blocking mode we ran temporarily out of data. Signal this
	     * to the caller via EWOULDBLOCK and error return (-1). In the
	     * other cases we simply return what we got and let the caller
................................................................................
	     * wait for more. On the other hand, if we got an EOF we have to
	     * convert and flush all waiting partial data.
	     */

	    if (!Tcl_Eof(downChan)) {
		if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
		    *errorCodePtr = EWOULDBLOCK;
		    return -1;
		}
		return gotBytes;
	    }

	    if (dataPtr->readIsFlushed) {
		/*
		 * Already flushed, nothing to do anymore.
		 */

		return gotBytes;
	    }

	    dataPtr->readIsFlushed = 1;
	    ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
		    TRANSMIT_IBUF, P_PRESERVE);

	    if (ResultEmpty(&dataPtr->result)) {
		/*
		 * We had nothing to flush.
		 */

		return gotBytes;
	    }

	    continue;		/* at: while (toRead > 0) */
	} /* read == 0 */

	/*
	 * Transform the read chunk and add the result to our read buffer
	 * (dataPtr->result).
	 */

	if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
		TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
	    *errorCodePtr = EINVAL;
	    return -1;

	}
    } /* while toRead > 0 */


    return gotBytes;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	/*
	 * Catch a no-op.
	 */

	return 0;
    }


    if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
	    TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
	*errorCodePtr = EINVAL;
	return -1;
    }


    return toWrite;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

    /*
     * 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.
     */


    if (dataPtr->mode & TCL_WRITABLE) {
	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
		P_NO_PRESERVE);
    }

    if (dataPtr->mode & TCL_READABLE) {
	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
		P_NO_PRESERVE);
	ResultClear(&dataPtr->result);
	dataPtr->readIsFlushed = 0;
    }


    return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, 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.
     */


    if (dataPtr->mode & TCL_WRITABLE) {
	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
		P_NO_PRESERVE);
    }

    if (dataPtr->mode & TCL_READABLE) {
	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
		P_NO_PRESERVE);
	ResultClear(&dataPtr->result);
	dataPtr->readIsFlushed = 0;
    }


    /*
     * If we have a wide seek capability, we should stick with that.
     */

    if (parentWideSeekProc != NULL) {
	return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
................................................................................
     * events on the channel below via a call to our 'TransformNotifyProc'.
     * But we have to pass the interest down now. We are allowed to add
     * additional 'interest' to the mask if we want to. But this
     * transformation has no such interest. It just passes the request down,
     * unchanged.
     */




    downChan = Tcl_GetStackedChannel(dataPtr->self);

    Tcl_GetChannelType(downChan)->watchProc(
	    Tcl_GetChannelInstanceData(downChan), mask);

    /*
     * Management of the internal timer.






>

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







 







>






>
>
>
>
>
>







 







>









<







 







<
<
|


>





>



>








>



>







 







|
>
>
>










|



<
|
<
<
<






<
|
<
<
<









|



|

|
>







 







>
>
>
|






>
>
>
|





|









|
|



|

|

|
<
<
<
<
<
<
<
<







 







>







 







>





|
|
|







 







|









>







 







|







 







|







 







|



|
>







 







|

|







|











|













|
>


>







 







>



|

>







 







>











>







 







>











>







 







>
>
>







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
...
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
...
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300

301
302
303
304
305
306
307
...
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
...
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
...
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
...
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
...
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
...
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
...
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
...
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
...
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
...
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
...
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
....
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
				 * the transformation. Used to execute the
				 * code below. */
    Tcl_Obj *command;		/* Tcl code to execute for a buffer */
    ResultBuffer result;	/* Internal buffer used to store the result of
				 * a transformation of incoming data. Also
				 * serves as buffer of all data not yet
				 * consumed by the reader. */
    int refCount;
};

static void
PreserveData(
    TransformChannelData *dataPtr)
{
    dataPtr->refCount++;
}

static void
ReleaseData(
    TransformChannelData *dataPtr)
{
    if (--dataPtr->refCount) {
	return;
    }
    ResultClear(&dataPtr->result);
    Tcl_DecrRefCount(dataPtr->command);
    ckfree(dataPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclChannelTransform --
 *
 *	Implements the Tcl "testchannel transform" debugging command. This is
................................................................................
    Tcl_Interp *interp,		/* Interpreter for result. */
    Tcl_Channel chan,		/* Channel to transform. */
    Tcl_Obj *cmdObjPtr)		/* Script to use for transform. */
{
    Channel *chanPtr;		/* The actual channel. */
    ChannelState *statePtr;	/* State info for channel. */
    int mode;			/* Read/write mode of the channel. */
    int objc;
    TransformChannelData *dataPtr;
    Tcl_DString ds;

    if (chan == NULL) {
	return TCL_ERROR;
    }

    if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("-command value is not a list", -1));
	return TCL_ERROR;
    }

    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;
    chanPtr = statePtr->topChanPtr;
    chan = (Tcl_Channel) chanPtr;
    mode = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));

................................................................................
     * 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->flags = 0;
    if (ds.string[0] == '0') {
	dataPtr->flags |= CHANNEL_ASYNC;
    }
    Tcl_DStringFree(&ds);


    dataPtr->watchMask = 0;
    dataPtr->mode = mode;
    dataPtr->timer = NULL;
    dataPtr->maxRead = 4096;	/* Initial value not relevant. */
    dataPtr->interp = interp;
    dataPtr->command = cmdObjPtr;
    Tcl_IncrRefCount(dataPtr->command);
................................................................................
    ResultInit(&dataPtr->result);

    dataPtr->self = Tcl_StackChannel(interp, &transformChannelType, dataPtr,
	    mode, chan);
    if (dataPtr->self == NULL) {
	Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
		"\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));


	ReleaseData(dataPtr);
	return TCL_ERROR;
    }
    Tcl_Preserve(dataPtr->self);

    /*
     * At last initialize the transformation at the script level.
     */

    PreserveData(dataPtr);
    if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
	    A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
	Tcl_UnstackChannel(interp, chan);
	ReleaseData(dataPtr);
	return TCL_ERROR;
    }

    if ((dataPtr->mode & TCL_READABLE) && ExecuteCallback(dataPtr, NULL,
	    A_CREATE_READ, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK) {
	ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
		P_NO_PRESERVE);
	Tcl_UnstackChannel(interp, chan);
	ReleaseData(dataPtr);
	return TCL_ERROR;
    }

    ReleaseData(dataPtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * ExecuteCallback --
................................................................................
				 * interpreters. */
{
    Tcl_Obj *resObj;		/* See below, switch (transmit). */
    int resLen;
    unsigned char *resBuf;
    Tcl_InterpState state = NULL;
    int res = TCL_OK;
    Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
    Tcl_Interp *eval = dataPtr->interp;

    Tcl_Preserve(eval);

    /*
     * Step 1, create the complete command to execute. Do this by appending
     * operation and buffer to operate upon to a copy of the callback
     * definition. We *cannot* create a list containing 3 objects and then use
     * 'Tcl_EvalObjv', because the command may contain additional prefixed
     * arguments. Feather's curried commands would come in handy here.
     */

    if (preserve == P_PRESERVE) {
	state = Tcl_SaveInterpState(eval, res);
    }

    Tcl_IncrRefCount(command);

    Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));




    /*
     * Use a byte-array to prevent the misinterpretation of binary data coming
     * through as UTF while at the tcl level.
     */


    Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));




    /*
     * Step 2, execute the command at the global level of the interpreter used
     * to create the transformation. Destroy the command afterward. If an
     * error occured and the current interpreter is defined and not equal to
     * the interpreter for the callback, then copy the error message into
     * current interpreter. Don't copy if in preservation mode.
     */

    res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount(command);
    command = NULL;

    if ((res != TCL_OK) && (interp != NULL) && (eval != interp)
	    && (preserve == P_NO_PRESERVE)) {
	Tcl_SetObjResult(interp, Tcl_GetObjResult(eval));
	Tcl_Release(eval);
	return res;
    }

    /*
     * Step 3, transmit a possible conversion result to the underlying
     * channel, or ourselves.
     */
................................................................................

    switch (transmit) {
    case TRANSMIT_DONT:
	/* nothing to do */
	break;

    case TRANSMIT_DOWN:
	if (dataPtr->self == NULL) {
	    break;
	}
	resObj = Tcl_GetObjResult(eval);
	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
	Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
		resLen);
	break;

    case TRANSMIT_SELF:
	if (dataPtr->self == NULL) {
	    break;
	}
	resObj = Tcl_GetObjResult(eval);
	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
	break;

    case TRANSMIT_IBUF:
	resObj = Tcl_GetObjResult(eval);
	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
	ResultAdd(&dataPtr->result, resBuf, resLen);
	break;

    case TRANSMIT_NUM:
	/*
	 * Interpret result as integer number.
	 */

	resObj = Tcl_GetObjResult(eval);
	TclGetIntFromObj(eval, resObj, &dataPtr->maxRead);
	break;
    }

    Tcl_ResetResult(eval);
    if (preserve == P_PRESERVE) {
	(void) Tcl_RestoreInterpState(eval, state);
    }
    Tcl_Release(eval);








    return res;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TransformBlockModeProc --
................................................................................
    /*
     * Now flush data waiting in internal buffers to output and input. The
     * input must be done despite the fact that there is no real receiver for
     * it anymore. But the scripts might have sideeffects other parts of the
     * system rely on (f.e. signaling the close to interested parties).
     */

    PreserveData(dataPtr);
    if (dataPtr->mode & TCL_WRITABLE) {
	ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
		TRANSMIT_DOWN, P_PRESERVE);
    }

    if ((dataPtr->mode & TCL_READABLE) && !dataPtr->readIsFlushed) {
	dataPtr->readIsFlushed = 1;
................................................................................
	ExecuteCallback(dataPtr, interp, A_DELETE_WRITE, NULL, 0,
		TRANSMIT_DONT, P_PRESERVE);
    }
    if (dataPtr->mode & TCL_READABLE) {
	ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
		TRANSMIT_DONT, P_PRESERVE);
    }
    ReleaseData(dataPtr);

    /*
     * General cleanup.
     */

    Tcl_Release(dataPtr->self);
    dataPtr->self = NULL;
    ReleaseData(dataPtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TransformInputProc --
................................................................................
    int gotBytes, read, copied;
    Tcl_Channel downChan;

    /*
     * Should assert(dataPtr->mode & TCL_READABLE);
     */

    if (toRead == 0 || dataPtr->self == NULL) {
	/*
	 * Catch a no-op.
	 */
	return 0;
    }

    gotBytes = 0;
    downChan = Tcl_GetStackedChannel(dataPtr->self);

    PreserveData(dataPtr);
    while (toRead > 0) {
	/*
	 * Loop until the request is satisfied (or no data is available from
	 * below, possibly EOF).
	 */

	copied = ResultCopy(&dataPtr->result, UCHARP(buf), toRead);
................................................................................

	if (toRead == 0) {
	    /*
	     * The request was completely satisfied from our buffers. We can
	     * break out of the loop and return to the caller.
	     */

	    break;
	}

	/*
	 * Length (dataPtr->result) == 0, toRead > 0 here. Use the incoming
	 * 'buf'! as target to store the intermediary information read from
	 * the underlying channel.
	 *
................................................................................

	if (dataPtr->maxRead >= 0) {
	    if (dataPtr->maxRead < toRead) {
		toRead = dataPtr->maxRead;
	    }
	} /* else: 'maxRead < 0' == Accept the current value of toRead. */
	if (toRead <= 0) {
	    break;
	}

	/*
	 * Get bytes from the underlying channel.
	 */

	read = Tcl_ReadRaw(downChan, buf, toRead);
................................................................................
	     * Report errors to caller. EAGAIN is a special situation. If we
	     * had some data before we report that instead of the request to
	     * re-try.
	     */
		int error = Tcl_GetErrno();

	    if ((error == EAGAIN) && (gotBytes > 0)) {
		break;
	    }

	    *errorCodePtr = error;
	    gotBytes = -1;
	    break;
	} else if (read == 0) {
	    /*
	     * Check wether we hit on EOF in the underlying channel or not. If
	     * not differentiate between blocking and non-blocking modes. In
	     * non-blocking mode we ran temporarily out of data. Signal this
	     * to the caller via EWOULDBLOCK and error return (-1). In the
	     * other cases we simply return what we got and let the caller
................................................................................
	     * wait for more. On the other hand, if we got an EOF we have to
	     * convert and flush all waiting partial data.
	     */

	    if (!Tcl_Eof(downChan)) {
		if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
		    *errorCodePtr = EWOULDBLOCK;
		    gotBytes = -1;
		}
		break;
	    }

	    if (dataPtr->readIsFlushed) {
		/*
		 * Already flushed, nothing to do anymore.
		 */

		break;
	    }

	    dataPtr->readIsFlushed = 1;
	    ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
		    TRANSMIT_IBUF, P_PRESERVE);

	    if (ResultEmpty(&dataPtr->result)) {
		/*
		 * We had nothing to flush.
		 */

		break;
	    }

	    continue;		/* at: while (toRead > 0) */
	} /* read == 0 */

	/*
	 * Transform the read chunk and add the result to our read buffer
	 * (dataPtr->result).
	 */

	if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
		TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
	    *errorCodePtr = EINVAL;
	    gotBytes = -1;
	    break;
	}
    } /* while toRead > 0 */
    ReleaseData(dataPtr);

    return gotBytes;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	/*
	 * Catch a no-op.
	 */

	return 0;
    }

    PreserveData(dataPtr);
    if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
	    TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
	*errorCodePtr = EINVAL;
	toWrite = -1;
    }
    ReleaseData(dataPtr);

    return toWrite;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

    /*
     * 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.
     */

    PreserveData(dataPtr);
    if (dataPtr->mode & TCL_WRITABLE) {
	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
		P_NO_PRESERVE);
    }

    if (dataPtr->mode & TCL_READABLE) {
	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
		P_NO_PRESERVE);
	ResultClear(&dataPtr->result);
	dataPtr->readIsFlushed = 0;
    }
    ReleaseData(dataPtr);

    return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, 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.
     */

    PreserveData(dataPtr);
    if (dataPtr->mode & TCL_WRITABLE) {
	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
		P_NO_PRESERVE);
    }

    if (dataPtr->mode & TCL_READABLE) {
	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
		P_NO_PRESERVE);
	ResultClear(&dataPtr->result);
	dataPtr->readIsFlushed = 0;
    }
    ReleaseData(dataPtr);

    /*
     * If we have a wide seek capability, we should stick with that.
     */

    if (parentWideSeekProc != NULL) {
	return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
................................................................................
     * events on the channel below via a call to our 'TransformNotifyProc'.
     * But we have to pass the interest down now. We are allowed to add
     * additional 'interest' to the mask if we want to. But this
     * transformation has no such interest. It just passes the request down,
     * unchanged.
     */

    if (dataPtr->self == NULL) {
	return;
    }
    downChan = Tcl_GetStackedChannel(dataPtr->self);

    Tcl_GetChannelType(downChan)->watchProc(
	    Tcl_GetChannelInstanceData(downChan), mask);

    /*
     * Management of the internal timer.

Changes to generic/tclIORChan.c.

96
97
98
99
100
101
102
103
104
105
106
107
108

109
110
111
112
113
114
115
...
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
...
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
...
661
662
663
664
665
666
667
668




669
670
671
672
673
674
675
...
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
....
1116
1117
1118
1119
1120
1121
1122

1123
1124
1125
1126
1127
1128
1129
....
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
....
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
....
1231
1232
1233
1234
1235
1236
1237





1238
1239
1240
1241
1242
1243
1244
....
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
....
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
....
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
....
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
....
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
....
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
....
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
....
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
....
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
....
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
....
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
....
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
....
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224


2225
2226
2227
2228
2229
2230
2231
....
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
....
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
....
2359
2360
2361
2362
2363
2364
2365
2366

2367
2368
2369
2370
2371
2372
2373
....
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926


2927
2928
2929
2930
2931
2932
2933
2934
....
2944
2945
2946
2947
2948
2949
2950






2951

2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
....
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
....
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
....
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
....
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
....
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
....
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
				 * command is gone.
				 */
#ifdef TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. == Handler thread */
    Tcl_ThreadId owner;         /* Thread owning the structure.    == Channel thread */
#endif
    Tcl_Obj *cmd;		/* Callback command prefix */
    int methods;		/* Bitmask of supported methods */

    /*
     * NOTE (9): Should we have predefined shared literals for the method
     * names?
     */


    int mode;			/* Mask of R/W mode */
    int interest;		/* Mask of events the channel is interested
				 * in. */

    int dead;			/* Boolean signal that some operations
				 * should no longer be attempted. */
................................................................................
			    const char *objName, Tcl_Obj *obj, int *mask);
static Tcl_Obj *	DecodeEventMask(int mask);
static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
			    Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj);
static Tcl_Obj *	NextHandle(void);
static void		FreeReflectedChannel(ReflectedChannel *rcPtr);
static int		InvokeTclMethod(ReflectedChannel *rcPtr,
			    const char *method, Tcl_Obj *argOneObj,
			    Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);

static ReflectedChannelMap *	GetReflectedChannelMap(Tcl_Interp *interp);
static void		DeleteReflectedChannelMap(ClientData clientData,
			    Tcl_Interp *interp);
static int		ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);

................................................................................
/*
 * Global constant strings (messages). ==================
 * These string are used directly as bypass errors, thus they have to be valid
 * Tcl lists where the last element is the message itself. Hence the
 * list-quoting to keep the words of the message together. See also [x].
 */

static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_read_toomuch = "{read delivered more than requested}";
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#ifdef TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
static const char *msg_send_dstlost    = "{Owner lost}";
#endif /* TCL_THREADS */
................................................................................

    /*
     * Now create the channel.
     */

    rcId = NextHandle();
    rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
    chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
	    mode);
    rcPtr->chan = chan;
    Tcl_Preserve(chan);
    chanPtr = (Channel *) chan;

    /*
     * Invoke 'initialize' and validate that the handler is present and ok.
     * Squash the channel if not.
     *
     * Note: The conversion of 'mode' back into a Tcl_Obj ensures that
     * 'initialize' is invoked with canonical mode names, and no
     * abbreviations. Using modeObj directly could feed abbreviations into the
     * handler, and the handler is not specified to handle such.
     */

    modeObj = DecodeEventMask(mode);
    /* assert modeObj.refCount == 1 */
    result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj);
    Tcl_DecrRefCount(modeObj);

    if (result != TCL_OK) {
	UnmarshallErrorResult(interp, resObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	goto error;
    }
................................................................................

    Tcl_ResetResult(interp);

    /*
     * Everything is fine now.
     */

    rcPtr->methods = methods;





    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_SetObjResult(interp,
            Tcl_NewStringObj(chanPtr->state->channelName, -1));
    return TCL_OK;

  error:
    /*
     * Signal to ReflectClose to not call 'finalize'.
     */

    rcPtr->methods = 0;
    Tcl_Close(interp, chan);
    return TCL_ERROR;

#undef MODE
#undef CMD
}
 
/*
................................................................................
{
    ReflectedChannel *rcPtr = clientData;
    int result;			/* Result code for 'close' */
    Tcl_Obj *resObj;		/* Result data for 'close' */
    ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
				 * this interp */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */


    if (TclInThreadExit()) {
	/*
	 * This call comes from TclFinalizeIOSystem. There are no
	 * interpreters, and therefore we cannot call upon the handler command
	 * anymore. Threading is irrelevant as well. We simply clean up all
	 * our C level data structures and leave the Tcl level to the other
................................................................................
             */

            Tcl_DeleteEvents(ReflectEventDelete, rcPtr);

	    if (result != TCL_OK) {
		FreeReceivedError(&p);
	    }

	}
#endif

        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	return EOK;


    }

    /*
     * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL)
     *
     * A cleaned method mask here implies that the channel creation was
     * aborted, and "finalize" must not be called.
     */

    if (rcPtr->methods == 0) {
        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	return EOK;
    }

    /*
     * Are we in the correct thread?
     */
................................................................................

        /*
         * Now squash the pending reflection events for this channel.
         */

        Tcl_DeleteEvents(ReflectEventDelete, rcPtr);

        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);

	if (result != TCL_OK) {
	    PassReceivedErrorInterp(interp, &p);
	}
    } else {
#endif
	result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj);
	if ((result != TCL_OK) && (interp != NULL)) {
	    Tcl_SetChannelErrorInterp(interp, resObj);
	}

	Tcl_DecrRefCount(resObj);	/* Remove reference we held from the
					 * invoke */

................................................................................
	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
		Tcl_GetChannelName(rcPtr->chan));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
#endif






        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
#ifdef TCL_THREADS
    }
#endif
    return (result == TCL_OK) ? EOK : EINVAL;
}
 
................................................................................
{
    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' */

    /*
     * The following check can be done before thread redirection, because we
     * are reading from an item which is readonly, i.e. will never change
     * during the lifetime of the channel.
     */

    if (!(rcPtr->methods & FLAG(METH_READ))) {
	SetChannelErrorStr(rcPtr->chan, msg_read_unsup);
	*errorCodePtr = EINVAL;
	return -1;
    }

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;
................................................................................
    /* ASSERT: rcPtr->mode & TCL_READABLE */

    Tcl_Preserve(rcPtr);

    toReadObj = Tcl_NewIntObj(toRead);
    Tcl_IncrRefCount(toReadObj);

    if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) {
	int code = ErrnoReturn(rcPtr, resObj);

	if (code < 0) {
	    *errorCodePtr = -code;
            goto error;
	}

................................................................................
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = clientData;
    Tcl_Obj *bufObj;
    Tcl_Obj *resObj;		/* Result data for 'write' */
    int written;

    /*
     * The following check can be done before thread redirection, because we
     * are reading from an item which is readonly, i.e. will never change
     * during the lifetime of the channel.
     */

    if (!(rcPtr->methods & FLAG(METH_WRITE))) {
	SetChannelErrorStr(rcPtr->chan, msg_write_unsup);
	*errorCodePtr = EINVAL;
	return -1;
    }

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;
................................................................................
    /* ASSERT: rcPtr->mode & TCL_WRITABLE */

    Tcl_Preserve(rcPtr);

    bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
    Tcl_IncrRefCount(bufObj);

    if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
	int code = ErrnoReturn(rcPtr, resObj);

	if (code < 0) {
	    *errorCodePtr = -code;
            goto error;
	}

................................................................................
    offObj  = Tcl_NewWideIntObj(offset);
    baseObj = Tcl_NewStringObj(
            (seekMode == SEEK_SET) ? "start" :
            (seekMode == SEEK_CUR) ? "current" : "end", -1);
    Tcl_IncrRefCount(offObj);
    Tcl_IncrRefCount(baseObj);

    if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj) != TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
        goto invalid;
................................................................................
ReflectWatch(
    ClientData clientData,
    int mask)
{
    ReflectedChannel *rcPtr = clientData;
    Tcl_Obj *maskObj;

    /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */

    /*
     * We restrict the interest to what the channel can support. IOW there
     * will never be write events for a channel which is not writable.
     * Analoguously for read events and non-readable channels.
     */

    mask &= rcPtr->mode;
................................................................................
    }
#endif

    Tcl_Preserve(rcPtr);

    maskObj = DecodeEventMask(mask);
    /* assert maskObj.refCount == 1 */
    (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
    Tcl_DecrRefCount(maskObj);

    Tcl_Release(rcPtr);
}
 
/*
 *----------------------------------------------------------------------
................................................................................
#endif

    blockObj = Tcl_NewBooleanObj(!nonblocking);
    Tcl_IncrRefCount(blockObj);

    Tcl_Preserve(rcPtr);

    if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj)!=TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, resObj);
	errorNum = EINVAL;
    } else {
	errorNum = EOK;
    }

    Tcl_DecrRefCount(blockObj);
................................................................................

    optionObj = Tcl_NewStringObj(optionName, -1);
    valueObj = Tcl_NewStringObj(newValue, -1);

    Tcl_IncrRefCount(optionObj);
    Tcl_IncrRefCount(valueObj);

    result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj);
    if (result != TCL_OK) {
	UnmarshallErrorResult(interp, resObj);
    }

    Tcl_DecrRefCount(optionObj);
    Tcl_DecrRefCount(valueObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
................................................................................
     */

    ReflectedChannel *rcPtr = clientData;
    Tcl_Obj *optionObj;
    Tcl_Obj *resObj;		/* Result data for 'configure' */
    int listc, result = TCL_OK;
    Tcl_Obj **listv;
    const char *method;

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
................................................................................
#endif

    if (optionName == NULL) {
	/*
	 * Retrieve all options.
	 */

	method = "cgetall";
	optionObj = NULL;
    } else {
	/*
	 * Retrieve the value of one option.
	 */

	method = "cget";
	optionObj = Tcl_NewStringObj(optionName, -1);
        Tcl_IncrRefCount(optionObj);
    }

    Tcl_Preserve(rcPtr);

    if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) {
................................................................................
NewReflectedChannel(
    Tcl_Interp *interp,
    Tcl_Obj *cmdpfxObj,
    int mode,
    Tcl_Obj *handleObj)
{
    ReflectedChannel *rcPtr;


    rcPtr = ckalloc(sizeof(ReflectedChannel));

    /* rcPtr->chan: Assigned by caller. Dummy data here. */
    /* rcPtr->methods: Assigned by caller. Dummy data here. */

    rcPtr->chan = NULL;
    rcPtr->methods = 0;
    rcPtr->interp = interp;
    rcPtr->dead = 0;
#ifdef TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    /* ASSERT: cmdpfxObj is a Tcl List */
    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
    Tcl_ListObjAppendElement(NULL, rcPtr->cmd, Tcl_NewObj());


    Tcl_ListObjAppendElement(NULL, rcPtr->cmd, handleObj);




    Tcl_IncrRefCount(rcPtr->cmd);
    return rcPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * NextHandle --
................................................................................
 
static void
FreeReflectedChannel(
    ReflectedChannel *rcPtr)
{
    Channel *chanPtr = (Channel *) rcPtr->chan;

    if (chanPtr->typePtr != &tclRChannelType) {
	/*
	 * Delete a cloned ChannelType structure.
	 */

	ckfree(chanPtr->typePtr);
	chanPtr->typePtr = NULL;
    }
    Tcl_Release(chanPtr);


    Tcl_DecrRefCount(rcPtr->cmd);
    ckfree(rcPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *
 *----------------------------------------------------------------------
 */

static int
InvokeTclMethod(
    ReflectedChannel *rcPtr,
    const char *method,
    Tcl_Obj *argOneObj,		/* NULL'able */
    Tcl_Obj *argTwoObj,		/* NULL'able */
    Tcl_Obj **resultObjPtr)	/* NULL'able */
{
    Tcl_Obj *methObj = NULL;	/* Method name in object form */
    Tcl_InterpState sr;		/* State of handler interp */
    int result;			/* Result code of method invokation */
    Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
    Tcl_Obj *cmd;
    int len;

    if (rcPtr->dead) {
	/*
	 * The channel is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */

................................................................................
         * Not touching argOneObj, argTwoObj, they have not been used.
         * See the contract as well.
         */

	return TCL_ERROR;
    }

    /*
     * NOTE (5): Decide impl. issue: Cache objects with method names? Needs
     * TSD data as reflections can be created in many different threads.
     * NO: Caching of command resolutions means storage per channel.
     */

    /*
     * Insert method into the callback command, after the command prefix,
     * before the channel id.
     */

    methObj = Tcl_NewStringObj(method, -1);
    cmd = TclListObjCopy(NULL, rcPtr->cmd);

    ListObjLength(cmd, len);
    Tcl_ListObjReplace(NULL, cmd, len - 2, 1, 1, &methObj);


    /*
     * Append the additional argument containing method specific details
     * behind the channel id. If specified.
     *
     * Because of the contract there is no need to increment the refcounts.
     * The objects will survive the Tcl_EvalObjv without change.
................................................................................
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
			cmdLen);
		Tcl_DecrRefCount(cmd);
		result = TCL_ERROR;
	    }
	    Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
		    "\n    (chan handler subcommand \"%s\")", method));

	    resObj = MarshallError(rcPtr->interp);
	}
	Tcl_IncrRefCount(resObj);
    }
    Tcl_DecrRefCount(cmd);
    Tcl_RestoreInterpState(rcPtr->interp, sr);
    Tcl_Release(rcPtr->interp);
................................................................................
    switch (evPtr->op) {
	/*
	 * The destination thread for the following operations is
	 * rcPtr->thread, which contains rcPtr->interp, the interp we have to
	 * call upon for the driver.
	 */

    case ForwardedClose:
	/*
	 * No parameters/results.
	 */



	if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}

	/*
	 * Freeing is done here, in the origin thread, callback command
	 * objects belong to this thread. Deallocating them in a different
	 * thread is not allowed
................................................................................
	Tcl_DeleteHashEntry(hPtr);

	rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
                Tcl_GetChannelName(rcPtr->chan));
	Tcl_DeleteHashEntry(hPtr);







	break;


    case ForwardedInput: {
	Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
        Tcl_IncrRefCount(toReadObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){
	    int code = ErrnoReturn(rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }
................................................................................

    case ForwardedOutput: {
	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
                paramPtr->output.buf, paramPtr->output.toWrite);
        Tcl_IncrRefCount(bufObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
	    int code = ErrnoReturn(rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }
................................................................................
                (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
                (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);

        Tcl_IncrRefCount(offObj);
        Tcl_IncrRefCount(baseObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->seek.offset = -1;
	} else {
	    /*
	     * Process a regular result. If the type is wrong this may change
	     * into an error.
	     */
................................................................................
    }

    case ForwardedWatch: {
	Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask);
        /* assert maskObj.refCount == 1 */

        Tcl_Preserve(rcPtr);
	(void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
	Tcl_DecrRefCount(maskObj);
        Tcl_Release(rcPtr);
	break;
    }

    case ForwardedBlock: {
	Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);

        Tcl_IncrRefCount(blockObj);
        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
                &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(blockObj);
	break;
    }
................................................................................
    case ForwardedSetOpt: {
	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1);
	Tcl_Obj *valueObj  = Tcl_NewStringObj(paramPtr->setOpt.value, -1);

        Tcl_IncrRefCount(optionObj);
        Tcl_IncrRefCount(valueObj);
        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj,
                &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(optionObj);
        Tcl_DecrRefCount(valueObj);
	break;
................................................................................
	 * Retrieve the value of one option.
	 */

	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);

        Tcl_IncrRefCount(optionObj);
        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	} else {
	    TclDStringAppendObj(paramPtr->getOpt.value, resObj);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(optionObj);
	break;
................................................................................

    case ForwardedGetOptAll:
	/*
	 * Retrieve all options.
	 */

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	} else {
	    /*
	     * Extract list, validate that it is a list, and #elements. See
	     * NOTE (4) as well.
	     */







|
<
<
<
<
<
>







 







|







 







<

<







 







<
<
<
<
<













|







 







|
>
>
>
>







 







|
|
|
|
<
<







 







>







 







>



|
|
>
>
|
<
<
<
<
<
<
<
<
<







 







<
<





|







 







>
>
>
>
>







 







<
<
<
<
<
<
<
<
<
<
<
<







 







|







 







<
<
<
<
<
<
<
<
<
<
<
<







 







|







 







|







 







<
<







 







|







 







|







 







|







 







|







 







|






|







 







>




<


<










|
>
>
|
>
>
>
>
|







 







<
<
<
<
<
<
<
<

>
>







 







|









<







 







<
<
<
<
<
<





<

>
|
|
>







 







|
>







 







|




>
>
|







 







>
>
>
>
>
>

>






|







 







|







 







|







 







|










|







 







|







 







|







 







|







96
97
98
99
100
101
102
103





104
105
106
107
108
109
110
111
...
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
...
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
...
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
...
715
716
717
718
719
720
721
722
723
724
725


726
727
728
729
730
731
732
....
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
....
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157









1158
1159
1160
1161
1162
1163
1164
....
1172
1173
1174
1175
1176
1177
1178


1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
....
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
....
1256
1257
1258
1259
1260
1261
1262












1263
1264
1265
1266
1267
1268
1269
....
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
....
1359
1360
1361
1362
1363
1364
1365












1366
1367
1368
1369
1370
1371
1372
....
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
....
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
....
1582
1583
1584
1585
1586
1587
1588


1589
1590
1591
1592
1593
1594
1595
....
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
....
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
....
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
....
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
....
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
....
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
....
2177
2178
2179
2180
2181
2182
2183








2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
....
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227

2228
2229
2230
2231
2232
2233
2234
....
2242
2243
2244
2245
2246
2247
2248






2249
2250
2251
2252
2253

2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
....
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
....
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
....
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
....
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
....
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
....
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
....
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
....
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
....
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
				 * command is gone.
				 */
#ifdef TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. == Handler thread */
    Tcl_ThreadId owner;         /* Thread owning the structure.    == Channel thread */
#endif
    Tcl_Obj *cmd;		/* Callback command prefix */
    Tcl_Obj *methods;		/* Methods to append to command prefix */





    Tcl_Obj *name;		/* Name of the channel as created */

    int mode;			/* Mask of R/W mode */
    int interest;		/* Mask of events the channel is interested
				 * in. */

    int dead;			/* Boolean signal that some operations
				 * should no longer be attempted. */
................................................................................
			    const char *objName, Tcl_Obj *obj, int *mask);
static Tcl_Obj *	DecodeEventMask(int mask);
static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
			    Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj);
static Tcl_Obj *	NextHandle(void);
static void		FreeReflectedChannel(ReflectedChannel *rcPtr);
static int		InvokeTclMethod(ReflectedChannel *rcPtr,
			    MethodName method, Tcl_Obj *argOneObj,
			    Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);

static ReflectedChannelMap *	GetReflectedChannelMap(Tcl_Interp *interp);
static void		DeleteReflectedChannelMap(ClientData clientData,
			    Tcl_Interp *interp);
static int		ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);

................................................................................
/*
 * Global constant strings (messages). ==================
 * These string are used directly as bypass errors, thus they have to be valid
 * Tcl lists where the last element is the message itself. Hence the
 * list-quoting to keep the words of the message together. See also [x].
 */


static const char *msg_read_toomuch = "{read delivered more than requested}";

static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#ifdef TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
static const char *msg_send_dstlost    = "{Owner lost}";
#endif /* TCL_THREADS */
................................................................................

    /*
     * Now create the channel.
     */

    rcId = NextHandle();
    rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);






    /*
     * Invoke 'initialize' and validate that the handler is present and ok.
     * Squash the channel if not.
     *
     * Note: The conversion of 'mode' back into a Tcl_Obj ensures that
     * 'initialize' is invoked with canonical mode names, and no
     * abbreviations. Using modeObj directly could feed abbreviations into the
     * handler, and the handler is not specified to handle such.
     */

    modeObj = DecodeEventMask(mode);
    /* assert modeObj.refCount == 1 */
    result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
    Tcl_DecrRefCount(modeObj);

    if (result != TCL_OK) {
	UnmarshallErrorResult(interp, resObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	goto error;
    }
................................................................................

    Tcl_ResetResult(interp);

    /*
     * Everything is fine now.
     */

    chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
	    mode);
    rcPtr->chan = chan;
    Tcl_Preserve(chan);
    chanPtr = (Channel *) chan;

    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_SetObjResult(interp,
            Tcl_NewStringObj(chanPtr->state->channelName, -1));
    return TCL_OK;

  error:
    Tcl_DecrRefCount(rcPtr->name);
    Tcl_DecrRefCount(rcPtr->methods);
    Tcl_DecrRefCount(rcPtr->cmd);
    ckfree((char*) rcPtr);


    return TCL_ERROR;

#undef MODE
#undef CMD
}
 
/*
................................................................................
{
    ReflectedChannel *rcPtr = clientData;
    int result;			/* Result code for 'close' */
    Tcl_Obj *resObj;		/* Result data for 'close' */
    ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
				 * this interp */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    const Tcl_ChannelType *tctPtr;

    if (TclInThreadExit()) {
	/*
	 * This call comes from TclFinalizeIOSystem. There are no
	 * interpreters, and therefore we cannot call upon the handler command
	 * anymore. Threading is irrelevant as well. We simply clean up all
	 * our C level data structures and leave the Tcl level to the other
................................................................................
             */

            Tcl_DeleteEvents(ReflectEventDelete, rcPtr);

	    if (result != TCL_OK) {
		FreeReceivedError(&p);
	    }
	    return EOK;
	}
#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree((char *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}









        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	return EOK;
    }

    /*
     * Are we in the correct thread?
     */
................................................................................

        /*
         * Now squash the pending reflection events for this channel.
         */

        Tcl_DeleteEvents(ReflectEventDelete, rcPtr);



	if (result != TCL_OK) {
	    PassReceivedErrorInterp(interp, &p);
	}
    } else {
#endif
	result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj);
	if ((result != TCL_OK) && (interp != NULL)) {
	    Tcl_SetChannelErrorInterp(interp, resObj);
	}

	Tcl_DecrRefCount(resObj);	/* Remove reference we held from the
					 * invoke */

................................................................................
	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
		Tcl_GetChannelName(rcPtr->chan));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree((char *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
#ifdef TCL_THREADS
    }
#endif
    return (result == TCL_OK) ? EOK : EINVAL;
}
 
................................................................................
{
    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?
     */

#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;
................................................................................
    /* ASSERT: rcPtr->mode & TCL_READABLE */

    Tcl_Preserve(rcPtr);

    toReadObj = Tcl_NewIntObj(toRead);
    Tcl_IncrRefCount(toReadObj);

    if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
	int code = ErrnoReturn(rcPtr, resObj);

	if (code < 0) {
	    *errorCodePtr = -code;
            goto error;
	}

................................................................................
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = clientData;
    Tcl_Obj *bufObj;
    Tcl_Obj *resObj;		/* Result data for 'write' */
    int written;













    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;
................................................................................
    /* ASSERT: rcPtr->mode & TCL_WRITABLE */

    Tcl_Preserve(rcPtr);

    bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
    Tcl_IncrRefCount(bufObj);

    if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
	int code = ErrnoReturn(rcPtr, resObj);

	if (code < 0) {
	    *errorCodePtr = -code;
            goto error;
	}

................................................................................
    offObj  = Tcl_NewWideIntObj(offset);
    baseObj = Tcl_NewStringObj(
            (seekMode == SEEK_SET) ? "start" :
            (seekMode == SEEK_CUR) ? "current" : "end", -1);
    Tcl_IncrRefCount(offObj);
    Tcl_IncrRefCount(baseObj);

    if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
        goto invalid;
................................................................................
ReflectWatch(
    ClientData clientData,
    int mask)
{
    ReflectedChannel *rcPtr = clientData;
    Tcl_Obj *maskObj;



    /*
     * We restrict the interest to what the channel can support. IOW there
     * will never be write events for a channel which is not writable.
     * Analoguously for read events and non-readable channels.
     */

    mask &= rcPtr->mode;
................................................................................
    }
#endif

    Tcl_Preserve(rcPtr);

    maskObj = DecodeEventMask(mask);
    /* assert maskObj.refCount == 1 */
    (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
    Tcl_DecrRefCount(maskObj);

    Tcl_Release(rcPtr);
}
 
/*
 *----------------------------------------------------------------------
................................................................................
#endif

    blockObj = Tcl_NewBooleanObj(!nonblocking);
    Tcl_IncrRefCount(blockObj);

    Tcl_Preserve(rcPtr);

    if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, resObj);
	errorNum = EINVAL;
    } else {
	errorNum = EOK;
    }

    Tcl_DecrRefCount(blockObj);
................................................................................

    optionObj = Tcl_NewStringObj(optionName, -1);
    valueObj = Tcl_NewStringObj(newValue, -1);

    Tcl_IncrRefCount(optionObj);
    Tcl_IncrRefCount(valueObj);

    result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj);
    if (result != TCL_OK) {
	UnmarshallErrorResult(interp, resObj);
    }

    Tcl_DecrRefCount(optionObj);
    Tcl_DecrRefCount(valueObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
................................................................................
     */

    ReflectedChannel *rcPtr = clientData;
    Tcl_Obj *optionObj;
    Tcl_Obj *resObj;		/* Result data for 'configure' */
    int listc, result = TCL_OK;
    Tcl_Obj **listv;
    MethodName method;

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
................................................................................
#endif

    if (optionName == NULL) {
	/*
	 * Retrieve all options.
	 */

	method = METH_CGETALL;
	optionObj = NULL;
    } else {
	/*
	 * Retrieve the value of one option.
	 */

	method = METH_CGET;
	optionObj = Tcl_NewStringObj(optionName, -1);
        Tcl_IncrRefCount(optionObj);
    }

    Tcl_Preserve(rcPtr);

    if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) {
................................................................................
NewReflectedChannel(
    Tcl_Interp *interp,
    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;
#ifdef TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    /* ASSERT: cmdpfxObj is a Tcl List */
    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
    Tcl_IncrRefCount(rcPtr->cmd);
    rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
    while (mn <= METH_WRITE) {
	Tcl_ListObjAppendElement(NULL, rcPtr->methods,
		Tcl_NewStringObj(methodNames[mn++], -1));
    }
    Tcl_IncrRefCount(rcPtr->methods);
    rcPtr->name = handleObj;
    Tcl_IncrRefCount(rcPtr->name);
    return rcPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * NextHandle --
................................................................................
 
static void
FreeReflectedChannel(
    ReflectedChannel *rcPtr)
{
    Channel *chanPtr = (Channel *) rcPtr->chan;









    Tcl_Release(chanPtr);
    Tcl_DecrRefCount(rcPtr->name);
    Tcl_DecrRefCount(rcPtr->methods);
    Tcl_DecrRefCount(rcPtr->cmd);
    ckfree(rcPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *
 *----------------------------------------------------------------------
 */

static int
InvokeTclMethod(
    ReflectedChannel *rcPtr,
    MethodName method,
    Tcl_Obj *argOneObj,		/* NULL'able */
    Tcl_Obj *argTwoObj,		/* NULL'able */
    Tcl_Obj **resultObjPtr)	/* NULL'able */
{
    Tcl_Obj *methObj = NULL;	/* Method name in object form */
    Tcl_InterpState sr;		/* State of handler interp */
    int result;			/* Result code of method invokation */
    Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
    Tcl_Obj *cmd;


    if (rcPtr->dead) {
	/*
	 * The channel is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */

................................................................................
         * Not touching argOneObj, argTwoObj, they have not been used.
         * See the contract as well.
         */

	return TCL_ERROR;
    }







    /*
     * Insert method into the callback command, after the command prefix,
     * before the channel id.
     */


    cmd = TclListObjCopy(NULL, rcPtr->cmd);

    Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
    Tcl_ListObjAppendElement(NULL, cmd, methObj);
    Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);

    /*
     * Append the additional argument containing method specific details
     * behind the channel id. If specified.
     *
     * Because of the contract there is no need to increment the refcounts.
     * The objects will survive the Tcl_EvalObjv without change.
................................................................................
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
			cmdLen);
		Tcl_DecrRefCount(cmd);
		result = TCL_ERROR;
	    }
	    Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
		    "\n    (chan handler subcommand \"%s\")",
		    methodNames[method]));
	    resObj = MarshallError(rcPtr->interp);
	}
	Tcl_IncrRefCount(resObj);
    }
    Tcl_DecrRefCount(cmd);
    Tcl_RestoreInterpState(rcPtr->interp, sr);
    Tcl_Release(rcPtr->interp);
................................................................................
    switch (evPtr->op) {
	/*
	 * The destination thread for the following operations is
	 * rcPtr->thread, which contains rcPtr->interp, the interp we have to
	 * call upon for the driver.
	 */

    case ForwardedClose: {
	/*
	 * No parameters/results.
	 */

	const Tcl_ChannelType *tctPtr;

	if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}

	/*
	 * Freeing is done here, in the origin thread, callback command
	 * objects belong to this thread. Deallocating them in a different
	 * thread is not allowed
................................................................................
	Tcl_DeleteHashEntry(hPtr);

	rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
                Tcl_GetChannelName(rcPtr->chan));
	Tcl_DeleteHashEntry(hPtr);

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree((char *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	break;
    }

    case ForwardedInput: {
	Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
        Tcl_IncrRefCount(toReadObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
	    int code = ErrnoReturn(rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }
................................................................................

    case ForwardedOutput: {
	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
                paramPtr->output.buf, paramPtr->output.toWrite);
        Tcl_IncrRefCount(bufObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
	    int code = ErrnoReturn(rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }
................................................................................
                (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
                (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);

        Tcl_IncrRefCount(offObj);
        Tcl_IncrRefCount(baseObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->seek.offset = -1;
	} else {
	    /*
	     * Process a regular result. If the type is wrong this may change
	     * into an error.
	     */
................................................................................
    }

    case ForwardedWatch: {
	Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask);
        /* assert maskObj.refCount == 1 */

        Tcl_Preserve(rcPtr);
	(void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
	Tcl_DecrRefCount(maskObj);
        Tcl_Release(rcPtr);
	break;
    }

    case ForwardedBlock: {
	Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);

        Tcl_IncrRefCount(blockObj);
        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
                &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(blockObj);
	break;
    }
................................................................................
    case ForwardedSetOpt: {
	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1);
	Tcl_Obj *valueObj  = Tcl_NewStringObj(paramPtr->setOpt.value, -1);

        Tcl_IncrRefCount(optionObj);
        Tcl_IncrRefCount(valueObj);
        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
                &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(optionObj);
        Tcl_DecrRefCount(valueObj);
	break;
................................................................................
	 * Retrieve the value of one option.
	 */

	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);

        Tcl_IncrRefCount(optionObj);
        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	} else {
	    TclDStringAppendObj(paramPtr->getOpt.value, resObj);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(optionObj);
	break;
................................................................................

    case ForwardedGetOptAll:
	/*
	 * Retrieve all options.
	 */

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	} else {
	    /*
	     * Extract list, validate that it is a list, and #elements. See
	     * NOTE (4) as well.
	     */

Changes to generic/tclInt.h.

2971
2972
2973
2974
2975
2976
2977

2978
2979
2980
2981
2982
2983
2984
MODULE_SCOPE void	TclFinalizeLock(void);
MODULE_SCOPE void	TclFinalizeMemorySubsystem(void);
MODULE_SCOPE void	TclFinalizeNotifier(void);
MODULE_SCOPE void	TclFinalizeObjects(void);
MODULE_SCOPE void	TclFinalizePreserve(void);
MODULE_SCOPE void	TclFinalizeSynchronization(void);
MODULE_SCOPE void	TclFinalizeThreadAlloc(void);

MODULE_SCOPE void	TclFinalizeThreadData(void);
MODULE_SCOPE void	TclFinalizeThreadObjects(void);
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 int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,






>







2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
MODULE_SCOPE void	TclFinalizeLock(void);
MODULE_SCOPE void	TclFinalizeMemorySubsystem(void);
MODULE_SCOPE void	TclFinalizeNotifier(void);
MODULE_SCOPE void	TclFinalizeObjects(void);
MODULE_SCOPE void	TclFinalizePreserve(void);
MODULE_SCOPE void	TclFinalizeSynchronization(void);
MODULE_SCOPE void	TclFinalizeThreadAlloc(void);
MODULE_SCOPE void	TclFinalizeThreadAllocThread(void);
MODULE_SCOPE void	TclFinalizeThreadData(void);
MODULE_SCOPE void	TclFinalizeThreadObjects(void);
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 int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,

Changes to generic/tclThread.c.

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
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeThreadData --
 *
 *	This function cleans up the thread-local storage. This is called once

 *	for each thread.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees up all thread local storage.
 *
................................................................................
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadData(void)
{
    TclFinalizeThreadDataThread();



}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeSynchronization --
 *






|
>
|







 







>
>
>







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
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeThreadData --
 *
 *	This function cleans up the thread-local storage. Secondary, it cleans
 *	thread alloc cache.
 *	This is called once for each thread before thread exits.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees up all thread local storage.
 *
................................................................................
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadData(void)
{
    TclFinalizeThreadDataThread();
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
    TclFinalizeThreadAllocThread();
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeSynchronization --
 *

Changes to generic/tclThreadAlloc.c.

1018
1019
1020
1021
1022
1023
1024



























1025
1026
1027
1028
1029
1030
1031
    objLockPtr = NULL;

    TclpFreeAllocMutex(listLockPtr);
    listLockPtr = NULL;

    TclpFreeAllocCache(NULL);
}



























 
#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetMemoryInfo --
 *






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







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
    objLockPtr = NULL;

    TclpFreeAllocMutex(listLockPtr);
    listLockPtr = NULL;

    TclpFreeAllocCache(NULL);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeThreadAllocThread --
 *
 *	This procedure is used to destroy single thread private resources used
 *	in this file. 
 * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadAllocThread(void)
{
    Cache *cachePtr = TclpGetAllocCache();
    if (cachePtr != NULL) {
	TclpFreeAllocCache(cachePtr);
    }
}
 
#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetMemoryInfo --
 *

Changes to tests/fCmd.test.

507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
    file mkdir td1
    testchmod 000 td1
    createfile tf1
    file rename tf1 td1
} -returnCodes error -cleanup {
    testchmod 755 td1
} -result {error renaming "tf1" to "td1/tf1": permission denied}
test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} -setup {
    cleanup
} -constraints {win 95} -returnCodes error -body {
    createfile tf1
    file rename tf1 $long
} -result [subst {error renaming "tf1" to "$long": file name too long}]
test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    createfile tf1
    file rename tf1 tf2
    glob tf*
} -result {tf2}






<
<
<
<
<
<







507
508
509
510
511
512
513






514
515
516
517
518
519
520
    file mkdir td1
    testchmod 000 td1
    createfile tf1
    file rename tf1 td1
} -returnCodes error -cleanup {
    testchmod 755 td1
} -result {error renaming "tf1" to "td1/tf1": permission denied}






test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    createfile tf1
    file rename tf1 tf2
    glob tf*
} -result {tf2}

Changes to tests/http.test.

488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
proc myProgress {token total current} {
    global progress httpLog
    if {[info exists httpLog] && $httpLog} {
	puts "progress $total $current"
    }
    set progress [list $total $current]
}
if 0 {
    # This test hangs on Windows95 because the client never gets EOF
    set httpLog 1
    test http-4.6.1 {http::Event} knownBug {
	set token [http::geturl $url -blocksize 50 -progress myProgress]
	return $progress
    } {111 111}
}
test http-4.7 {http::Event} -body {
    set token [http::geturl $url -keepalive 0 -progress myProgress]
    return $progress
} -cleanup {
    http::cleanup $token
} -result {111 111}
test http-4.8 {http::Event} -body {






<
<
<
|
|
|
|
<







488
489
490
491
492
493
494



495
496
497
498

499
500
501
502
503
504
505
proc myProgress {token total current} {
    global progress httpLog
    if {[info exists httpLog] && $httpLog} {
	puts "progress $total $current"
    }
    set progress [list $total $current]
}



test http-4.6.1 {http::Event} knownBug {
    set token [http::geturl $url -blocksize 50 -progress myProgress]
    return $progress
} {111 111}

test http-4.7 {http::Event} -body {
    set token [http::geturl $url -keepalive 0 -progress myProgress]
    return $progress
} -cleanup {
    http::cleanup $token
} -result {111 111}
test http-4.8 {http::Event} -body {

Changes to tests/ioCmd.test.

808
809
810
811
812
813
814

































































815
816
817
818
819
820
821
    set ch [chan create {read write} foo]
} -body {
    list [catch {chan configure $ch -blocking 0} m] $m
} -cleanup {
    close $ch
    rename foo {}
} -match glob -result {1 {*nested eval*}}


































































# --- --- --- --------- --------- ---------
# Helper commands to record the arguments to handler methods.

# Stored in a script so that the threads and interpreters needing this
# code do not need their own copy but can access this variable.







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







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
    set ch [chan create {read write} foo]
} -body {
    list [catch {chan configure $ch -blocking 0} m] $m
} -cleanup {
    close $ch
    rename foo {}
} -match glob -result {1 {*nested eval*}}
test iocmd-21.21 {[close] in [read] segfaults} -setup {
    proc foo {method chan args} {
	switch -- $method initialize {
	    return {initialize finalize watch read}
	} finalize {} watch {} read {
	    close $chan
	    return a
	}
    }
    set ch [chan create read foo]
} -body {
    read $ch 0
} -cleanup {
    close $ch
    rename foo {}
} -result {}
test iocmd-21.22 {[close] in [read] segfaults} -setup {
    proc foo {method chan args} {
	switch -- $method initialize {
	    return {initialize finalize watch read}
	} finalize {} watch {} read {
	    catch {close $chan}
	    return a
	}
    }
    set ch [chan create read foo]
} -body {
    read $ch 1
} -returnCodes error -cleanup {
    catch {close $ch}
    rename foo {}
} -match glob -result {*invalid argument*}
test iocmd-21.23 {[close] in [gets] segfaults} -setup {
    proc foo {method chan args} {
	switch -- $method initialize {
	    return {initialize finalize watch read}
	} finalize {} watch {} read {
	    catch {close $chan}
	    return \n
	}
    }
    set ch [chan create read foo]
} -body {
    gets $ch
} -cleanup {
    catch {close $ch}
    rename foo {}
} -result {}
test iocmd-21.24 {[close] in binary [gets] segfaults} -setup {
    proc foo {method chan args} {
	switch -- $method initialize {
	    return {initialize finalize watch read}
	} finalize {} watch {} read {
	    catch {close $chan}
	    return \n
	}
    }
    set ch [chan create read foo]
} -body {
    chan configure $ch -translation binary
    gets $ch
} -cleanup {
    catch {close $ch}
    rename foo {}
} -result {}

# --- --- --- --------- --------- ---------
# Helper commands to record the arguments to handler methods.

# Stored in a script so that the threads and interpreters needing this
# code do not need their own copy but can access this variable.

Changes to tests/ioTrans.test.

535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
...
553
554
555
556
557
558
559
560
561




















562
563
564
565
566
567
568
...
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
    set c [chan push [set c [tempchan]] [list foo $c]]
    lappend res [read $c]
    #lappend res [gets $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} file*}
test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
................................................................................
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    chan configure $c -buffersize 2
    lappend res [read $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} file*}




















test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
................................................................................
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    lappend res [gets $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} file*}

# --- === *** ###########################
# method write (via puts)

test iortrans-5.1 {chan write, regular write} -setup {
    set res {}
} -match glob -body {






|







 







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







 







|







535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
...
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
...
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
    set c [chan push [set c [tempchan]] [list foo $c]]
    lappend res [read $c]
    #lappend res [gets $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} {}}
test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
................................................................................
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    chan configure $c -buffersize 2
    lappend res [read $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* te} {read rt* st} {read rt* { d}} {read rt* at} {read rt* {a
}} {}}
test iortrans-4.8.2 {chan read, bug 721ec69271} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
	return x
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    chan configure $c -buffersize 1
    lappend res [read $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* t} {read rt* e} {read rt* s} {read rt* t} {read rt* { }} {read rt* d} {read rt* a} {read rt* t} {read rt* a} {read rt* {
}} {}}
test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
................................................................................
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    lappend res [gets $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} {}}

# --- === *** ###########################
# method write (via puts)

test iortrans-5.1 {chan write, regular write} -setup {
    set res {}
} -match glob -body {

Changes to tests/iogt.test.

224
225
226
227
228
229
230
231
232










233
234
235
236
237
238
239
...
575
576
577
578
579
580
581









582
583
584
585
586
587
588
    switch -- $op {
	create/write -
	create/read  -
	delete/write -
	delete/read  -
	clear_read   {;#ignore}
	flush/write -
	flush/read  -
	write       -










	read        {
	    testchannel unstack $chan
	    testchannel transform $chan \
		-command [namespace code [list id_torture $chan]]
	    return $data
	}
	query/maxRead {return -1}
................................................................................
    set fh [open $path(dummy) r]
    torture -attach $fh
    chan configure $fh -buffersize 2
    set x [read $fh]
    testchannel unstack $fh
    close   $fh
    set x









} {}

test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
    proc DoneCopy {n {err {}}} {
	variable copy 1
    }
} -constraints {testchannel hangs} -body {






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







 







>
>
>
>
>
>
>
>
>







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
...
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
    switch -- $op {
	create/write -
	create/read  -
	delete/write -
	delete/read  -
	clear_read   {;#ignore}
	flush/write -
	flush/read  {}
	write       {
	    global level
	    if {$level} {
		return
	    }
	    incr level
	    testchannel unstack $chan
	    testchannel transform $chan \
		-command [namespace code [list id_torture $chan]]
	    return $data
	}
	read        {
	    testchannel unstack $chan
	    testchannel transform $chan \
		-command [namespace code [list id_torture $chan]]
	    return $data
	}
	query/maxRead {return -1}
................................................................................
    set fh [open $path(dummy) r]
    torture -attach $fh
    chan configure $fh -buffersize 2
    set x [read $fh]
    testchannel unstack $fh
    close   $fh
    set x
} {}
test iogt-2.5 {basic I/O, mixed trail} {testchannel} {
    set ::level 0
    set fh [open $path(dummyout) w]
    torture -attach $fh
    puts -nonewline $fh abcdef
    flush $fh
    testchannel unstack $fh
    close   $fh
} {}

test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
    proc DoneCopy {n {err {}}} {
	variable copy 1
    }
} -constraints {testchannel hangs} -body {

Changes to tests/stringComp.test.

22
23
24
25
26
27
28
















29
30
31
32
33
34
35
...
683
684
685
686
687
688
689
690
















691
692
693
694
695
696
697
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] != {}}]
















 
test stringComp-1.1 {error conditions} {
    proc foo {} {string gorp a b}
    list [catch {foo} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test stringComp-1.2 {error conditions} {
    proc foo {} {string}
................................................................................
    }} 12345
} {}

## string repeat
## not yet bc

## string replace
## not yet bc

















## string tolower
## not yet bc

## string toupper
## not yet bc







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







 







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







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
...
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
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
	set end [getbytes]
	for {set i 0} {$i < $iterations} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [getbytes]
	}
	return [expr {$end - $tmp}]
    }
}
 
test stringComp-1.1 {error conditions} {
    proc foo {} {string gorp a b}
    list [catch {foo} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test stringComp-1.2 {error conditions} {
    proc foo {} {string}
................................................................................
    }} 12345
} {}

## string repeat
## not yet bc

## string replace
test stringComp-14.1 {Bug 82e7f67325} {
    apply {x {
	set a [join $x {}]
	lappend b [string length [string replace ___! 0 2 $a]]
	lappend b [string length [string replace ___! 0 2 $a[unset a]]]
    }} {a b}
} {3 3}
test stringComp-14.2 {Bug 82e7f67325} memory {
    # As in stringComp-14.1, but make sure we don't retain too many refs
    leaktest {
	apply {x {
	    set a [join $x {}]
	    lappend b [string length [string replace ___! 0 2 $a]]
	    lappend b [string length [string replace ___! 0 2 $a[unset a]]]
	}} {a b}
    }
} {0}

## string tolower
## not yet bc

## string toupper
## not yet bc

Changes to tests/winFCmd.test.

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
...
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
...
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
...
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
...
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
...
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
...
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
...
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
....
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
    catch {close $fd}
} -returnCodes error -result EACCES
test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup {
    cleanup
} -constraints {win win2000orXP testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EINVAL
test winFCmd-1.13.1 {TclpRenameFile: errno: EACCES} -setup {
    cleanup
} -constraints {win nt winOlderThan2000 testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EACCES
test winFCmd-1.13.2 {TclpRenameFile: errno: ENOENT} -setup {
    cleanup
} -constraints {win 95 testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result ENOENT
test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
    cleanup
} -constraints {win 95 testfile} -body {
    createfile tf1
    testfile mv tf1 nul
} -returnCodes error -result EACCES
test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    createfile tf1
    testfile mv tf1 nul
} -returnCodes error -result EEXIST
................................................................................
    testfile mv nul tf1
} -returnCodes error -result EINVAL
test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup {
    cleanup
} -constraints {win nt winOlderThan2000 testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EACCES
test winFCmd-1.19.2 {TclpRenameFile: errno == ENOENT} -setup {
    cleanup
} -constraints {win 95 testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result ENOENT
test winFCmd-1.20 {TclpRenameFile: src is dir} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    # under 95, this would actually succeed and move the current dir out from
    # under the current process!
    file delete /tf1
    testfile mv [pwd] /tf1
................................................................................
    createfile tf1
    testfile cp tf1 ""
} -cleanup {
    cleanup
} -returnCodes error -result ENOENT
test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
} -constraints {win 95 testfile} -body {
    createfile tf1
    set fd [open tf2 w]
    testfile cp tf1 tf2
} -cleanup {
    close $fd
    cleanup
} -returnCodes error -result EACCES
test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
} -constraints {win win2000orXP testfile} -body {
    testfile cp nul tf1
} -returnCodes error -result EINVAL
test winFCmd-2.8.1 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
} -constraints {win nt winOlderThan2000 testfile} -body {
    testfile cp nul tf1
} -returnCodes error -result EACCES
test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} -setup {
    cleanup
} -constraints {win 95 testfile} -body {
    testfile cp nul tf1
} -returnCodes error -result ENOENT
test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
    testfile cp tf1 tf2
    list [contents tf1] [contents tf2]
} -cleanup {
................................................................................
    testchmod 000 tf2
    testfile cp tf1 tf2
    list [file writable tf2] [contents tf2]
} -cleanup {
    catch {testchmod 666 tf2}
    cleanup
} -result {1 tf1}
test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} -setup {
    cleanup
} -constraints {win 95 testfile testchmod} -body {
    createfile tf1
    createfile tf2
    testchmod 000 tf2
    set fd [open tf2]
    set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
    close $fd
    lappend msg [file writable tf2]
} -result {1 EACCES 0}

test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} -body {
    testfile rm $cdfile $cdrom/dummy~~.fil
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} -setup {
    cleanup
} -constraints {win testfile} -body {
................................................................................
    catch {testchmod 666 tf1}
    cleanup
} -returnCodes error -result EACCES

test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
    testfile mkdir $cdrom/dummy~~.dir
} -constraints {win nt cdrom testfile} -returnCodes error -result EACCES
test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} -body {
    testfile mkdir $cdrom/dummy~~.dir
} -constraints {win 95 cdrom testfile} -returnCodes error -result ENOSPC
test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile mkdir td1
} -cleanup {
    cleanup
................................................................................
    testchmod 000 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 666 td1}
    cleanup
} -result {td1 EACCES}
test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win 95 testfile} -body {
    testfile rmdir nul
} -returnCodes error -result {nul EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    testfile rmdir /
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
# This next test has a very hokey way of matching...
test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} -setup {
    cleanup
} -constraints {win 95 testfile} -body {
    createfile tf1
    set res [catch {testfile rmdir tf1} msg]
    # get rid of path
    set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
    list $res $msg
} -result {1 {tf1 ENOTDIR}}
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
    cleanup
} -constraints {winVista testfile testchmod} -body {
    file mkdir td1
    testchmod 000 td1
    testfile rmdir td1
    file exists td1
} -cleanup {
    catch {testchmod 666 td1}
    cleanup
} -returnCodes error -result {td1 EACCES}
# This next test has a very hokey way of matching...
test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} -setup {
    cleanup
} -constraints {win 95 testfile} -body {
    file mkdir td1/td2
    set res [catch {testfile rmdir td1} msg]
    # get rid of path
    set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
    list $res $msg
} -result {1 {td1 EEXIST}}
# This next test has a very hokey way of matching...
test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2
    list [catch {testfile rmdir td1} msg] [file tail $msg]
} -result {1 {td1 EEXIST}}
................................................................................
    file mkdir td1
    createfile td1/tf1 tf1
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
} -result {tf1}
test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} -body {
    # cdrom can return either d:\ or D:/, but we only care about the errcode
    testfile rmdir $cdrom/
} -constraints {win 95 cdrom testfile} -returnCodes error -match glob \
    -result {* EACCES} ; # was EEXIST, but changed for win98.
test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body {
    testfile rmdir $cdrom/
} -constraints {win nt cdrom testfile} -returnCodes error -match glob \
    -result {* EACCES}
test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
	{win emptyTest} {
    # can't make it happen
................................................................................
    file mkdir td1
    createfile td1/tf1 tf1
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
} -result {tf1}
test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} -setup {
    cleanup
} -constraints {win 95 testfile} -body {
    file mkdir td1
    testfile cpdir td1 /
} -cleanup {
    cleanup
} -returnCodes error -result {/ EEXIST}
test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    file mkdir td1
    testfile cpdir td1 /
} -cleanup {
    cleanup
................................................................................
test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1
    testfile rmdir -force td1
} -result {}
test winFCmd-9.2 {TraversalDelete: DOTREE_F} -setup {
    cleanup
} -constraints {win 95 testfile} -body {
    file mkdir td1
    set fd [open td1/tf1 w]
    testfile rmdir -force td1
} -cleanup {
    close $fd
} -returnCodes error -result {td1\tf1 EACCES}
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
    cleanup
} -constraints {winVista testfile testchmod} -body {
    file mkdir td1/td2
    testchmod 000 td1
    testfile rmdir -force td1
    file exists td1






|



<
<
<
<
<
<
<
<
<
<
<







 







<
<
<
<
<







 







<
<
<
<
<
<
<
<
<
<



|




<
<
<
<
<







 







<
<
<
<
<
<
<
<
<
<
<







 







<
<
<







 







<
<
<
<
<







<
<
<
<
<
<
<
<
<
<











<
<
<
<
<
<
<
<
<
<







 







<
<
<
<
<







 







<
<
<
<
<
<
<
<







 







<
<
<
<
<
<
<
<
<







204
205
206
207
208
209
210
211
212
213
214











215
216
217
218
219
220
221
...
242
243
244
245
246
247
248





249
250
251
252
253
254
255
...
454
455
456
457
458
459
460










461
462
463
464
465
466
467
468





469
470
471
472
473
474
475
...
538
539
540
541
542
543
544











545
546
547
548
549
550
551
...
620
621
622
623
624
625
626



627
628
629
630
631
632
633
...
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
...
813
814
815
816
817
818
819





820
821
822
823
824
825
826
...
851
852
853
854
855
856
857








858
859
860
861
862
863
864
...
951
952
953
954
955
956
957









958
959
960
961
962
963
964
    catch {close $fd}
} -returnCodes error -result EACCES
test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup {
    cleanup
} -constraints {win win2000orXP testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EINVAL
test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
    cleanup
} -constraints {win nt winOlderThan2000 testfile} -body {
    testfile mv nul tf1











} -returnCodes error -result EACCES
test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    createfile tf1
    testfile mv tf1 nul
} -returnCodes error -result EEXIST
................................................................................
    testfile mv nul tf1
} -returnCodes error -result EINVAL
test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup {
    cleanup
} -constraints {win nt winOlderThan2000 testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EACCES





test winFCmd-1.20 {TclpRenameFile: src is dir} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    # under 95, this would actually succeed and move the current dir out from
    # under the current process!
    file delete /tf1
    testfile mv [pwd] /tf1
................................................................................
    createfile tf1
    testfile cp tf1 ""
} -cleanup {
    cleanup
} -returnCodes error -result ENOENT
test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
    cleanup










} -constraints {win win2000orXP testfile} -body {
    testfile cp nul tf1
} -returnCodes error -result EINVAL
test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
} -constraints {win nt winOlderThan2000 testfile} -body {
    testfile cp nul tf1
} -returnCodes error -result EACCES





test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
    testfile cp tf1 tf2
    list [contents tf1] [contents tf2]
} -cleanup {
................................................................................
    testchmod 000 tf2
    testfile cp tf1 tf2
    list [file writable tf2] [contents tf2]
} -cleanup {
    catch {testchmod 666 tf2}
    cleanup
} -result {1 tf1}












test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} -body {
    testfile rm $cdfile $cdrom/dummy~~.fil
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} -setup {
    cleanup
} -constraints {win testfile} -body {
................................................................................
    catch {testchmod 666 tf1}
    cleanup
} -returnCodes error -result EACCES

test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
    testfile mkdir $cdrom/dummy~~.dir
} -constraints {win nt cdrom testfile} -returnCodes error -result EACCES



test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile mkdir td1
} -cleanup {
    cleanup
................................................................................
    testchmod 000 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 666 td1}
    cleanup
} -result {td1 EACCES}





test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    testfile rmdir /
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}










test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
    cleanup
} -constraints {winVista testfile testchmod} -body {
    file mkdir td1
    testchmod 000 td1
    testfile rmdir td1
    file exists td1
} -cleanup {
    catch {testchmod 666 td1}
    cleanup
} -returnCodes error -result {td1 EACCES}










# This next test has a very hokey way of matching...
test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2
    list [catch {testfile rmdir td1} msg] [file tail $msg]
} -result {1 {td1 EEXIST}}
................................................................................
    file mkdir td1
    createfile td1/tf1 tf1
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
} -result {tf1}





test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body {
    testfile rmdir $cdrom/
} -constraints {win nt cdrom testfile} -returnCodes error -match glob \
    -result {* EACCES}
test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
	{win emptyTest} {
    # can't make it happen
................................................................................
    file mkdir td1
    createfile td1/tf1 tf1
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
} -result {tf1}








test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    file mkdir td1
    testfile cpdir td1 /
} -cleanup {
    cleanup
................................................................................
test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1
    testfile rmdir -force td1
} -result {}









test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
    cleanup
} -constraints {winVista testfile testchmod} -body {
    file mkdir td1/td2
    testchmod 000 td1
    testfile rmdir -force td1
    file exists td1

Changes to tests/winFile.test.

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
test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
    glob ~nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body {
    # The administrator account should always exist.
    glob ~administrator
} -match glob -result *
test winFile-1.3 {TclpGetUserHome} -constraints {win 95} -body {
    # Find some user in system.ini and then see if they have a home.

    set f [open $::env(windir)/system.ini]
    while {[gets $f line] >= 0} {
	if {$line ne {[Password Lists]}} {
	    continue
	}
	gets $f
	set name [lindex [split [gets $f] =] 0]
	if {$name ne ""} {
	    return [catch {glob ~$name}]
	}
    }
    return 0 ;# didn't find anything...
} -cleanup {
    catch {close $f}
} -result {0}
test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
    catch {glob [email protected]}
} {0}

test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
    makeFile {} GlobCapS
    list [glob -nocomplain GlobC*] [glob -nocomplain globc*]






<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







33
34
35
36
37
38
39


















40
41
42
43
44
45
46
test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
    glob ~nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body {
    # The administrator account should always exist.
    glob ~administrator
} -match glob -result *


















test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
    catch {glob [email protected]}
} {0}

test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
    makeFile {} GlobCapS
    list [glob -nocomplain GlobC*] [glob -nocomplain globc*]

Changes to tests/winPipe.test.

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
...
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
    exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} {
    exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {win 95 exec cat32} {
    exec command /c type $path(big) |& $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.6 {32 bit comprehensive tests: from console} \
	{win cat32 AllocConsole} {
    # would block waiting for human input
} {}
test winpipe-1.7 {32 bit comprehensive tests: from NUL} {win exec cat32} {
    exec $cat32 < nul > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
................................................................................
    puts $f $big
    puts $f \032
    flush $f
    set r [read $f 64]
    catch {close $f}
    set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
test winpipe-1.22 {Checking command.com for Win95/98 hanging} {win 95 exec} {
    exec command.com /c dir /b
    set result 1
} 1

test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
    proc readResults {f} {
	global x result
	if { [eof $f] } {
	    close $f
	    set x 1






<
<
<
<







 







<
<
<
<







78
79
80
81
82
83
84




85
86
87
88
89
90
91
...
166
167
168
169
170
171
172




173
174
175
176
177
178
179
    exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} {
    exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"




test winpipe-1.6 {32 bit comprehensive tests: from console} \
	{win cat32 AllocConsole} {
    # would block waiting for human input
} {}
test winpipe-1.7 {32 bit comprehensive tests: from NUL} {win exec cat32} {
    exec $cat32 < nul > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
................................................................................
    puts $f $big
    puts $f \032
    flush $f
    set r [read $f 64]
    catch {close $f}
    set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"





test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
    proc readResults {f} {
	global x result
	if { [eof $f] } {
	    close $f
	    set x 1

Changes to unix/tclUnixThrd.c.

723
724
725
726
727
728
729

730
731
732
733
734
735
736
{
    if (ptr != NULL) {
	/*
	 * Called by the pthread lib when a thread exits
	 */

	TclFreeAllocCache(ptr);


    } else if (initialized) {
	/*
	 * Called by us in TclFinalizeThreadAlloc() during the library
	 * finalization initiated from Tcl_Finalize()
	 */







>







723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
{
    if (ptr != NULL) {
	/*
	 * Called by the pthread lib when a thread exits
	 */

	TclFreeAllocCache(ptr);
	pthread_setspecific(key, NULL);

    } else if (initialized) {
	/*
	 * Called by us in TclFinalizeThreadAlloc() during the library
	 * finalization initiated from Tcl_Finalize()
	 */