os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinChan.c
author sl@SLION-WIN7.fritz.box
Fri, 15 Jun 2012 03:10:57 +0200
changeset 0 bde4ae8d615e
permissions -rw-r--r--
First public contribution.
sl@0
     1
/* 
sl@0
     2
 * tclWinChan.c
sl@0
     3
 *
sl@0
     4
 *	Channel drivers for Windows channels based on files, command
sl@0
     5
 *	pipes and TCP sockets.
sl@0
     6
 *
sl@0
     7
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
sl@0
     8
 *
sl@0
     9
 * See the file "license.terms" for information on usage and redistribution
sl@0
    10
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0
    11
 *
sl@0
    12
 * RCS: @(#) $Id: tclWinChan.c,v 1.30.2.5 2006/08/30 17:53:28 hobbs Exp $
sl@0
    13
 */
sl@0
    14
sl@0
    15
#include "tclWinInt.h"
sl@0
    16
#include "tclIO.h"
sl@0
    17
sl@0
    18
/*
sl@0
    19
 * State flags used in the info structures below.
sl@0
    20
 */
sl@0
    21
sl@0
    22
#define FILE_PENDING	(1<<0)	/* Message is pending in the queue. */
sl@0
    23
#define FILE_ASYNC	(1<<1)	/* Channel is non-blocking. */
sl@0
    24
#define FILE_APPEND	(1<<2)	/* File is in append mode. */
sl@0
    25
sl@0
    26
#define FILE_TYPE_SERIAL  (FILE_TYPE_PIPE+1)
sl@0
    27
#define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)
sl@0
    28
sl@0
    29
/*
sl@0
    30
 * The following structure contains per-instance data for a file based channel.
sl@0
    31
 */
sl@0
    32
sl@0
    33
typedef struct FileInfo {
sl@0
    34
    Tcl_Channel channel;	/* Pointer to channel structure. */
sl@0
    35
    int validMask;		/* OR'ed combination of TCL_READABLE,
sl@0
    36
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
sl@0
    37
				 * which operations are valid on the file. */
sl@0
    38
    int watchMask;		/* OR'ed combination of TCL_READABLE,
sl@0
    39
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
sl@0
    40
				 * which events should be reported. */
sl@0
    41
    int flags;			/* State flags, see above for a list. */
sl@0
    42
    HANDLE handle;		/* Input/output file. */
sl@0
    43
    struct FileInfo *nextPtr;	/* Pointer to next registered file. */
sl@0
    44
    int dirty;                  /* Boolean flag. Set if the OS may have data
sl@0
    45
				 * pending on the channel */
sl@0
    46
} FileInfo;
sl@0
    47
sl@0
    48
typedef struct ThreadSpecificData {
sl@0
    49
    /*
sl@0
    50
     * List of all file channels currently open.
sl@0
    51
     */
sl@0
    52
sl@0
    53
    FileInfo *firstFilePtr;
sl@0
    54
} ThreadSpecificData;
sl@0
    55
sl@0
    56
static Tcl_ThreadDataKey dataKey;
sl@0
    57
sl@0
    58
/*
sl@0
    59
 * The following structure is what is added to the Tcl event queue when
sl@0
    60
 * file events are generated.
sl@0
    61
 */
sl@0
    62
sl@0
    63
typedef struct FileEvent {
sl@0
    64
    Tcl_Event header;		/* Information that is standard for
sl@0
    65
				 * all events. */
sl@0
    66
    FileInfo *infoPtr;		/* Pointer to file info structure.  Note
sl@0
    67
				 * that we still have to verify that the
sl@0
    68
				 * file exists before dereferencing this
sl@0
    69
				 * pointer. */
sl@0
    70
} FileEvent;
sl@0
    71
sl@0
    72
/*
sl@0
    73
 * Static routines for this file:
sl@0
    74
 */
sl@0
    75
sl@0
    76
static int		FileBlockProc _ANSI_ARGS_((ClientData instanceData,
sl@0
    77
			    int mode));
sl@0
    78
static void		FileChannelExitHandler _ANSI_ARGS_((
sl@0
    79
		            ClientData clientData));
sl@0
    80
static void		FileCheckProc _ANSI_ARGS_((ClientData clientData,
sl@0
    81
			    int flags));
sl@0
    82
static int		FileCloseProc _ANSI_ARGS_((ClientData instanceData,
sl@0
    83
		            Tcl_Interp *interp));
sl@0
    84
static int		FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr, 
sl@0
    85
			    int flags));
sl@0
    86
static int		FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
sl@0
    87
		            int direction, ClientData *handlePtr));
sl@0
    88
static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
sl@0
    89
static int		FileInputProc _ANSI_ARGS_((ClientData instanceData,
sl@0
    90
	            	    char *buf, int toRead, int *errorCode));
sl@0
    91
static int		FileOutputProc _ANSI_ARGS_((ClientData instanceData,
sl@0
    92
			    CONST char *buf, int toWrite, int *errorCode));
sl@0
    93
static int		FileSeekProc _ANSI_ARGS_((ClientData instanceData,
sl@0
    94
			    long offset, int mode, int *errorCode));
sl@0
    95
static Tcl_WideInt	FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
sl@0
    96
			    Tcl_WideInt offset, int mode, int *errorCode));
sl@0
    97
static void		FileSetupProc _ANSI_ARGS_((ClientData clientData,
sl@0
    98
			    int flags));
sl@0
    99
static void		FileWatchProc _ANSI_ARGS_((ClientData instanceData,
sl@0
   100
		            int mask));
sl@0
   101
static void             FileThreadActionProc _ANSI_ARGS_ ((
sl@0
   102
			   ClientData instanceData, int action));
sl@0
   103
static DWORD		FileGetType _ANSI_ARGS_((HANDLE handle));
sl@0
   104
sl@0
   105
/*
sl@0
   106
 * This structure describes the channel type structure for file based IO.
sl@0
   107
 */
sl@0
   108
sl@0
   109
static Tcl_ChannelType fileChannelType = {
sl@0
   110
    "file",			/* Type name. */
sl@0
   111
    TCL_CHANNEL_VERSION_4,	/* v4 channel */
sl@0
   112
    FileCloseProc,		/* Close proc. */
sl@0
   113
    FileInputProc,		/* Input proc. */
sl@0
   114
    FileOutputProc,		/* Output proc. */
sl@0
   115
    FileSeekProc,		/* Seek proc. */
sl@0
   116
    NULL,			/* Set option proc. */
sl@0
   117
    NULL,			/* Get option proc. */
sl@0
   118
    FileWatchProc,		/* Set up the notifier to watch the channel. */
sl@0
   119
    FileGetHandleProc,		/* Get an OS handle from channel. */
sl@0
   120
    NULL,			/* close2proc. */
sl@0
   121
    FileBlockProc,		/* Set blocking or non-blocking mode.*/
sl@0
   122
    NULL,			/* flush proc. */
sl@0
   123
    NULL,			/* handler proc. */
sl@0
   124
    FileWideSeekProc,		/* Wide seek proc. */
sl@0
   125
    FileThreadActionProc,	/* Thread action proc. */
sl@0
   126
};
sl@0
   127
sl@0
   128
#ifdef HAVE_NO_SEH
sl@0
   129
sl@0
   130
/*
sl@0
   131
 * Unlike Borland and Microsoft, we don't register exception handlers
sl@0
   132
 * by pushing registration records onto the runtime stack.  Instead, we
sl@0
   133
 * register them by creating an EXCEPTION_REGISTRATION within the activation
sl@0
   134
 * record.
sl@0
   135
 */
sl@0
   136
sl@0
   137
typedef struct EXCEPTION_REGISTRATION {
sl@0
   138
    struct EXCEPTION_REGISTRATION* link;
sl@0
   139
    EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*,
sl@0
   140
				      struct _CONTEXT*, void* );
sl@0
   141
    void* ebp;
sl@0
   142
    void* esp;
sl@0
   143
    int status;
sl@0
   144
} EXCEPTION_REGISTRATION;
sl@0
   145
sl@0
   146
#endif
sl@0
   147

sl@0
   148
/*
sl@0
   149
 *----------------------------------------------------------------------
sl@0
   150
 *
sl@0
   151
 * FileInit --
sl@0
   152
 *
sl@0
   153
 *	This function creates the window used to simulate file events.
sl@0
   154
 *
sl@0
   155
 * Results:
sl@0
   156
 *	None.
sl@0
   157
 *
sl@0
   158
 * Side effects:
sl@0
   159
 *	Creates a new window and creates an exit handler. 
sl@0
   160
 *
sl@0
   161
 *----------------------------------------------------------------------
sl@0
   162
 */
sl@0
   163
sl@0
   164
static ThreadSpecificData *
sl@0
   165
FileInit()
sl@0
   166
{
sl@0
   167
    ThreadSpecificData *tsdPtr =
sl@0
   168
	(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
sl@0
   169
    if (tsdPtr == NULL) {
sl@0
   170
	tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0
   171
	tsdPtr->firstFilePtr = NULL;
sl@0
   172
	Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
sl@0
   173
	Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
sl@0
   174
    }
sl@0
   175
    return tsdPtr;
sl@0
   176
}
sl@0
   177

sl@0
   178
/*
sl@0
   179
 *----------------------------------------------------------------------
sl@0
   180
 *
sl@0
   181
 * FileChannelExitHandler --
sl@0
   182
 *
sl@0
   183
 *	This function is called to cleanup the channel driver before
sl@0
   184
 *	Tcl is unloaded.
sl@0
   185
 *
sl@0
   186
 * Results:
sl@0
   187
 *	None.
sl@0
   188
 *
sl@0
   189
 * Side effects:
sl@0
   190
 *	Destroys the communication window.
sl@0
   191
 *
sl@0
   192
 *----------------------------------------------------------------------
sl@0
   193
 */
sl@0
   194
sl@0
   195
static void
sl@0
   196
FileChannelExitHandler(clientData)
sl@0
   197
    ClientData clientData;	/* Old window proc */
sl@0
   198
{
sl@0
   199
    Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
sl@0
   200
}
sl@0
   201

sl@0
   202
/*
sl@0
   203
 *----------------------------------------------------------------------
sl@0
   204
 *
sl@0
   205
 * FileSetupProc --
sl@0
   206
 *
sl@0
   207
 *	This procedure is invoked before Tcl_DoOneEvent blocks waiting
sl@0
   208
 *	for an event.
sl@0
   209
 *
sl@0
   210
 * Results:
sl@0
   211
 *	None.
sl@0
   212
 *
sl@0
   213
 * Side effects:
sl@0
   214
 *	Adjusts the block time if needed.
sl@0
   215
 *
sl@0
   216
 *----------------------------------------------------------------------
sl@0
   217
 */
sl@0
   218
sl@0
   219
void
sl@0
   220
FileSetupProc(data, flags)
sl@0
   221
    ClientData data;		/* Not used. */
sl@0
   222
    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
sl@0
   223
{
sl@0
   224
    FileInfo *infoPtr;
sl@0
   225
    Tcl_Time blockTime = { 0, 0 };
sl@0
   226
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0
   227
sl@0
   228
    if (!(flags & TCL_FILE_EVENTS)) {
sl@0
   229
	return;
sl@0
   230
    }
sl@0
   231
    
sl@0
   232
    /*
sl@0
   233
     * Check to see if there is a ready file.  If so, poll.
sl@0
   234
     */
sl@0
   235
sl@0
   236
    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
sl@0
   237
	    infoPtr = infoPtr->nextPtr) {
sl@0
   238
	if (infoPtr->watchMask) {
sl@0
   239
	    Tcl_SetMaxBlockTime(&blockTime);
sl@0
   240
	    break;
sl@0
   241
	}
sl@0
   242
    }
sl@0
   243
}
sl@0
   244

sl@0
   245
/*
sl@0
   246
 *----------------------------------------------------------------------
sl@0
   247
 *
sl@0
   248
 * FileCheckProc --
sl@0
   249
 *
sl@0
   250
 *	This procedure is called by Tcl_DoOneEvent to check the file
sl@0
   251
 *	event source for events. 
sl@0
   252
 *
sl@0
   253
 * Results:
sl@0
   254
 *	None.
sl@0
   255
 *
sl@0
   256
 * Side effects:
sl@0
   257
 *	May queue an event.
sl@0
   258
 *
sl@0
   259
 *----------------------------------------------------------------------
sl@0
   260
 */
sl@0
   261
sl@0
   262
static void
sl@0
   263
FileCheckProc(data, flags)
sl@0
   264
    ClientData data;		/* Not used. */
sl@0
   265
    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
sl@0
   266
{
sl@0
   267
    FileEvent *evPtr;
sl@0
   268
    FileInfo *infoPtr;
sl@0
   269
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0
   270
sl@0
   271
    if (!(flags & TCL_FILE_EVENTS)) {
sl@0
   272
	return;
sl@0
   273
    }
sl@0
   274
    
sl@0
   275
    /*
sl@0
   276
     * Queue events for any ready files that don't already have events
sl@0
   277
     * queued (caused by persistent states that won't generate WinSock
sl@0
   278
     * events).
sl@0
   279
     */
sl@0
   280
sl@0
   281
    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
sl@0
   282
	    infoPtr = infoPtr->nextPtr) {
sl@0
   283
	if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
sl@0
   284
	    infoPtr->flags |= FILE_PENDING;
sl@0
   285
	    evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
sl@0
   286
	    evPtr->header.proc = FileEventProc;
sl@0
   287
	    evPtr->infoPtr = infoPtr;
sl@0
   288
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
sl@0
   289
	}
sl@0
   290
    }
sl@0
   291
}
sl@0
   292

sl@0
   293
/*----------------------------------------------------------------------
sl@0
   294
 *
sl@0
   295
 * FileEventProc --
sl@0
   296
 *
sl@0
   297
 *	This function is invoked by Tcl_ServiceEvent when a file event
sl@0
   298
 *	reaches the front of the event queue.  This procedure invokes
sl@0
   299
 *	Tcl_NotifyChannel on the file.
sl@0
   300
 *
sl@0
   301
 * Results:
sl@0
   302
 *	Returns 1 if the event was handled, meaning it should be removed
sl@0
   303
 *	from the queue.  Returns 0 if the event was not handled, meaning
sl@0
   304
 *	it should stay on the queue.  The only time the event isn't
sl@0
   305
 *	handled is if the TCL_FILE_EVENTS flag bit isn't set.
sl@0
   306
 *
sl@0
   307
 * Side effects:
sl@0
   308
 *	Whatever the notifier callback does.
sl@0
   309
 *
sl@0
   310
 *----------------------------------------------------------------------
sl@0
   311
 */
sl@0
   312
sl@0
   313
static int
sl@0
   314
FileEventProc(evPtr, flags)
sl@0
   315
    Tcl_Event *evPtr;		/* Event to service. */
sl@0
   316
    int flags;			/* Flags that indicate what events to
sl@0
   317
				 * handle, such as TCL_FILE_EVENTS. */
sl@0
   318
{
sl@0
   319
    FileEvent *fileEvPtr = (FileEvent *)evPtr;
sl@0
   320
    FileInfo *infoPtr;
sl@0
   321
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0
   322
sl@0
   323
    if (!(flags & TCL_FILE_EVENTS)) {
sl@0
   324
	return 0;
sl@0
   325
    }
sl@0
   326
sl@0
   327
    /*
sl@0
   328
     * Search through the list of watched files for the one whose handle
sl@0
   329
     * matches the event.  We do this rather than simply dereferencing
sl@0
   330
     * the handle in the event so that files can be deleted while the
sl@0
   331
     * event is in the queue.
sl@0
   332
     */
sl@0
   333
sl@0
   334
    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
sl@0
   335
	    infoPtr = infoPtr->nextPtr) {
sl@0
   336
	if (fileEvPtr->infoPtr == infoPtr) {
sl@0
   337
	    infoPtr->flags &= ~(FILE_PENDING);
sl@0
   338
	    Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
sl@0
   339
	    break;
sl@0
   340
	}
sl@0
   341
    }
sl@0
   342
    return 1;
sl@0
   343
}
sl@0
   344

sl@0
   345
/*
sl@0
   346
 *----------------------------------------------------------------------
sl@0
   347
 *
sl@0
   348
 * FileBlockProc --
sl@0
   349
 *
sl@0
   350
 *	Set blocking or non-blocking mode on channel.
sl@0
   351
 *
sl@0
   352
 * Results:
sl@0
   353
 *	0 if successful, errno when failed.
sl@0
   354
 *
sl@0
   355
 * Side effects:
sl@0
   356
 *	Sets the device into blocking or non-blocking mode.
sl@0
   357
 *
sl@0
   358
 *----------------------------------------------------------------------
sl@0
   359
 */
sl@0
   360
sl@0
   361
static int
sl@0
   362
FileBlockProc(instanceData, mode)
sl@0
   363
    ClientData instanceData;	/* Instance data for channel. */
sl@0
   364
    int mode;			/* TCL_MODE_BLOCKING or
sl@0
   365
                                 * TCL_MODE_NONBLOCKING. */
sl@0
   366
{
sl@0
   367
    FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0
   368
    
sl@0
   369
    /*
sl@0
   370
     * Files on Windows can not be switched between blocking and nonblocking,
sl@0
   371
     * hence we have to emulate the behavior. This is done in the input
sl@0
   372
     * function by checking against a bit in the state. We set or unset the
sl@0
   373
     * bit here to cause the input function to emulate the correct behavior.
sl@0
   374
     */
sl@0
   375
sl@0
   376
    if (mode == TCL_MODE_NONBLOCKING) {
sl@0
   377
	infoPtr->flags |= FILE_ASYNC;
sl@0
   378
    } else {
sl@0
   379
	infoPtr->flags &= ~(FILE_ASYNC);
sl@0
   380
    }
sl@0
   381
    return 0;
sl@0
   382
}
sl@0
   383

sl@0
   384
/*
sl@0
   385
 *----------------------------------------------------------------------
sl@0
   386
 *
sl@0
   387
 * FileCloseProc --
sl@0
   388
 *
sl@0
   389
 *	Closes the IO channel.
sl@0
   390
 *
sl@0
   391
 * Results:
sl@0
   392
 *	0 if successful, the value of errno if failed.
sl@0
   393
 *
sl@0
   394
 * Side effects:
sl@0
   395
 *	Closes the physical channel
sl@0
   396
 *
sl@0
   397
 *----------------------------------------------------------------------
sl@0
   398
 */
sl@0
   399
sl@0
   400
static int
sl@0
   401
FileCloseProc(instanceData, interp)
sl@0
   402
    ClientData instanceData;	/* Pointer to FileInfo structure. */
sl@0
   403
    Tcl_Interp *interp;		/* Not used. */
sl@0
   404
{
sl@0
   405
    FileInfo *fileInfoPtr = (FileInfo *) instanceData;
sl@0
   406
    FileInfo *infoPtr;
sl@0
   407
    ThreadSpecificData *tsdPtr;
sl@0
   408
    int errorCode = 0;
sl@0
   409
sl@0
   410
    /*
sl@0
   411
     * Remove the file from the watch list.
sl@0
   412
     */
sl@0
   413
sl@0
   414
    FileWatchProc(instanceData, 0);
sl@0
   415
sl@0
   416
    /*
sl@0
   417
     * Don't close the Win32 handle if the handle is a standard channel
sl@0
   418
     * during the thread exit process.  Otherwise, one thread may kill
sl@0
   419
     * the stdio of another.
sl@0
   420
     */
sl@0
   421
sl@0
   422
    if (!TclInThreadExit() 
sl@0
   423
	    || ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
sl@0
   424
		&& (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
sl@0
   425
		&& (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
sl@0
   426
	if (CloseHandle(fileInfoPtr->handle) == FALSE) {
sl@0
   427
	    TclWinConvertError(GetLastError());
sl@0
   428
	    errorCode = errno;
sl@0
   429
	}
sl@0
   430
    }
sl@0
   431
sl@0
   432
    /*
sl@0
   433
     * See if this FileInfo* is still on the thread local list.
sl@0
   434
     */
sl@0
   435
    tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0
   436
    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
sl@0
   437
	    infoPtr = infoPtr->nextPtr) {
sl@0
   438
	if (infoPtr == fileInfoPtr) {
sl@0
   439
            /*
sl@0
   440
             * This channel exists on the thread local list. It should
sl@0
   441
             * have been removed by an earlier Thread Action call,
sl@0
   442
             * but do that now since just deallocating fileInfoPtr would
sl@0
   443
             * leave an deallocated pointer on the thread local list.
sl@0
   444
             */
sl@0
   445
	    FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
sl@0
   446
            break;
sl@0
   447
        }
sl@0
   448
    }
sl@0
   449
    ckfree((char *)fileInfoPtr);
sl@0
   450
    return errorCode;
sl@0
   451
}
sl@0
   452

sl@0
   453
/*
sl@0
   454
 *----------------------------------------------------------------------
sl@0
   455
 *
sl@0
   456
 * FileSeekProc --
sl@0
   457
 *
sl@0
   458
 *	Seeks on a file-based channel. Returns the new position.
sl@0
   459
 *
sl@0
   460
 * Results:
sl@0
   461
 *	-1 if failed, the new position if successful. If failed, it
sl@0
   462
 *	also sets *errorCodePtr to the error code.
sl@0
   463
 *
sl@0
   464
 * Side effects:
sl@0
   465
 *	Moves the location at which the channel will be accessed in
sl@0
   466
 *	future operations.
sl@0
   467
 *
sl@0
   468
 *----------------------------------------------------------------------
sl@0
   469
 */
sl@0
   470
sl@0
   471
static int
sl@0
   472
FileSeekProc(instanceData, offset, mode, errorCodePtr)
sl@0
   473
    ClientData instanceData;	/* File state. */
sl@0
   474
    long offset;		/* Offset to seek to. */
sl@0
   475
    int mode;			/* Relative to where should we seek? */
sl@0
   476
    int *errorCodePtr;		/* To store error code. */
sl@0
   477
{
sl@0
   478
    FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0
   479
    DWORD moveMethod;
sl@0
   480
    DWORD newPos, newPosHigh;
sl@0
   481
    DWORD oldPos, oldPosHigh;
sl@0
   482
sl@0
   483
    *errorCodePtr = 0;
sl@0
   484
    if (mode == SEEK_SET) {
sl@0
   485
        moveMethod = FILE_BEGIN;
sl@0
   486
    } else if (mode == SEEK_CUR) {
sl@0
   487
        moveMethod = FILE_CURRENT;
sl@0
   488
    } else {
sl@0
   489
        moveMethod = FILE_END;
sl@0
   490
    }
sl@0
   491
sl@0
   492
    /*
sl@0
   493
     * Save our current place in case we need to roll-back the seek.
sl@0
   494
     */
sl@0
   495
    oldPosHigh = (DWORD)0;
sl@0
   496
    oldPos = SetFilePointer(infoPtr->handle, (LONG)0, &oldPosHigh,
sl@0
   497
	    FILE_CURRENT);
sl@0
   498
    if (oldPos == INVALID_SET_FILE_POINTER) {
sl@0
   499
	DWORD winError = GetLastError();
sl@0
   500
	if (winError != NO_ERROR) {
sl@0
   501
	    TclWinConvertError(winError);
sl@0
   502
	    *errorCodePtr = errno;
sl@0
   503
	    return -1;
sl@0
   504
	}
sl@0
   505
    }
sl@0
   506
sl@0
   507
    newPosHigh = (DWORD)(offset < 0 ? -1 : 0);
sl@0
   508
    newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
sl@0
   509
			    moveMethod);
sl@0
   510
    if (newPos == INVALID_SET_FILE_POINTER) {
sl@0
   511
	DWORD winError = GetLastError();
sl@0
   512
	if (winError != NO_ERROR) {
sl@0
   513
	    TclWinConvertError(winError);
sl@0
   514
	    *errorCodePtr = errno;
sl@0
   515
	    return -1;
sl@0
   516
	}
sl@0
   517
    }
sl@0
   518
sl@0
   519
    /*
sl@0
   520
     * Check for expressability in our return type, and roll-back otherwise.
sl@0
   521
     */
sl@0
   522
    if (newPosHigh != 0) {
sl@0
   523
	*errorCodePtr = EOVERFLOW;
sl@0
   524
	SetFilePointer(infoPtr->handle, (LONG)oldPos, &oldPosHigh, FILE_BEGIN);
sl@0
   525
	return -1;
sl@0
   526
    }
sl@0
   527
    return (int) newPos;
sl@0
   528
}
sl@0
   529

sl@0
   530
/*
sl@0
   531
 *----------------------------------------------------------------------
sl@0
   532
 *
sl@0
   533
 * FileWideSeekProc --
sl@0
   534
 *
sl@0
   535
 *	Seeks on a file-based channel. Returns the new position.
sl@0
   536
 *
sl@0
   537
 * Results:
sl@0
   538
 *	-1 if failed, the new position if successful. If failed, it
sl@0
   539
 *	also sets *errorCodePtr to the error code.
sl@0
   540
 *
sl@0
   541
 * Side effects:
sl@0
   542
 *	Moves the location at which the channel will be accessed in
sl@0
   543
 *	future operations.
sl@0
   544
 *
sl@0
   545
 *----------------------------------------------------------------------
sl@0
   546
 */
sl@0
   547
sl@0
   548
static Tcl_WideInt
sl@0
   549
FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
sl@0
   550
    ClientData instanceData;	/* File state. */
sl@0
   551
    Tcl_WideInt offset;		/* Offset to seek to. */
sl@0
   552
    int mode;			/* Relative to where should we seek? */
sl@0
   553
    int *errorCodePtr;		/* To store error code. */
sl@0
   554
{
sl@0
   555
    FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0
   556
    DWORD moveMethod;
sl@0
   557
    DWORD newPos, newPosHigh;
sl@0
   558
sl@0
   559
    *errorCodePtr = 0;
sl@0
   560
    if (mode == SEEK_SET) {
sl@0
   561
        moveMethod = FILE_BEGIN;
sl@0
   562
    } else if (mode == SEEK_CUR) {
sl@0
   563
        moveMethod = FILE_CURRENT;
sl@0
   564
    } else {
sl@0
   565
        moveMethod = FILE_END;
sl@0
   566
    }
sl@0
   567
sl@0
   568
    newPosHigh = (DWORD)(offset >> 32);
sl@0
   569
    newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
sl@0
   570
			    moveMethod);
sl@0
   571
    if (newPos == INVALID_SET_FILE_POINTER) {
sl@0
   572
	DWORD winError = GetLastError();
sl@0
   573
	if (winError != NO_ERROR) {
sl@0
   574
	    TclWinConvertError(winError);
sl@0
   575
	    *errorCodePtr = errno;
sl@0
   576
	    return -1;
sl@0
   577
	}
sl@0
   578
    }
sl@0
   579
    return ((Tcl_WideInt) newPos) | (((Tcl_WideInt) newPosHigh) << 32);
sl@0
   580
}
sl@0
   581

sl@0
   582
/*
sl@0
   583
 *----------------------------------------------------------------------
sl@0
   584
 *
sl@0
   585
 * FileInputProc --
sl@0
   586
 *
sl@0
   587
 *	Reads input from the IO channel into the buffer given. Returns
sl@0
   588
 *	count of how many bytes were actually read, and an error indication.
sl@0
   589
 *
sl@0
   590
 * Results:
sl@0
   591
 *	A count of how many bytes were read is returned and an error
sl@0
   592
 *	indication is returned in an output argument.
sl@0
   593
 *
sl@0
   594
 * Side effects:
sl@0
   595
 *	Reads input from the actual channel.
sl@0
   596
 *
sl@0
   597
 *----------------------------------------------------------------------
sl@0
   598
 */
sl@0
   599
sl@0
   600
static int
sl@0
   601
FileInputProc(instanceData, buf, bufSize, errorCode)
sl@0
   602
    ClientData instanceData;		/* File state. */
sl@0
   603
    char *buf;				/* Where to store data read. */
sl@0
   604
    int bufSize;			/* How much space is available
sl@0
   605
                                         * in the buffer? */
sl@0
   606
    int *errorCode;			/* Where to store error code. */
sl@0
   607
{
sl@0
   608
    FileInfo *infoPtr;
sl@0
   609
    DWORD bytesRead;
sl@0
   610
sl@0
   611
    *errorCode = 0;
sl@0
   612
    infoPtr = (FileInfo *) instanceData;
sl@0
   613
sl@0
   614
    /*
sl@0
   615
     * Note that we will block on reads from a console buffer until a
sl@0
   616
     * full line has been entered.  The only way I know of to get
sl@0
   617
     * around this is to write a console driver.  We should probably
sl@0
   618
     * do this at some point, but for now, we just block.  The same
sl@0
   619
     * problem exists for files being read over the network.
sl@0
   620
     */
sl@0
   621
sl@0
   622
    if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
sl@0
   623
            (LPOVERLAPPED) NULL) != FALSE) {
sl@0
   624
	return bytesRead;
sl@0
   625
    }
sl@0
   626
    
sl@0
   627
    TclWinConvertError(GetLastError());
sl@0
   628
    *errorCode = errno;
sl@0
   629
    if (errno == EPIPE) {
sl@0
   630
	return 0;
sl@0
   631
    }
sl@0
   632
    return -1;
sl@0
   633
}
sl@0
   634

sl@0
   635
/*
sl@0
   636
 *----------------------------------------------------------------------
sl@0
   637
 *
sl@0
   638
 * FileOutputProc --
sl@0
   639
 *
sl@0
   640
 *	Writes the given output on the IO channel. Returns count of how
sl@0
   641
 *	many characters were actually written, and an error indication.
sl@0
   642
 *
sl@0
   643
 * Results:
sl@0
   644
 *	A count of how many characters were written is returned and an
sl@0
   645
 *	error indication is returned in an output argument.
sl@0
   646
 *
sl@0
   647
 * Side effects:
sl@0
   648
 *	Writes output on the actual channel.
sl@0
   649
 *
sl@0
   650
 *----------------------------------------------------------------------
sl@0
   651
 */
sl@0
   652
sl@0
   653
static int
sl@0
   654
FileOutputProc(instanceData, buf, toWrite, errorCode)
sl@0
   655
    ClientData instanceData;		/* File state. */
sl@0
   656
    CONST char *buf;			/* The data buffer. */
sl@0
   657
    int toWrite;			/* How many bytes to write? */
sl@0
   658
    int *errorCode;			/* Where to store error code. */
sl@0
   659
{
sl@0
   660
    FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0
   661
    DWORD bytesWritten;
sl@0
   662
    
sl@0
   663
    *errorCode = 0;
sl@0
   664
sl@0
   665
    /*
sl@0
   666
     * If we are writing to a file that was opened with O_APPEND, we need to
sl@0
   667
     * seek to the end of the file before writing the current buffer.
sl@0
   668
     */
sl@0
   669
sl@0
   670
    if (infoPtr->flags & FILE_APPEND) {
sl@0
   671
        SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
sl@0
   672
    }
sl@0
   673
sl@0
   674
    if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
sl@0
   675
            (LPOVERLAPPED) NULL) == FALSE) {
sl@0
   676
        TclWinConvertError(GetLastError());
sl@0
   677
        *errorCode = errno;
sl@0
   678
        return -1;
sl@0
   679
    }
sl@0
   680
    infoPtr->dirty = 1;
sl@0
   681
    return bytesWritten;
sl@0
   682
}
sl@0
   683

sl@0
   684
/*
sl@0
   685
 *----------------------------------------------------------------------
sl@0
   686
 *
sl@0
   687
 * FileWatchProc --
sl@0
   688
 *
sl@0
   689
 *	Called by the notifier to set up to watch for events on this
sl@0
   690
 *	channel.
sl@0
   691
 *
sl@0
   692
 * Results:
sl@0
   693
 *	None.
sl@0
   694
 *
sl@0
   695
 * Side effects:
sl@0
   696
 *	None.
sl@0
   697
 *
sl@0
   698
 *----------------------------------------------------------------------
sl@0
   699
 */
sl@0
   700
sl@0
   701
static void
sl@0
   702
FileWatchProc(instanceData, mask)
sl@0
   703
    ClientData instanceData;		/* File state. */
sl@0
   704
    int mask;				/* What events to watch for; OR-ed
sl@0
   705
                                         * combination of TCL_READABLE,
sl@0
   706
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
sl@0
   707
{
sl@0
   708
    FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0
   709
    Tcl_Time blockTime = { 0, 0 };
sl@0
   710
sl@0
   711
    /*
sl@0
   712
     * Since the file is always ready for events, we set the block time
sl@0
   713
     * to zero so we will poll.
sl@0
   714
     */
sl@0
   715
sl@0
   716
    infoPtr->watchMask = mask & infoPtr->validMask;
sl@0
   717
    if (infoPtr->watchMask) {
sl@0
   718
	Tcl_SetMaxBlockTime(&blockTime);
sl@0
   719
    }
sl@0
   720
}
sl@0
   721

sl@0
   722
/*
sl@0
   723
 *----------------------------------------------------------------------
sl@0
   724
 *
sl@0
   725
 * FileGetHandleProc --
sl@0
   726
 *
sl@0
   727
 *	Called from Tcl_GetChannelHandle to retrieve OS handles from
sl@0
   728
 *	a file based channel.
sl@0
   729
 *
sl@0
   730
 * Results:
sl@0
   731
 *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
sl@0
   732
 *	there is no handle for the specified direction. 
sl@0
   733
 *
sl@0
   734
 * Side effects:
sl@0
   735
 *	None.
sl@0
   736
 *
sl@0
   737
 *----------------------------------------------------------------------
sl@0
   738
 */
sl@0
   739
sl@0
   740
static int
sl@0
   741
FileGetHandleProc(instanceData, direction, handlePtr)
sl@0
   742
    ClientData instanceData;	/* The file state. */
sl@0
   743
    int direction;		/* TCL_READABLE or TCL_WRITABLE */
sl@0
   744
    ClientData *handlePtr;	/* Where to store the handle.  */
sl@0
   745
{
sl@0
   746
    FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0
   747
sl@0
   748
    if (direction & infoPtr->validMask) {
sl@0
   749
	*handlePtr = (ClientData) infoPtr->handle;
sl@0
   750
	return TCL_OK;
sl@0
   751
    } else {
sl@0
   752
	return TCL_ERROR;
sl@0
   753
    }
sl@0
   754
}
sl@0
   755
sl@0
   756

sl@0
   757
/*
sl@0
   758
 *----------------------------------------------------------------------
sl@0
   759
 *
sl@0
   760
 * TclpOpenFileChannel --
sl@0
   761
 *
sl@0
   762
 *	Open an File based channel on Unix systems.
sl@0
   763
 *
sl@0
   764
 * Results:
sl@0
   765
 *	The new channel or NULL. If NULL, the output argument
sl@0
   766
 *	errorCodePtr is set to a POSIX error.
sl@0
   767
 *
sl@0
   768
 * Side effects:
sl@0
   769
 *	May open the channel and may cause creation of a file on the
sl@0
   770
 *	file system.
sl@0
   771
 *
sl@0
   772
 *----------------------------------------------------------------------
sl@0
   773
 */
sl@0
   774
sl@0
   775
Tcl_Channel
sl@0
   776
TclpOpenFileChannel(interp, pathPtr, mode, permissions)
sl@0
   777
    Tcl_Interp *interp;			/* Interpreter for error reporting;
sl@0
   778
                                         * can be NULL. */
sl@0
   779
    Tcl_Obj *pathPtr;			/* Name of file to open. */
sl@0
   780
    int mode;				/* POSIX mode. */
sl@0
   781
    int permissions;			/* If the open involves creating a
sl@0
   782
                                         * file, with what modes to create
sl@0
   783
                                         * it? */
sl@0
   784
{
sl@0
   785
    Tcl_Channel channel = 0;
sl@0
   786
    int channelPermissions;
sl@0
   787
    DWORD accessMode, createMode, shareMode, flags;
sl@0
   788
    CONST TCHAR *nativeName;
sl@0
   789
    HANDLE handle;
sl@0
   790
    char channelName[16 + TCL_INTEGER_SPACE];
sl@0
   791
    TclFile readFile = NULL;
sl@0
   792
    TclFile writeFile = NULL;
sl@0
   793
sl@0
   794
    nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
sl@0
   795
    if (nativeName == NULL) {
sl@0
   796
	return NULL;
sl@0
   797
    }
sl@0
   798
    
sl@0
   799
    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
sl@0
   800
	case O_RDONLY:
sl@0
   801
	    accessMode = GENERIC_READ;
sl@0
   802
	    channelPermissions = TCL_READABLE;
sl@0
   803
	    break;
sl@0
   804
	case O_WRONLY:
sl@0
   805
	    accessMode = GENERIC_WRITE;
sl@0
   806
	    channelPermissions = TCL_WRITABLE;
sl@0
   807
	    break;
sl@0
   808
	case O_RDWR:
sl@0
   809
	    accessMode = (GENERIC_READ | GENERIC_WRITE);
sl@0
   810
	    channelPermissions = (TCL_READABLE | TCL_WRITABLE);
sl@0
   811
	    break;
sl@0
   812
	default:
sl@0
   813
	    panic("TclpOpenFileChannel: invalid mode value");
sl@0
   814
	    break;
sl@0
   815
    }
sl@0
   816
sl@0
   817
    /*
sl@0
   818
     * Map the creation flags to the NT create mode.
sl@0
   819
     */
sl@0
   820
sl@0
   821
    switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
sl@0
   822
	case (O_CREAT | O_EXCL):
sl@0
   823
	case (O_CREAT | O_EXCL | O_TRUNC):
sl@0
   824
	    createMode = CREATE_NEW;
sl@0
   825
	    break;
sl@0
   826
	case (O_CREAT | O_TRUNC):
sl@0
   827
	    createMode = CREATE_ALWAYS;
sl@0
   828
	    break;
sl@0
   829
	case O_CREAT:
sl@0
   830
	    createMode = OPEN_ALWAYS;
sl@0
   831
	    break;
sl@0
   832
	case O_TRUNC:
sl@0
   833
	case (O_TRUNC | O_EXCL):
sl@0
   834
	    createMode = TRUNCATE_EXISTING;
sl@0
   835
	    break;
sl@0
   836
	default:
sl@0
   837
	    createMode = OPEN_EXISTING;
sl@0
   838
	    break;
sl@0
   839
    }
sl@0
   840
sl@0
   841
    /*
sl@0
   842
     * If the file is being created, get the file attributes from the
sl@0
   843
     * permissions argument, else use the existing file attributes.
sl@0
   844
     */
sl@0
   845
sl@0
   846
    if (mode & O_CREAT) {
sl@0
   847
        if (permissions & S_IWRITE) {
sl@0
   848
            flags = FILE_ATTRIBUTE_NORMAL;
sl@0
   849
        } else {
sl@0
   850
            flags = FILE_ATTRIBUTE_READONLY;
sl@0
   851
        }
sl@0
   852
    } else {
sl@0
   853
	flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
sl@0
   854
        if (flags == 0xFFFFFFFF) {
sl@0
   855
	    flags = 0;
sl@0
   856
	}
sl@0
   857
    }
sl@0
   858
sl@0
   859
    /*
sl@0
   860
     * Set up the file sharing mode.  We want to allow simultaneous access.
sl@0
   861
     */
sl@0
   862
sl@0
   863
    shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
sl@0
   864
sl@0
   865
    /*
sl@0
   866
     * Now we get to create the file.
sl@0
   867
     */
sl@0
   868
sl@0
   869
    handle = (*tclWinProcs->createFileProc)(nativeName, accessMode, 
sl@0
   870
	    shareMode, NULL, createMode, flags, (HANDLE) NULL);
sl@0
   871
sl@0
   872
    if (handle == INVALID_HANDLE_VALUE) {
sl@0
   873
	DWORD err;
sl@0
   874
	err = GetLastError();
sl@0
   875
	if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
sl@0
   876
	    err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
sl@0
   877
	}
sl@0
   878
        TclWinConvertError(err);
sl@0
   879
	if (interp != (Tcl_Interp *) NULL) {
sl@0
   880
            Tcl_AppendResult(interp, "couldn't open \"", 
sl@0
   881
			     Tcl_GetString(pathPtr), "\": ",
sl@0
   882
			     Tcl_PosixError(interp), (char *) NULL);
sl@0
   883
        }
sl@0
   884
        return NULL;
sl@0
   885
    }
sl@0
   886
    
sl@0
   887
    channel = NULL;
sl@0
   888
sl@0
   889
    switch ( FileGetType(handle) ) {
sl@0
   890
    case FILE_TYPE_SERIAL:
sl@0
   891
	/*
sl@0
   892
	 * Reopen channel for OVERLAPPED operation
sl@0
   893
	 * Normally this shouldn't fail, because the channel exists
sl@0
   894
	 */
sl@0
   895
	handle = TclWinSerialReopen(handle, nativeName, accessMode);
sl@0
   896
	if (handle == INVALID_HANDLE_VALUE) {
sl@0
   897
	    TclWinConvertError(GetLastError());
sl@0
   898
	    if (interp != (Tcl_Interp *) NULL) {
sl@0
   899
		Tcl_AppendResult(interp, "couldn't reopen serial \"",
sl@0
   900
			Tcl_GetString(pathPtr), "\": ",
sl@0
   901
			Tcl_PosixError(interp), (char *) NULL);
sl@0
   902
	    }
sl@0
   903
	    return NULL;
sl@0
   904
	}
sl@0
   905
	channel = TclWinOpenSerialChannel(handle, channelName,
sl@0
   906
	        channelPermissions);
sl@0
   907
	break;
sl@0
   908
    case FILE_TYPE_CONSOLE:
sl@0
   909
	channel = TclWinOpenConsoleChannel(handle, channelName,
sl@0
   910
	        channelPermissions);
sl@0
   911
	break;
sl@0
   912
    case FILE_TYPE_PIPE:
sl@0
   913
	if (channelPermissions & TCL_READABLE) {
sl@0
   914
	    readFile = TclWinMakeFile(handle);
sl@0
   915
	}
sl@0
   916
	if (channelPermissions & TCL_WRITABLE) {
sl@0
   917
	    writeFile = TclWinMakeFile(handle);
sl@0
   918
	}
sl@0
   919
	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
sl@0
   920
	break;
sl@0
   921
    case FILE_TYPE_CHAR:
sl@0
   922
    case FILE_TYPE_DISK:
sl@0
   923
    case FILE_TYPE_UNKNOWN:
sl@0
   924
	channel = TclWinOpenFileChannel(handle, channelName,
sl@0
   925
					channelPermissions,
sl@0
   926
					(mode & O_APPEND) ? FILE_APPEND : 0);
sl@0
   927
	break;
sl@0
   928
sl@0
   929
    default:
sl@0
   930
	/*
sl@0
   931
	 * The handle is of an unknown type, probably /dev/nul equivalent
sl@0
   932
	 * or possibly a closed handle.  
sl@0
   933
	 */
sl@0
   934
	
sl@0
   935
	channel = NULL;
sl@0
   936
	Tcl_AppendResult(interp, "couldn't open \"", 
sl@0
   937
			 Tcl_GetString(pathPtr), "\": ",
sl@0
   938
			 "bad file type", (char *) NULL);
sl@0
   939
	break;
sl@0
   940
    }
sl@0
   941
sl@0
   942
    return channel;
sl@0
   943
}
sl@0
   944

sl@0
   945
/*
sl@0
   946
 *----------------------------------------------------------------------
sl@0
   947
 *
sl@0
   948
 * Tcl_MakeFileChannel --
sl@0
   949
 *
sl@0
   950
 *	Creates a Tcl_Channel from an existing platform specific file
sl@0
   951
 *	handle.
sl@0
   952
 *
sl@0
   953
 * Results:
sl@0
   954
 *	The Tcl_Channel created around the preexisting file.
sl@0
   955
 *
sl@0
   956
 * Side effects:
sl@0
   957
 *	None.
sl@0
   958
 *
sl@0
   959
 *----------------------------------------------------------------------
sl@0
   960
 */
sl@0
   961
sl@0
   962
Tcl_Channel
sl@0
   963
Tcl_MakeFileChannel(rawHandle, mode)
sl@0
   964
    ClientData rawHandle;	/* OS level handle */
sl@0
   965
    int mode;			/* ORed combination of TCL_READABLE and
sl@0
   966
                                 * TCL_WRITABLE to indicate file mode. */
sl@0
   967
{
sl@0
   968
#ifdef HAVE_NO_SEH
sl@0
   969
    EXCEPTION_REGISTRATION registration;
sl@0
   970
#endif
sl@0
   971
    char channelName[16 + TCL_INTEGER_SPACE];
sl@0
   972
    Tcl_Channel channel = NULL;
sl@0
   973
    HANDLE handle = (HANDLE) rawHandle;
sl@0
   974
    HANDLE dupedHandle;
sl@0
   975
    TclFile readFile = NULL;
sl@0
   976
    TclFile writeFile = NULL;
sl@0
   977
    BOOL result;
sl@0
   978
sl@0
   979
    if (mode == 0) {
sl@0
   980
	return NULL;
sl@0
   981
    }
sl@0
   982
sl@0
   983
    switch (FileGetType(handle))
sl@0
   984
    {
sl@0
   985
    case FILE_TYPE_SERIAL:
sl@0
   986
	channel = TclWinOpenSerialChannel(handle, channelName, mode);
sl@0
   987
	break;
sl@0
   988
    case FILE_TYPE_CONSOLE:
sl@0
   989
	channel = TclWinOpenConsoleChannel(handle, channelName, mode);
sl@0
   990
	break;
sl@0
   991
    case FILE_TYPE_PIPE:
sl@0
   992
	if (mode & TCL_READABLE)
sl@0
   993
	{
sl@0
   994
	    readFile = TclWinMakeFile(handle);
sl@0
   995
	}
sl@0
   996
	if (mode & TCL_WRITABLE)
sl@0
   997
	{
sl@0
   998
	    writeFile = TclWinMakeFile(handle);
sl@0
   999
	}
sl@0
  1000
	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
sl@0
  1001
	break;
sl@0
  1002
sl@0
  1003
    case FILE_TYPE_DISK:
sl@0
  1004
    case FILE_TYPE_CHAR:
sl@0
  1005
	channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
sl@0
  1006
	break;
sl@0
  1007
	
sl@0
  1008
    case FILE_TYPE_UNKNOWN:
sl@0
  1009
    default:
sl@0
  1010
	/*
sl@0
  1011
	 * The handle is of an unknown type.  Test the validity of this OS
sl@0
  1012
	 * handle by duplicating it, then closing the dupe.  The Win32 API
sl@0
  1013
	 * doesn't provide an IsValidHandle() function, so we have to emulate
sl@0
  1014
	 * it here.  This test will not work on a console handle reliably,
sl@0
  1015
	 * which is why we can't test every handle that comes into this
sl@0
  1016
	 * function in this way.
sl@0
  1017
	 */
sl@0
  1018
sl@0
  1019
	result = DuplicateHandle(GetCurrentProcess(), handle,
sl@0
  1020
		GetCurrentProcess(), &dupedHandle, 0, FALSE,
sl@0
  1021
		DUPLICATE_SAME_ACCESS);
sl@0
  1022
sl@0
  1023
	if (result == 0) {
sl@0
  1024
	    /* 
sl@0
  1025
	     * Unable to make a duplicate. It's definately invalid at this
sl@0
  1026
	     * point.
sl@0
  1027
	     */
sl@0
  1028
sl@0
  1029
	    return NULL;
sl@0
  1030
	}
sl@0
  1031
sl@0
  1032
	/*
sl@0
  1033
	 * Use structured exception handling (Win32 SEH) to protect the close
sl@0
  1034
	 * of this duped handle which might throw EXCEPTION_INVALID_HANDLE.
sl@0
  1035
	 */
sl@0
  1036
sl@0
  1037
	result = 0;
sl@0
  1038
#ifndef HAVE_NO_SEH
sl@0
  1039
	__try {
sl@0
  1040
	    CloseHandle(dupedHandle);
sl@0
  1041
	    result = 1;
sl@0
  1042
	} __except (EXCEPTION_EXECUTE_HANDLER) {}
sl@0
  1043
#else
sl@0
  1044
	/*
sl@0
  1045
	 * Don't have SEH available, do things the hard way.
sl@0
  1046
	 * Note that this needs to be one block of asm, to avoid stack
sl@0
  1047
	 * imbalance; also, it is illegal for one asm block to contain 
sl@0
  1048
	 * a jump to another.
sl@0
  1049
	 */
sl@0
  1050
	
sl@0
  1051
	__asm__ __volatile__ (
sl@0
  1052
sl@0
  1053
	    /*
sl@0
  1054
	     * Pick up parameters before messing with the stack
sl@0
  1055
	     */
sl@0
  1056
sl@0
  1057
	    "movl       %[dupedHandle], %%ebx"          "\n\t"
sl@0
  1058
sl@0
  1059
	    /*
sl@0
  1060
	     * Construct an EXCEPTION_REGISTRATION to protect the
sl@0
  1061
	     * call to CloseHandle
sl@0
  1062
	     */
sl@0
  1063
	    "leal       %[registration], %%edx"         "\n\t"
sl@0
  1064
	    "movl       %%fs:0,         %%eax"          "\n\t"
sl@0
  1065
	    "movl       %%eax,          0x0(%%edx)"     "\n\t" /* link */
sl@0
  1066
	    "leal       1f,             %%eax"          "\n\t"
sl@0
  1067
	    "movl       %%eax,          0x4(%%edx)"     "\n\t" /* handler */
sl@0
  1068
	    "movl       %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
sl@0
  1069
	    "movl       %%esp,          0xc(%%edx)"     "\n\t" /* esp */
sl@0
  1070
	    "movl       $0,             0x10(%%edx)"    "\n\t" /* status */
sl@0
  1071
	
sl@0
  1072
	    /* Link the EXCEPTION_REGISTRATION on the chain */
sl@0
  1073
	    
sl@0
  1074
	    "movl       %%edx,          %%fs:0"         "\n\t"
sl@0
  1075
	    
sl@0
  1076
	    /* Call CloseHandle( dupedHandle ) */
sl@0
  1077
	    
sl@0
  1078
	    "pushl      %%ebx"                          "\n\t"
sl@0
  1079
	    "call       _CloseHandle@4"                 "\n\t"
sl@0
  1080
	    
sl@0
  1081
	    /* 
sl@0
  1082
	     * Come here on normal exit.  Recover the EXCEPTION_REGISTRATION
sl@0
  1083
	     * and put a TRUE status return into it.
sl@0
  1084
	     */
sl@0
  1085
	    
sl@0
  1086
	    "movl       %%fs:0,         %%edx"          "\n\t"
sl@0
  1087
	    "movl	$1,		%%eax"		"\n\t"
sl@0
  1088
	    "movl       %%eax,          0x10(%%edx)"    "\n\t"
sl@0
  1089
	    "jmp        2f"                             "\n"
sl@0
  1090
	    
sl@0
  1091
	    /*
sl@0
  1092
	     * Come here on an exception.  Recover the EXCEPTION_REGISTRATION
sl@0
  1093
	     */
sl@0
  1094
	    
sl@0
  1095
	    "1:"                                        "\t"
sl@0
  1096
	    "movl       %%fs:0,         %%edx"          "\n\t"
sl@0
  1097
	    "movl       0x8(%%edx),     %%edx"          "\n\t"
sl@0
  1098
	    
sl@0
  1099
	    /* 
sl@0
  1100
	     * Come here however we exited.  Restore context from the
sl@0
  1101
	     * EXCEPTION_REGISTRATION in case the stack is unbalanced.
sl@0
  1102
	     */
sl@0
  1103
	    
sl@0
  1104
	    "2:"                                        "\t"
sl@0
  1105
	    "movl       0xc(%%edx),     %%esp"          "\n\t"
sl@0
  1106
	    "movl       0x8(%%edx),     %%ebp"          "\n\t"
sl@0
  1107
	    "movl       0x0(%%edx),     %%eax"          "\n\t"
sl@0
  1108
	    "movl       %%eax,          %%fs:0"         "\n\t"
sl@0
  1109
	    
sl@0
  1110
	    :
sl@0
  1111
	    /* No outputs */
sl@0
  1112
	    :
sl@0
  1113
	    [registration]  "m"     (registration),
sl@0
  1114
	    [dupedHandle]   "m"	    (dupedHandle)
sl@0
  1115
	    :
sl@0
  1116
	    "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
sl@0
  1117
	    );
sl@0
  1118
	result = registration.status;
sl@0
  1119
sl@0
  1120
#endif
sl@0
  1121
	if (result == FALSE) {
sl@0
  1122
	    return NULL;
sl@0
  1123
	}
sl@0
  1124
sl@0
  1125
	/* Fall through, the handle is valid. */
sl@0
  1126
sl@0
  1127
	/*
sl@0
  1128
	 * Create the undefined channel, anyways, because we know the handle
sl@0
  1129
	 * is valid to something.
sl@0
  1130
	 */
sl@0
  1131
sl@0
  1132
	channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
sl@0
  1133
    }
sl@0
  1134
sl@0
  1135
    return channel;
sl@0
  1136
}
sl@0
  1137

sl@0
  1138
/*
sl@0
  1139
 *----------------------------------------------------------------------
sl@0
  1140
 *
sl@0
  1141
 * TclpGetDefaultStdChannel --
sl@0
  1142
 *
sl@0
  1143
 *	Constructs a channel for the specified standard OS handle.
sl@0
  1144
 *
sl@0
  1145
 * Results:
sl@0
  1146
 *	Returns the specified default standard channel, or NULL.
sl@0
  1147
 *
sl@0
  1148
 * Side effects:
sl@0
  1149
 *	May cause the creation of a standard channel and the underlying
sl@0
  1150
 *	file.
sl@0
  1151
 *
sl@0
  1152
 *----------------------------------------------------------------------
sl@0
  1153
 */
sl@0
  1154
sl@0
  1155
Tcl_Channel
sl@0
  1156
TclpGetDefaultStdChannel(type)
sl@0
  1157
    int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
sl@0
  1158
{
sl@0
  1159
    Tcl_Channel channel;
sl@0
  1160
    HANDLE handle;
sl@0
  1161
    int mode;
sl@0
  1162
    char *bufMode;
sl@0
  1163
    DWORD handleId;		/* Standard handle to retrieve. */
sl@0
  1164
sl@0
  1165
sl@0
  1166
    switch (type) {
sl@0
  1167
	case TCL_STDIN:
sl@0
  1168
	    handleId = STD_INPUT_HANDLE;
sl@0
  1169
	    mode = TCL_READABLE;
sl@0
  1170
	    bufMode = "line";
sl@0
  1171
	    break;
sl@0
  1172
	case TCL_STDOUT:
sl@0
  1173
	    handleId = STD_OUTPUT_HANDLE;
sl@0
  1174
	    mode = TCL_WRITABLE;
sl@0
  1175
	    bufMode = "line";
sl@0
  1176
	    break;
sl@0
  1177
	case TCL_STDERR:
sl@0
  1178
	    handleId = STD_ERROR_HANDLE;
sl@0
  1179
	    mode = TCL_WRITABLE;
sl@0
  1180
	    bufMode = "none";
sl@0
  1181
	    break;
sl@0
  1182
	default:
sl@0
  1183
	    panic("TclGetDefaultStdChannel: Unexpected channel type");
sl@0
  1184
	    break;
sl@0
  1185
    }
sl@0
  1186
sl@0
  1187
    handle = GetStdHandle(handleId);
sl@0
  1188
sl@0
  1189
    /*
sl@0
  1190
     * Note that we need to check for 0 because Windows may return 0 if this
sl@0
  1191
     * is not a console mode application, even though this is not a valid
sl@0
  1192
     * handle.
sl@0
  1193
     */
sl@0
  1194
sl@0
  1195
    if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
sl@0
  1196
	return (Tcl_Channel) NULL;
sl@0
  1197
    }
sl@0
  1198
sl@0
  1199
    channel = Tcl_MakeFileChannel(handle, mode);
sl@0
  1200
sl@0
  1201
    if (channel == NULL) {
sl@0
  1202
	return (Tcl_Channel) NULL;
sl@0
  1203
    }
sl@0
  1204
sl@0
  1205
    /*
sl@0
  1206
     * Set up the normal channel options for stdio handles.
sl@0
  1207
     */
sl@0
  1208
sl@0
  1209
    if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
sl@0
  1210
            "auto") == TCL_ERROR)
sl@0
  1211
	    || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
sl@0
  1212
		    "\032 {}") == TCL_ERROR)
sl@0
  1213
	    || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,
sl@0
  1214
		    "-buffering", bufMode) == TCL_ERROR)) {
sl@0
  1215
        Tcl_Close((Tcl_Interp *) NULL, channel);
sl@0
  1216
        return (Tcl_Channel) NULL;
sl@0
  1217
    }
sl@0
  1218
    return channel;
sl@0
  1219
}
sl@0
  1220
sl@0
  1221
sl@0
  1222

sl@0
  1223
/*
sl@0
  1224
 *----------------------------------------------------------------------
sl@0
  1225
 *
sl@0
  1226
 * TclWinOpenFileChannel --
sl@0
  1227
 *
sl@0
  1228
 *	Constructs a File channel for the specified standard OS handle.
sl@0
  1229
 *      This is a helper function to break up the construction of 
sl@0
  1230
 *      channels into File, Console, or Serial.
sl@0
  1231
 *
sl@0
  1232
 * Results:
sl@0
  1233
 *	Returns the new channel, or NULL.
sl@0
  1234
 *
sl@0
  1235
 * Side effects:
sl@0
  1236
 *	May open the channel and may cause creation of a file on the
sl@0
  1237
 *	file system.
sl@0
  1238
 *
sl@0
  1239
 *----------------------------------------------------------------------
sl@0
  1240
 */
sl@0
  1241
sl@0
  1242
Tcl_Channel
sl@0
  1243
TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
sl@0
  1244
    HANDLE handle;
sl@0
  1245
    char *channelName;
sl@0
  1246
    int permissions;
sl@0
  1247
    int appendMode;
sl@0
  1248
{
sl@0
  1249
    FileInfo *infoPtr;
sl@0
  1250
    ThreadSpecificData *tsdPtr;
sl@0
  1251
sl@0
  1252
    tsdPtr = FileInit();
sl@0
  1253
sl@0
  1254
    /*
sl@0
  1255
     * See if a channel with this handle already exists.
sl@0
  1256
     */
sl@0
  1257
    
sl@0
  1258
    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
sl@0
  1259
	 infoPtr = infoPtr->nextPtr) {
sl@0
  1260
	if (infoPtr->handle == (HANDLE) handle) {
sl@0
  1261
	    return (permissions == infoPtr->validMask) ? infoPtr->channel : NULL;
sl@0
  1262
	}
sl@0
  1263
    }
sl@0
  1264
sl@0
  1265
    infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
sl@0
  1266
    /* TIP #218. Removed the code inserting the new structure
sl@0
  1267
     * into the global list. This is now handled in the thread
sl@0
  1268
     * action callbacks, and only there.
sl@0
  1269
     */
sl@0
  1270
    infoPtr->nextPtr = NULL;
sl@0
  1271
    infoPtr->validMask = permissions;
sl@0
  1272
    infoPtr->watchMask = 0;
sl@0
  1273
    infoPtr->flags = appendMode;
sl@0
  1274
    infoPtr->handle = handle;
sl@0
  1275
    infoPtr->dirty = 0;
sl@0
  1276
    wsprintfA(channelName, "file%lx", (int) infoPtr);
sl@0
  1277
    
sl@0
  1278
    infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
sl@0
  1279
	    (ClientData) infoPtr, permissions);
sl@0
  1280
    
sl@0
  1281
    /*
sl@0
  1282
     * Files have default translation of AUTO and ^Z eof char, which
sl@0
  1283
     * means that a ^Z will be accepted as EOF when reading.
sl@0
  1284
     */
sl@0
  1285
    
sl@0
  1286
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
sl@0
  1287
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
sl@0
  1288
sl@0
  1289
    return infoPtr->channel;
sl@0
  1290
}
sl@0
  1291
sl@0
  1292
sl@0
  1293
/*
sl@0
  1294
 *----------------------------------------------------------------------
sl@0
  1295
 *
sl@0
  1296
 * TclWinFlushDirtyChannels --
sl@0
  1297
 *
sl@0
  1298
 *	Flush all dirty channels to disk, so that requesting the
sl@0
  1299
 *	size of any file returns the correct value.
sl@0
  1300
 *
sl@0
  1301
 * Results:
sl@0
  1302
 *	None.
sl@0
  1303
 *
sl@0
  1304
 * Side effects:
sl@0
  1305
 *	Information is actually written to disk now, rather than
sl@0
  1306
 *	later.  Don't call this too often, or there will be a 
sl@0
  1307
 *	performance hit (i.e. only call when we need to ask for
sl@0
  1308
 *	the size of a file).
sl@0
  1309
 *
sl@0
  1310
 *----------------------------------------------------------------------
sl@0
  1311
 */
sl@0
  1312
sl@0
  1313
void
sl@0
  1314
TclWinFlushDirtyChannels ()
sl@0
  1315
{
sl@0
  1316
    FileInfo *infoPtr;
sl@0
  1317
    ThreadSpecificData *tsdPtr;
sl@0
  1318
sl@0
  1319
    tsdPtr = FileInit();
sl@0
  1320
sl@0
  1321
    /*
sl@0
  1322
     * Flush all channels which are dirty, i.e. may have data pending
sl@0
  1323
     * in the OS
sl@0
  1324
     */
sl@0
  1325
    
sl@0
  1326
    for (infoPtr = tsdPtr->firstFilePtr;
sl@0
  1327
	 infoPtr != NULL; 
sl@0
  1328
	 infoPtr = infoPtr->nextPtr) {
sl@0
  1329
	if (infoPtr->dirty) {
sl@0
  1330
	    FlushFileBuffers(infoPtr->handle);
sl@0
  1331
	    infoPtr->dirty = 0;
sl@0
  1332
	}
sl@0
  1333
    }
sl@0
  1334
}
sl@0
  1335

sl@0
  1336
/*
sl@0
  1337
 *----------------------------------------------------------------------
sl@0
  1338
 *
sl@0
  1339
 * FileThreadActionProc --
sl@0
  1340
 *
sl@0
  1341
 *	Insert or remove any thread local refs to this channel.
sl@0
  1342
 *
sl@0
  1343
 * Results:
sl@0
  1344
 *	None.
sl@0
  1345
 *
sl@0
  1346
 * Side effects:
sl@0
  1347
 *	Changes thread local list of valid channels.
sl@0
  1348
 *
sl@0
  1349
 *----------------------------------------------------------------------
sl@0
  1350
 */
sl@0
  1351
sl@0
  1352
static void
sl@0
  1353
FileThreadActionProc (instanceData, action)
sl@0
  1354
     ClientData instanceData;
sl@0
  1355
     int action;
sl@0
  1356
{
sl@0
  1357
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0
  1358
    FileInfo *infoPtr = (FileInfo *) instanceData;
sl@0
  1359
sl@0
  1360
    if (action == TCL_CHANNEL_THREAD_INSERT) {
sl@0
  1361
        infoPtr->nextPtr = tsdPtr->firstFilePtr;
sl@0
  1362
	tsdPtr->firstFilePtr = infoPtr;
sl@0
  1363
    } else {
sl@0
  1364
        FileInfo **nextPtrPtr;
sl@0
  1365
	int removed = 0;
sl@0
  1366
sl@0
  1367
	for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
sl@0
  1368
	     nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
sl@0
  1369
	    if ((*nextPtrPtr) == infoPtr) {
sl@0
  1370
	        (*nextPtrPtr) = infoPtr->nextPtr;
sl@0
  1371
		removed = 1;
sl@0
  1372
		break;
sl@0
  1373
	    }
sl@0
  1374
	}
sl@0
  1375
sl@0
  1376
	/*
sl@0
  1377
	 * This could happen if the channel was created in one thread
sl@0
  1378
	 * and then moved to another without updating the thread
sl@0
  1379
	 * local data in each thread.
sl@0
  1380
	 */
sl@0
  1381
sl@0
  1382
	if (!removed) {
sl@0
  1383
	    panic("file info ptr not on thread channel list");
sl@0
  1384
	}
sl@0
  1385
    }
sl@0
  1386
}
sl@0
  1387
sl@0
  1388
sl@0
  1389
/*
sl@0
  1390
 *----------------------------------------------------------------------
sl@0
  1391
 *
sl@0
  1392
 * FileGetType --
sl@0
  1393
 *
sl@0
  1394
 *	Given a file handle, return its type
sl@0
  1395
 *
sl@0
  1396
 * Results:
sl@0
  1397
 *	None.
sl@0
  1398
 *
sl@0
  1399
 * Side effects:
sl@0
  1400
 *	None.
sl@0
  1401
 *
sl@0
  1402
 *----------------------------------------------------------------------
sl@0
  1403
 */
sl@0
  1404
sl@0
  1405
DWORD
sl@0
  1406
FileGetType(handle)
sl@0
  1407
    HANDLE handle; /* Opened file handle */
sl@0
  1408
{ 
sl@0
  1409
    DWORD type;
sl@0
  1410
    DWORD consoleParams;
sl@0
  1411
    DCB dcb;
sl@0
  1412
sl@0
  1413
    type = GetFileType(handle);
sl@0
  1414
sl@0
  1415
    /*
sl@0
  1416
     * If the file is a character device, we need to try to figure out
sl@0
  1417
     * whether it is a serial port, a console, or something else.  We
sl@0
  1418
     * test for the console case first because this is more common.
sl@0
  1419
     */
sl@0
  1420
    
sl@0
  1421
    if (type == FILE_TYPE_CHAR || (type == FILE_TYPE_UNKNOWN && !GetLastError())) {
sl@0
  1422
	    if (GetConsoleMode(handle, &consoleParams)) {
sl@0
  1423
	      type = FILE_TYPE_CONSOLE;
sl@0
  1424
      } else {
sl@0
  1425
	      dcb.DCBlength = sizeof( DCB ) ;
sl@0
  1426
	      if (GetCommState(handle, &dcb)) {
sl@0
  1427
		      type = FILE_TYPE_SERIAL;
sl@0
  1428
        }
sl@0
  1429
      }
sl@0
  1430
    }
sl@0
  1431
sl@0
  1432
    return type;
sl@0
  1433
}