2005-02-01  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch]  Merged with HEAD as of today.
	
	* generic/tclInt.decls: 
	    Changed numbers of new stubs to resolve a conflict.
	* generic/tclInt.h:
	    Added new TclStrToD routine that replaces the native
	    'strtod' throughout Tcl.
	* generic/tclCmdMZ (Tcl_StringObjCmd):
	* generic/tclGet.c (Tcl_GetDouble):
	* generic/tclObj.c (SetBooleanFromAny, SetDoubleFromAny):
	* generic/tclParseExpr.c (GetLexeme):
	* generic/tclScan.c (Tcl_ScanObjCmd):
	    Replaced all uses of the native 'strtod' with a TclStrToD
	    routine that performs correct rounding and handles denormals.
	* generic/tclStrToD.c: (new file)
	    New scanning function for extracting 'double' from a string
	    that rounds correctly, and handles denormals and infinities.

	These changes represent a partial implementation of TIP #132.
	Output conversion of floating point numbers, and proper handling
	of infinities within expressions, still need to be addressed.
	
2005-02-01  Don Porter  <dgp@users.sourceforge.net>

        * generic/tclExecute.c (TclCompEvalObj): Removed stray statement
        left behind in prior code reorganization.

2005-01-31  Don Porter  <dgp@users.sourceforge.net>

	* unix/configure:	autoconf-2.57

2005-01-30  Joe English  <jenglish@users.sourceforge.net>

	* unix/configure.in: Restored two double-evals that were
	removed in the DBGX purge; these are still needed on some
	platforms to account for TCL_TRIM_DOTS.  [Bug 1112654]

	* unix/configure: NOT REGENERATED: only have autoconf 2.59 here,
	need to find someone with autoconf 2.57.

2005-01-28  Jeff Hobbs  <jeffh@ActiveState.com>

	* unix/configure, unix/tcl.m4: add solaris 64-bit gcc build
	support. [Bug 1021871]

2005-01-28  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* tests/expr-old.test (expr-old-37.2): Added test for [Bug 1109484]

2005-01-27  Jeff Hobbs  <jeffh@ActiveState.com>

	* generic/tclBasic.c (Tcl_ExprBoolean, Tcl_ExprDouble) 
	(Tcl_ExprLong): Fix to recognize Tcl_WideInt type. [Bug 1109484]

2005-01-26  Andreas Kupries <andreask@activestate.com>

	TIP#218 IMPLEMENTATION

	* generic/tclDecls.h:	Regenerated from tcl.decls.
	* generic/tclStubInit.c:	

	* doc/CrtChannel.3:	Documentation of extended API,
	* generic/tcl.decls:	extended testsuite, and
	* generic/tcl.h:	implementation. Removal of old
	* generic/tclIO.c:	driver-specific TclpCut/Splice
	* generic/tclInt.h:	functions. Replaced with generic
	* tests/io.test:	thread-action calls through the
	* unix/tclUnixChan.c:	new hooks. Update of all builtin
	* unix/tclUnixPipe.c:	channel drivers to version 4.
	* unix/tclUnixSock.c:	Windows drivers extended to 
	* win/tclWinChan.c:	manage thread state in a thread
	* win/tclWinConsole.c:	action handler.
	* win/tclWinPipe.c:	
	* win/tclWinSerial.c:	
	* win/tclWinSock.c:	

2005-01-25  Don Porter  <dgp@users.sourceforge.net>

	* library/auto.tcl:	Updated [auto_reset] to clear auto-loaded
	commands in namespaces other than :: and to clear auto-loaded commands
	that do not happen to be procs.  [Bug 1101670]
	***POTENTIAL INCOMPATIBILITY***

2005-01-25  Daniel Steffen  <das@users.sourceforge.net>

	* unix/tcl.m4 (Darwin): fixed bug with static build linking to
	dynamic library in /usr/lib etc instead of linking to static library
	earlier in search path. [Tcl Bug 956908]
	Removed obsolete references to Rhapsody. 
	* unix/configure: autoconf-2.57

2005-01-21  Andreas Kupries <andreask@activestate.com>

	* generic/tclStubInit.c: Regenerated the stubs support code from
	* generic/tclDecls.h:    the modified tcl.decls (TIP #233, see below).

	* doc/GetTime.3:       Implemented TIP #233, i.e. the
	* generic/tcl.decls:   'Virtualization of Tcl's Sense of Time'.
	* generic/tcl.h:       Declared, implemented, and documented the
	* generic/tclInt.h:    specified new API functions. Moved the
	* unix/tclUnixEvent.c: native (OS) access to time information
	* unix/tclUnixNotfy.c: into standard handler functions. Inserted
	* unix/tclUnixTime.c:  hooks calling on the handlers where native
	* win/tclWinNotify.c:  access was done before, and where scaling
	* win/tclWinTime.c:    between domains (real/virtual) is required.

2005-01-21  Andreas Kupries <andreask@activestate.com>

	* generic/tclThread.c: Typo police. Fixed some nits
	* generic/tclCmdAH.c:  in header comments of functions.
	* generic/tclBasic.c:  (Missing --).
	* generic/tclFileName.c:

2005-01-21  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* doc/FileSystem.3: Add missing ARGUMENTS section definitions for
	arguments to Tcl_FSLink. [Bug 1106272]

2005-01-21  Kevin B. Kenny  <kennykb@acm.org>

	[kennykb-numerics-branch]

	* unix/Makefile.in:     Updated Makefile to build libtommath on
				Unix as well as Windows. [Bug 1106865]

'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1997-2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" RCS: @(#) $Id: CrtChannel.3,v 1.24.2.1 2005/02/02 15:53:12 kennykb Exp $
.so man.macros
.TH Tcl_CreateChannel 3 8.4 Tcl "Tcl Library Procedures"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelWideSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_ChannelThreadActionProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Channel
\fBTcl_CreateChannel\fR(\fItypePtr, channelName, instanceData, mask\fR)
.sp

.sp
Tcl_DriverSeekProc *
\fBTcl_ChannelSeekProc\fR(\fItypePtr\fR)
.sp
.VS 8.4
Tcl_DriverWideSeekProc *
\fBTcl_ChannelWideSeekProc\fR(\fItypePtr\fR)
.sp
Tcl_DriverThreadActionProc *
\fBTcl_ChannelThreadActionProc\fR(\fItypePtr\fR)
.VE 8.4
.sp
Tcl_DriverSetOptionProc *
\fBTcl_ChannelSetOptionProc\fR(\fItypePtr\fR)
.sp
Tcl_DriverGetOptionProc *
\fBTcl_ChannelGetOptionProc\fR(\fItypePtr\fR)

name is registered in the (thread)-global list of all channels (result
== 1) or not (result == 0).
.PP
\fBTcl_CutChannel\fR removes the specified \fIchannel\fR from the
(thread)global list of all channels (of the current thread).
Application to a channel still registered in some interpreter
is not allowed.
.VS 8.5
Also notifies the driver if the \fBTcl_ChannelType\fR version is
\fBTCL_CHANNEL_VERSION_4\fR (or higher), and
\fBTcl_DriverThreadActionProc\fR is defined for it.
.VE 8.5
.PP
\fBTcl_SpliceChannel\fR adds the specified \fIchannel\fR to the
(thread)global list of all channels (of the current thread).
Application to a channel registered in some interpreter is not allowed.
.VS 8.5
Also notifies the driver if the \fBTcl_ChannelType\fR version is
\fBTCL_CHANNEL_VERSION_4\fR (or higher), and
\fBTcl_DriverThreadActionProc\fR is defined for it.
.VE 8.5
.PP
\fBTcl_ClearChannelHandlers\fR removes all channelhandlers and event
scripts associated with the specified \fIchannel\fR, thus shutting
down all event processing for this channel.
.VE 8.4
.SH TCL_CHANNELTYPE
.PP
A channel driver provides a \fBTcl_ChannelType\fR structure that contains
pointers to functions that implement the various operations on a channel;
these operations are invoked as needed by the generic layer.  The structure
was versioned starting in Tcl 8.3.2/8.4 to correct a problem with stacked
channel drivers.  See the \fBOLD CHANNEL TYPES\fR section below for
details about the old structure.
.PP
The \fBTcl_ChannelType\fR structure contains the following fields:
.CS
typedef struct Tcl_ChannelType {
	char *\fItypeName\fR;
	Tcl_ChannelTypeVersion \fIversion\fR;
	Tcl_DriverCloseProc *\fIcloseProc\fR;
	Tcl_DriverInputProc *\fIinputProc\fR;
	Tcl_DriverOutputProc *\fIoutputProc\fR;
	Tcl_DriverSeekProc *\fIseekProc\fR;
	Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
	Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
	Tcl_DriverWatchProc *\fIwatchProc\fR;
	Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
	Tcl_DriverClose2Proc *\fIclose2Proc\fR;
	Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
	Tcl_DriverFlushProc *\fIflushProc\fR;
	Tcl_DriverHandlerProc *\fIhandlerProc\fR;
	Tcl_DriverWideSeekProc *\fIwideSeekProc\fR;
	Tcl_DriverThreadActionProc *\fIthreadActionProc\fR;
} Tcl_ChannelType;
.CE
.PP
The driver must provide implementations for all functions except
\fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR,
\fIgetOptionProc\fR, and \fIclose2Proc\fR, which may be specified as
NULL.  Other functions that can not be implemented for this type of
device should return \fBEINVAL\fR when invoked to indicate that they
are not implemented, except in the case of \fIflushProc\fR and
\fIhandlerProc\fR, which should specified as NULL if not otherwise defined.
.PP
The user should only use the above structure for \fBTcl_ChannelType\fR
instantiation.  When referencing fields in a \fBTcl_ChannelType\fR
structure, the following functions should be used to obtain the values:
\fBTcl_ChannelName\fR, \fBTcl_ChannelVersion\fR,
\fBTcl_ChannelBlockModeProc\fR, \fBTcl_ChannelCloseProc\fR,
\fBTcl_ChannelClose2Proc\fR, \fBTcl_ChannelInputProc\fR,
\fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelSeekProc\fR,
.VS 8.4
\fBTcl_ChannelWideSeekProc\fR,
\fBTcl_ChannelThreadActionProc\fR,
.VE 8.4
\fBTcl_ChannelSetOptionProc\fR, \fBTcl_ChannelGetOptionProc\fR,
\fBTcl_ChannelWatchProc\fR, \fBTcl_ChannelGetHandleProc\fR,
\fBTcl_ChannelFlushProc\fR, or \fBTcl_ChannelHandlerProc\fR.
.PP
The change to the structures was made in such a way that standard channel
types are binary compatible.  However, channel types that use stacked
channels (i.e. TLS, Trf) have new versions to correspond to the above change
since the previous code for stacked channels had problems.
.SS TYPENAME
.PP
The \fItypeName\fR field contains a null-terminated string that
identifies the type of the device implemented by this driver, e.g.
\fBfile\fR or \fBsocket\fR.
.PP
This value can be retrieved with \fBTcl_ChannelName\fR, which returns
a pointer to the string.
.SS VERSION
.PP

The \fIversion\fR field should be set to the version of the structure
that you require. \fBTCL_CHANNEL_VERSION_2\fR is the minimum recommended.
.VS 8.4
\fBTCL_CHANNEL_VERSION_3\fR must be set to specifiy the \fIwideSeekProc\fR member.
.VE 8.4
.VS 8.5
\fBTCL_CHANNEL_VERSION_4\fR must be set to specifiy the
\fIthreadActionProc\fR member (includes \fIwideSeekProc\fR).
.VE 8.5
If it is not set to any of these, then this
\fBTcl_ChannelType\fR is assumed to have the original structure.  See
\fBOLD CHANNEL TYPES\fR for more details.  While Tcl will recognize
and function with either structures, stacked channels must be of at
least \fBTCL_CHANNEL_VERSION_2\fR to function correctly.
.PP
This value can be retrieved with \fBTcl_ChannelVersion\fR, which returns
.VS 8.4
one of \fBTCL_CHANNEL_VERSION_4\fR, \fBTCL_CHANNEL_VERSION_3\fR,
.VE 8.4
\fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR.
.SS BLOCKMODEPROC
.PP
The \fIblockModeProc\fR field contains the address of a function called by
the generic layer to set blocking and nonblocking mode on the device.
\fIBlockModeProc\fR should match the following prototype:

\fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR
when this channel was created.  The \fIinterestMask\fR is an OR-ed
combination of \fBTCL_READABLE\fR or \fBTCL_WRITABLE\fR; it indicates what
type of event occurred on this channel.
.PP
This value can be retrieved with \fBTcl_ChannelHandlerProc\fR, which returns
a pointer to the function.

.VS 8.4
.SS "THREADACTIONPROC"
.PP
The \fthreadActionProc\fR field contains the address of the function
called by the generic layer when a channel is created, closed, or
going to move to a different thread, i.e. whenever thread-specific
driver state might have to initialized or updated. It can be NULL.
The action \fITCL_CHANNEL_THREAD_REMOVE\fR is used to notify the
driver that it should update or remove any thread-specific data it
might be maintaining for the channel.
.PP
The action \fITCL_CHANNEL_THREAD_INSERT\fR is used to notify the
driver that it should update or initialize any thread-specific data it
might be maintaining using the calling thread as the associate. See
\fBTcl_CutChannel\fR and \fBTcl_SpliceChannel\fR for more detail.
.PP
.CS
typedef void Tcl_DriverThreadActionProc(
	ClientData \fIinstanceData\fR,
      int        \fIaction\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created.
.PP
These values can be retrieved with \fBTcl_ChannelThreadActionProc\fR,
which returns a pointer to the function.
.VE 8.4

.SH TCL_BADCHANNELOPTION
.PP
This procedure generates a "bad option" error message in an
(optional) interpreter.  It is used by channel drivers when 
an invalid Set/Get option is requested. Its purpose is to concatenate
the generic options list to the specific ones and factorize
the generic options error message string.

'\"
'\" Copyright (c) 2001 Vincent Darley
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: FileSystem.3,v 1.50.2.1 2005/02/02 15:53:12 kennykb Exp $
'\" 
.so man.macros
.TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSLoadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_AllocStatBuf \- procedures to interact with any filesystem
.SH SYNOPSIS

If non-NULL, filled with the number of elements in the split path.
.AP Tcl_Obj *basePtr in
The base path on to which to join the given elements.  May be NULL.
.AP int objc in
The number of elements in \fIobjv\fR.
.AP "Tcl_Obj *const" objv[] in
The elements to join to the given base path.
.AP Tcl_Obj *linkNamePtr in
The name of the link to be created or read.
.AP Tcl_Obj *toPtr in
What the link called \fIlinkNamePtr\fR should be linked to, or NULL if
the symbolic link specified by \fIlinkNamePtr\fR is to be read.
.AP int linkAction in
OR-ed combination of flags indicating what kind of link should be
created (will be ignored if \fItoPtr\fR is NULL). Valid bits to set
are \fBTCL_CREATE_SYMBOLIC_LINK\fR and \fBTCL_CREATE_HARD_LINK\fR.
When both flags are set and the underlying filesystem can do either,
symbolic links are preferred.
.BE

.SH DESCRIPTION
.PP
There are several reasons for calling the \fBTcl_FS\fR API functions
(e.g. \fBTcl_FSAccess\fR and \fBTcl_FSStat\fR)
rather than calling system level functions like \fBaccess\fR and

.SH NAME
Tcl_GetTime \- get date and time
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_GetTime\fR(\fItimePtr\fR)
.sp
\fBTcl_SetTimeProc\fR(\fIgetProc, scaleProc, clientData\fR)
.sp
\fBTcl_QueryTimeProc\fR(\fIgetProcPtr, scaleProcPtr, clientDataPtr\fR)
.SH ARGUMENTS
.AS "Tcl_Time *" timePtr out
.AP "Tcl_Time *" timePtr out
Points to memory in which to store the date and time information.
.AS "Tcl_GetTimeProc *" getProc in
.AP "Tcl_GetTimeProc *" getProc in
Pointer to handler function replacing Tcl_GetTime's access to the OS.
.AS "Tcl_ScaleTimeProc *" scaleProc in
.AP "Tcl_ScaleTimeProc *" scaleProc in
Pointer to handler function for the conversion of time delays in the
virtual domain to real-time.
.AS "ClientData *" clientData in
.AP "ClientData *" clientData in
Value passed through to the two handler functions.
.AS "Tcl_GetTimeProc **" getProcPtr inout
.AP "Tcl_GetTimeProc **" getProcPtr inout
Pointer to place the currently registered get handler function into.
.AS "Tcl_ScaleTimeProc **" scaleProcPtr inout
.AP "Tcl_ScaleTimeProc **" scaleProcPtr inout
Pointer to place the currently registered scale handler function into.
.AS "ClientData **" clientDataPtr inout
.AP "ClientData **" clientDataPtr inout
Pointer to place the currently registered pass-through value into.
.BE
.SH DESCRIPTION
.PP
The \fBTcl_GetTime\fR function retrieves the current time as a
\fITcl_Time\fR structure in memory the caller provides.  This
structure has the following definition:
.CS

microseconds that have elapsed since the start of the second
designated by \fIsec\fR.  The Tcl library makes every effort to keep
this number as precise as possible, subject to the limitations of the
computer system.  On multiprocessor variants of Windows, this number
may be limited to the 10- or 20-ms granularity of the system clock.
(On single-processor Windows systems, the \fIusec\fR field is derived
from a performance counter and is highly precise.)
.PP
The \fBTcl_SetTime\fR function registers two related handler functions
with the core. The first handler function is a replacement for
\fBTcl_GetTime\fR, or rather the OS access made by
\fBTcl_GetTime\fR. The other handler function is used by the Tcl
notifier to convert wait/block times from the virtual domain into real
time.
.PP
The \fBTcl_QueryTime\fR function returns the currently registered
handler functions. If no external handlers were set then this will
return the standard handlers accessing and processing the native time
of the OS. The arguments to the function are allowed to be NULL; and
any argument which is NULL is ignored and not set.
.PP
Any handler pair specified has to return data which is consistent
between them. In other words, setting one handler of the pair to
something assuming a 10-times slowdown, and the other handler of the
pair to something assuming a two-times slowdown is wrong and not
allowed.
.PP
The set handler functions are allowed to run the delivered time
backwards, however this should be avoided. We have to allow it as the
native time can run backwards as the user can fiddle with the system
time one way or other. Note that the insertion of the hooks will not
change the behaviour of the Tcl core with regard to this situation,
i.e. the existing behaviour is retained.
.SH "SEE ALSO"
clock
.SH KEYWORDS
date, time

# tcl.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Tcl library via the stubs table.
#	This file is used to generate the tclDecls.h, tclPlatDecls.h,
#	tclStub.c, and tclPlatStub.c files.
#	
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: tcl.decls,v 1.105.2.5 2005/02/02 15:53:14 kennykb Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private

    int Tcl_GetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token,
	    int *flagsPtr)
}
declare 551 generic {
    int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, Tcl_Command token,
	    Tcl_Namespace **namespacePtrPtr)
}
# TIP#233 (Virtualized Time)
declare 552 generic {
    void Tcl_SetTimeProc (Tcl_GetTimeProc* getProc,
	    Tcl_ScaleTimeProc* scaleProc,
	    ClientData clientData)
}
declare 553 generic {
    void Tcl_QueryTimeProc (Tcl_GetTimeProc** getProc,
	    Tcl_ScaleTimeProc** scaleProc,
	    ClientData* clientData)
}
# TIP#218 (Driver Thread Actions) davygrvy/akupries ChannelType ver 4
declare 554 generic {
    Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(Tcl_ChannelType *chanTypePtr)
}

# TIP #237:

declare 555 generic {
    Tcl_Obj* Tcl_NewBignumObj( mp_int* value )
}
declare 556 generic {
    Tcl_Obj* Tcl_DbNewBignumObj( mp_int* value, CONST char* file, int line )
}
declare 557 generic {
    void Tcl_SetBignumObj( Tcl_Obj* obj, mp_int* value )
}
declare 558 generic {
    int Tcl_GetBignumFromObj( Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value )
}

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

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

 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tcl.h,v 1.191.2.6 2005/02/02 15:53:15 kennykb Exp $
 */

#ifndef _TCL
#define _TCL

/*
 *  * For C++ compilers, use extern "C"

    long sec;			/* Seconds. */
    long usec;			/* Microseconds. */
} Tcl_Time;

typedef void (Tcl_SetTimerProc) _ANSI_ARGS_((Tcl_Time *timePtr));
typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));

/* TIP #233 (Virtualized Time)
 */
typedef void (Tcl_GetTimeProc)   _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));
typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));


/*
 * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler
 * to indicate what sorts of events are of interest:
 */
#define TCL_READABLE	(1<<1)
#define TCL_WRITABLE	(1<<2)

/*
 * Channel version tag.  This was introduced in 8.3.2/8.4.
 */
#define TCL_CHANNEL_VERSION_1	((Tcl_ChannelTypeVersion) 0x1)
#define TCL_CHANNEL_VERSION_2	((Tcl_ChannelTypeVersion) 0x2)
#define TCL_CHANNEL_VERSION_3	((Tcl_ChannelTypeVersion) 0x3)
#define TCL_CHANNEL_VERSION_4	((Tcl_ChannelTypeVersion) 0x4)

/*
 * TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc
 */

#define TCL_CHANNEL_THREAD_INSERT (0)
#define TCL_CHANNEL_THREAD_REMOVE (1)

/*
 * Typedefs for the various operations in a channel type:
 */
typedef int	(Tcl_DriverBlockModeProc) _ANSI_ARGS_((
		    ClientData instanceData, int mode));
typedef int	(Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData,

		    ClientData instanceData));
typedef int	(Tcl_DriverHandlerProc) _ANSI_ARGS_((
		    ClientData instanceData, int interestMask));
typedef Tcl_WideInt (Tcl_DriverWideSeekProc) _ANSI_ARGS_((
		    ClientData instanceData, Tcl_WideInt offset,
		    int mode, int *errorCodePtr));

/* TIP #218, Channel Thread Actions */
typedef void     (Tcl_DriverThreadActionProc) _ANSI_ARGS_ ((
		    ClientData instanceData, int action));

/*
 * The following declarations either map ckalloc and ckfree to
 * malloc and free, or they map them to procedures with all sorts
 * of debugging hooks defined in tclCkalloc.c.
 */
#ifdef TCL_MEM_DEBUG

     */
    Tcl_DriverWideSeekProc *wideSeekProc;
					/* Procedure to call to seek
					 * on the channel which can
					 * handle 64-bit offsets. May be
					 * NULL, and must be NULL if
					 * seekProc is NULL. */

     /*
      * Only valid in TCL_CHANNEL_VERSION_4 channels or later
      * TIP #218, Channel Thread Actions
      */
     Tcl_DriverThreadActionProc *threadActionProc;
 					/* Procedure to call to notify
 					 * the driver of thread specific
 					 * activity for a channel.
					 * May be NULL. */
} Tcl_ChannelType;

/*
 * The following flags determine whether the blockModeProc above should
 * set the channel into blocking or nonblocking mode. They are passed
 * as arguments to the blockModeProc procedure in the above structure.
 */

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclBasic.c,v 1.136.2.3 2005/02/02 15:53:15 kennykb Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * Static procedures in this file:

	exprPtr = Tcl_NewStringObj(string, length);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
	if (result == TCL_OK) {
	    /*
	     * Store an integer based on the expression result.
	     */

	    if (resultPtr->typePtr == &tclIntType) {
		*ptr = resultPtr->internalRep.longValue;
	    } else if (resultPtr->typePtr == &tclDoubleType) {
		*ptr = (long) resultPtr->internalRep.doubleValue;
	    } else if (resultPtr->typePtr == &tclWideIntType) {
#ifndef TCL_WIDE_INT_IS_LONG
		/*
		 * See Tcl_GetIntFromObj for conversion comments.
		 */
		Tcl_WideInt w = resultPtr->internalRep.wideValue;
		if ((w >= -(Tcl_WideInt)(ULONG_MAX))
			&& (w <= (Tcl_WideInt)(ULONG_MAX))) {
		    *ptr = Tcl_WideAsLong(w);
		} else {
		    Tcl_SetResult(interp,
			    "integer value too large to represent as non-long integer",
			    TCL_STATIC);
		    result = TCL_ERROR;
		}
#else
		*ptr = resultPtr->internalRep.longValue;
#endif
	    } else {
		Tcl_SetResult(interp,
		        "expression didn't have numeric value", TCL_STATIC);
		result = TCL_ERROR;
	    }
	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
	} else {

	exprPtr = Tcl_NewStringObj(string, length);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
	if (result == TCL_OK) {
	    /*
	     * Store a double  based on the expression result.
	     */

	    if (resultPtr->typePtr == &tclIntType) {
		*ptr = (double) resultPtr->internalRep.longValue;
	    } else if (resultPtr->typePtr == &tclDoubleType) {
		*ptr = resultPtr->internalRep.doubleValue;
	    } else if (resultPtr->typePtr == &tclWideIntType) {
#ifndef TCL_WIDE_INT_IS_LONG
		/*
		 * See Tcl_GetIntFromObj for conversion comments.
		 */
		Tcl_WideInt w = resultPtr->internalRep.wideValue;
		if ((w >= -(Tcl_WideInt)(ULONG_MAX))
			&& (w <= (Tcl_WideInt)(ULONG_MAX))) {
		    *ptr = (double) Tcl_WideAsLong(w);
		} else {
		    Tcl_SetResult(interp,
			    "integer value too large to represent as non-long integer",
			    TCL_STATIC);
		    result = TCL_ERROR;
		}
#else
		*ptr = (double) resultPtr->internalRep.longValue;
#endif
	    } else {
		Tcl_SetResult(interp,
		        "expression didn't have numeric value", TCL_STATIC);
		result = TCL_ERROR;
	    }
	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
	} else {

	exprPtr = Tcl_NewStringObj(string, length);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
	if (result == TCL_OK) {
	    /*
	     * Store a boolean based on the expression result.
	     */

	    if (resultPtr->typePtr == &tclIntType) {
		*ptr = (resultPtr->internalRep.longValue != 0);
	    } else if (resultPtr->typePtr == &tclDoubleType) {
		*ptr = (resultPtr->internalRep.doubleValue != 0.0);
	    } else if (resultPtr->typePtr == &tclWideIntType) {
#ifndef TCL_WIDE_INT_IS_LONG
		*ptr = (resultPtr->internalRep.wideValue != 0);
#else
		*ptr = (resultPtr->internalRep.longValue != 0);
#endif
	    } else {
		result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
	    }
	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
	}
	if (result != TCL_OK) {
	    /*

    iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVersion --
 *
 *	Get the Tcl major, minor, and patchlevel version numbers and
 *      the release type.  A patch is a release type TCL_FINAL_RELEASE
 *      with a patchLevel > 0.
 *
 * Results:
 *	None.

/* 
 * tclCmdAH.c --
 *
 *	This file contains the top-level command routines for most of
 *	the Tcl built-in commands whose names begin with the letters
 *	A to H.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdAH.c,v 1.57.2.1 2005/02/02 15:53:17 kennykb Exp $
 */

#include "tclInt.h"
#include <locale.h>

/*
 * Prototypes for local procedures defined in this file:

    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ContinueObjCmd --
 *
 *	This procedure is invoked to process the "continue" Tcl command.
 *	See the user documentation for details on what it does.
 *
 *	With the bytecode compiler, this procedure is only called when
 *	a command name is computed at runtime, and is "continue" or the name
 *	to which "continue" was renamed: e.g., "set z continue; $z"

 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2003 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdMZ.c,v 1.115.2.1 2005/02/02 15:53:17 kennykb Exp $
 */

#include "tclInt.h"
#include "tclRegexp.h"

/*
 *----------------------------------------------------------------------

				result = 0;
				failat = -1;
			    }
			    break;
			}
		    }
		    errno = 0;
		    TclStrToD(string1, (CONST char **) &stop); /* INTL: Tcl source. */
		    if (errno == ERANGE) {
			/*
			 * if (errno == ERANGE), then it was an over/underflow
			 * problem, but in this method, we only want to know
			 * yes or no, so bad flow returns 0 (false) and sets
			 * the failVarObj to the string length.
			 */

/*
 * tclDecls.h --
 *
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclDecls.h,v 1.107.2.4 2005/02/02 15:53:18 kennykb Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl

#endif
#ifndef Tcl_GetEnsembleNamespace_TCL_DECLARED
#define Tcl_GetEnsembleNamespace_TCL_DECLARED
/* 551 */
EXTERN int		Tcl_GetEnsembleNamespace _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Command token, 
				Tcl_Namespace ** namespacePtrPtr));
#endif
#ifndef Tcl_SetTimeProc_TCL_DECLARED
#define Tcl_SetTimeProc_TCL_DECLARED
/* 552 */
EXTERN void		Tcl_SetTimeProc _ANSI_ARGS_((
				Tcl_GetTimeProc* getProc, 
				Tcl_ScaleTimeProc* scaleProc, 
				ClientData clientData));
#endif
#ifndef Tcl_QueryTimeProc_TCL_DECLARED
#define Tcl_QueryTimeProc_TCL_DECLARED
/* 553 */
EXTERN void		Tcl_QueryTimeProc _ANSI_ARGS_((
				Tcl_GetTimeProc** getProc, 
				Tcl_ScaleTimeProc** scaleProc, 
				ClientData* clientData));
#endif
#ifndef Tcl_ChannelThreadActionProc_TCL_DECLARED
#define Tcl_ChannelThreadActionProc_TCL_DECLARED
/* 554 */
EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc _ANSI_ARGS_((
				Tcl_ChannelType * chanTypePtr));
#endif
#ifndef Tcl_NewBignumObj_TCL_DECLARED
#define Tcl_NewBignumObj_TCL_DECLARED
/* 555 */
EXTERN Tcl_Obj*		Tcl_NewBignumObj _ANSI_ARGS_((mp_int* value));
#endif
#ifndef Tcl_DbNewBignumObj_TCL_DECLARED
#define Tcl_DbNewBignumObj_TCL_DECLARED
/* 556 */
EXTERN Tcl_Obj*		Tcl_DbNewBignumObj _ANSI_ARGS_((mp_int* value, 
				CONST char* file, int line));
#endif
#ifndef Tcl_SetBignumObj_TCL_DECLARED
#define Tcl_SetBignumObj_TCL_DECLARED
/* 557 */
EXTERN void		Tcl_SetBignumObj _ANSI_ARGS_((Tcl_Obj* obj, 
				mp_int* value));
#endif
#ifndef Tcl_GetBignumFromObj_TCL_DECLARED
#define Tcl_GetBignumFromObj_TCL_DECLARED
/* 558 */
EXTERN int		Tcl_GetBignumFromObj _ANSI_ARGS_((Tcl_Interp* interp, 
				Tcl_Obj* obj, mp_int* value));
#endif

typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;

    int (*tcl_SetEnsembleUnknownHandler) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj * unknownList)); /* 545 */
    int (*tcl_SetEnsembleFlags) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, int flags)); /* 546 */
    int (*tcl_GetEnsembleSubcommandList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** subcmdListPtr)); /* 547 */
    int (*tcl_GetEnsembleMappingDict) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** mapDictPtr)); /* 548 */
    int (*tcl_GetEnsembleUnknownHandler) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** unknownListPtr)); /* 549 */
    int (*tcl_GetEnsembleFlags) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, int * flagsPtr)); /* 550 */
    int (*tcl_GetEnsembleNamespace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Namespace ** namespacePtrPtr)); /* 551 */
    void (*tcl_SetTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc* getProc, Tcl_ScaleTimeProc* scaleProc, ClientData clientData)); /* 552 */
    void (*tcl_QueryTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc** getProc, Tcl_ScaleTimeProc** scaleProc, ClientData* clientData)); /* 553 */
    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 554 */
    Tcl_Obj* (*tcl_NewBignumObj) _ANSI_ARGS_((mp_int* value)); /* 555 */
    Tcl_Obj* (*tcl_DbNewBignumObj) _ANSI_ARGS_((mp_int* value, CONST char* file, int line)); /* 556 */
    void (*tcl_SetBignumObj) _ANSI_ARGS_((Tcl_Obj* obj, mp_int* value)); /* 557 */
    int (*tcl_GetBignumFromObj) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value)); /* 558 */
} TclStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern TclStubs *tclStubsPtr;
#ifdef __cplusplus

#define Tcl_GetEnsembleFlags \
	(tclStubsPtr->tcl_GetEnsembleFlags) /* 550 */
#endif
#ifndef Tcl_GetEnsembleNamespace
#define Tcl_GetEnsembleNamespace \
	(tclStubsPtr->tcl_GetEnsembleNamespace) /* 551 */
#endif
#ifndef Tcl_SetTimeProc
#define Tcl_SetTimeProc \
	(tclStubsPtr->tcl_SetTimeProc) /* 552 */
#endif
#ifndef Tcl_QueryTimeProc
#define Tcl_QueryTimeProc \
	(tclStubsPtr->tcl_QueryTimeProc) /* 553 */
#endif
#ifndef Tcl_ChannelThreadActionProc
#define Tcl_ChannelThreadActionProc \
	(tclStubsPtr->tcl_ChannelThreadActionProc) /* 554 */
#endif
#ifndef Tcl_NewBignumObj
#define Tcl_NewBignumObj \
	(tclStubsPtr->tcl_NewBignumObj) /* 555 */
#endif
#ifndef Tcl_DbNewBignumObj
#define Tcl_DbNewBignumObj \
	(tclStubsPtr->tcl_DbNewBignumObj) /* 556 */
#endif
#ifndef Tcl_SetBignumObj
#define Tcl_SetBignumObj \
	(tclStubsPtr->tcl_SetBignumObj) /* 557 */
#endif
#ifndef Tcl_GetBignumFromObj
#define Tcl_GetBignumFromObj \
	(tclStubsPtr->tcl_GetBignumFromObj) /* 558 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLDECLS */

/* 
 * tclExecute.c --
 *
 *	This file contains procedures that execute byte-compiled Tcl
 *	commands.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.167.2.2 2005/02/02 15:53:21 kennykb Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

#ifndef TCL_NO_MATH
#   include <math.h>

      recompileObj:
	iPtr->errorLine = 1; 
	result = tclByteCodeType.setFromAnyProc(interp, objPtr);
	if (result != TCL_OK) {
	    iPtr->numLevels--;
	    return result;
	}

	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
    } else {
	/*
	 * Make sure the Bytecode hasn't been invalidated by, e.g., someone 
	 * redefining a command with a compile procedure (this might make the 
	 * compiled code wrong). 
	 * The object needs to be recompiled if it was compiled in/for a 

/*
 * tclFileName.c --
 *
 *	This file contains routines for converting file names betwen
 *	native and network form.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclFileName.c,v 1.60.2.2 2005/02/02 15:53:23 kennykb Exp $
 */

#include "tclInt.h"
#include "tclRegexp.h"
#include "tclFileSystem.h" /* For TclGetPathType() */

/*

    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_AllocStatBuf --
 *
 *     This procedure allocates a Tcl_StatBuf on the heap.  It exists
 *     so that extensions may be used unchanged on systems where
 *     largefile support is optional.
 *
 * Results:
 *     A pointer to a Tcl_StatBuf which may be deallocated by being

/* 
 * tclGet.c --
 *
 *	This file contains procedures to convert strings into
 *	other forms, like integers or floating-point numbers or
 *	booleans, doing syntax checking along the way.
 *
 * Copyright (c) 1990-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclGet.c,v 1.9.2.1 2005/02/02 15:53:24 kennykb Exp $
 */

#include "tclInt.h"
#include <math.h>


/*

int
Tcl_GetDouble(interp, string, doublePtr)
    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
    CONST char *string;		/* String containing a floating-point number
				 * in a form acceptable to strtod. */
    double *doublePtr;		/* Place to store converted result. */
{
    CONST char *end;
    double d;

    errno = 0;
    d = TclStrToD(string, &end); /* INTL: Tcl source. */
    if (end == string) {
	badDouble:
        if (interp != (Tcl_Interp *) NULL) {
            Tcl_AppendResult(interp,
                    "expected floating-point number but got \"",
                    string, "\"", (char *) NULL);
        }

/* 
 * tclIO.c --
 *
 *	This file provides the generic portions (those that are the same on
 *	all platforms and for all channel types) of Tcl's IO facilities.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIO.c,v 1.81.2.1 2005/02/02 15:53:24 kennykb Exp $
 */

#include "tclInt.h"
#include "tclIO.h"
#include <assert.h>



    /*
     * Link the channel into the list of all channels; create an on-exit
     * handler if there is not one already, to close off all the channels
     * in the list on exit.
     *
     * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.

     *
     * TIP #218.
     * AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel
     *     We need Tcl_SpliceChannel, for the threadAction calls.
     *     There is no real reason to duplicate all of this.

     * NOTE: All drivers using thread actions now have to perform their TSD
     *       manipulation only in their thread action proc. Doing it when
     *       creating their instance structures will collide with the thread
     *       action activity and lead to damaged lists.
     */

    statePtr->nextCSPtr = (ChannelState *) NULL;
    Tcl_SpliceChannel ((Tcl_Channel) chanPtr);

    /*
     * Install this channel in the first empty standard channel slot, if
     * the channel was previously closed explicitly.
     */

    if ((tsdPtr->stdinChannel == NULL) &&

 * Results:
 *	Nothing.
 *
 * Side effects:
 *	Resets the field 'nextCSPtr' of the specified channel state to NULL.
 *
 * NOTE:
 *	The channel to cut out of the list must not be referenced
 *	in any interpreter. This is something this procedure cannot
 *	check (despite the refcount) because the caller usually wants
 *	fiddle with the channel (like transfering it to a different
 *	thread) and thus keeps the refcount artifically high to prevent
 *	its destruction.
 *
 *----------------------------------------------------------------------

{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ChannelState *prevCSPtr;		/* Preceding channel state in list of
					 * all states - used to splice a
					 * channel out of the list on close. */
    ChannelState *statePtr = ((Channel *) chan)->state;
					/* state of the channel stack. */
    Tcl_DriverThreadActionProc *threadActionProc;

    /*
     * Remove this channel from of the list of all channels
     * (in the current thread).
     */

    if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {

	    Tcl_Panic("FlushChannel: damaged channel list");
	}
	prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
    }

    statePtr->nextCSPtr = (ChannelState *) NULL;

    /* TIP #218, Channel Thread Actions */
    threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
    if (threadActionProc != NULL) {
        (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
			     TCL_CHANNEL_THREAD_REMOVE);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SpliceChannel --
 *
 *	Adds a channel to the (thread-)global list of all channels
 *	(in that thread). Expects that the field 'nextChanPtr' in
 *	the channel is set to NULL.
 *
 * Results:
 *	Nothing.
 *
 * Side effects:
 *	Nothing.
 *
 * NOTE:
 *	The channel to splice into the list must not be referenced in any
 *	interpreter. This is something this procedure cannot check
 *	(despite the refcount) because the caller usually wants figgle
 *	with the channel (like transfering it to a different thread)
 *	and thus keeps the refcount artifically high to prevent its
 *	destruction.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SpliceChannel(chan)
    Tcl_Channel chan;			/* The channel being added. Must
					 * not be referenced in any
					 * interpreter. */
{
    ThreadSpecificData	*tsdPtr = TCL_TSD_INIT(&dataKey);
    ChannelState	*statePtr = ((Channel *) chan)->state;
    Tcl_DriverThreadActionProc *threadActionProc;

    if (statePtr->nextCSPtr != (ChannelState *) NULL) {
	Tcl_Panic("Tcl_SpliceChannel: trying to add channel used in different list");
    }

    statePtr->nextCSPtr = tsdPtr->firstCSPtr;
    tsdPtr->firstCSPtr = statePtr;

    /*
     * TIP #10. Mark the current thread as the new one managing this
     *		channel. Note: 'Tcl_GetCurrentThread' returns sensible
     *		values even for a non-threaded core.
     */

    statePtr->managingThread = Tcl_GetCurrentThread();

    /* TIP #218, Channel Thread Actions */
    threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
    if (threadActionProc != NULL) {
        (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
			     TCL_CHANNEL_THREAD_INSERT);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Close --
 *

Tcl_ChannelVersion(chanTypePtr)
    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
{
    if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
	return TCL_CHANNEL_VERSION_2;
    } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) {
	return TCL_CHANNEL_VERSION_3;
    } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) {
	return TCL_CHANNEL_VERSION_4;
    } else {
	/*
	 * In <v2 channel versions, the version field is occupied
	 * by the Tcl_DriverBlockModeProc
	 */

	return TCL_CHANNEL_VERSION_1;

{
    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
	return chanTypePtr->wideSeekProc;
    } else {
	return NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelThreadActionProc --
 *
 *      TIP #218, Channel Thread Actions.
 *	Return the Tcl_DriverThreadActionProc of the channel type.
 *
 * Results:
 *	A pointer to the proc.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_DriverThreadActionProc *
Tcl_ChannelThreadActionProc(chanTypePtr)
    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
{
    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
	return chanTypePtr->threadActionProc;
    } else {
	return NULL;
    }
}

#if 0
/*
 * For future debugging work, a simple function to print the flags of
 * a channel in semi-readable form.
 */

 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-19/99 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclInt.h,v 1.202.2.5 2005/02/02 15:53:26 kennykb Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Common include files needed by most of the Tcl source files are

MODULE_SCOPE char *	tclNativeExecutableName;
MODULE_SCOPE int	tclFindExecutableSearchDone;
MODULE_SCOPE char *	tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;
MODULE_SCOPE Tcl_NotifierProcs tclOriginalNotifier;

/* TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */

MODULE_SCOPE Tcl_GetTimeProc*   tclGetTimeProcPtr;
MODULE_SCOPE Tcl_ScaleTimeProc* tclScaleTimeProcPtr;
MODULE_SCOPE ClientData         tclTimeClientData;

/*
 * Variables denoting the Tcl object types defined in the core.
 */

MODULE_SCOPE Tcl_ObjType tclBooleanType;
MODULE_SCOPE Tcl_ObjType tclByteArrayType;
MODULE_SCOPE Tcl_ObjType tclByteCodeType;

MODULE_SCOPE ClientData	TclpGetNativeCwd _ANSI_ARGS_((ClientData clientData));
MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
MODULE_SCOPE Tcl_Obj*	TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr, 
			    Tcl_Obj *toPtr, int linkType));
MODULE_SCOPE int	TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr));
MODULE_SCOPE Tcl_Obj *	TclPathPart _ANSI_ARGS_((Tcl_Interp *interp, 
			    Tcl_Obj *pathPtr, Tcl_PathPart portion));




MODULE_SCOPE void	TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *,
			    format));
MODULE_SCOPE char *	TclpReadlink _ANSI_ARGS_((CONST char *fileName,
			    Tcl_DString *linkPtr));
MODULE_SCOPE void	TclpReleaseFile _ANSI_ARGS_((TclFile file));
MODULE_SCOPE void	TclpSetInterfaces ();
MODULE_SCOPE void	TclpSetVariables _ANSI_ARGS_((Tcl_Interp *interp));

MODULE_SCOPE void	TclSetBgErrorHandler _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *cmdPrefix));
MODULE_SCOPE void	TclSetProcessGlobalValue _ANSI_ARGS_ ((
			    ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue,
			    Tcl_Encoding encoding));
MODULE_SCOPE VOID	TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id,
			    int result));
MODULE_SCOPE double	TclStrToD _ANSI_ARGS_((CONST char* string,
					       CONST char** endPtr));
MODULE_SCOPE int	TclSubstTokens _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    int *tokensLeftPtr));
MODULE_SCOPE void	TclTransferResult _ANSI_ARGS_((
			    Tcl_Interp *sourceInterp, int result,
			    Tcl_Interp *targetInterp));
MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized _ANSI_ARGS_((

 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2001 by ActiveState Corporation.
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclObj.c,v 1.72.2.4 2005/02/02 15:53:26 kennykb Exp $
 */

#include "tclInt.h"
#include "tommath.h"
#include "tclCompile.h"

/*

	     * is non-zero and not "1". Such a string would result in
	     * the boolean value true. We try converting to double. If
	     * that succeeds and the resulting double is non-zero, we
	     * have a "true".  Note that numbers can't have embedded
	     * NULLs.
	     */

	    dbl = TclStrToD(string, (CONST char **) &end);
	    if (end == string) {
		goto badBoolean;
	    }

	    /*
	     * Make sure the string has no garbage after the end of
	     * the double.

 */

static int
SetDoubleFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr;	/* The object to convert. */
{
    CONST char *string, *end;
    double newDouble;
    int length;

    /*
     * Get the string representation. Make it up-to-date if necessary.
     */

    string = Tcl_GetStringFromObj(objPtr, &length);

    /*
     * Now parse "objPtr"s string as an double. Numbers can't have embedded
     * NULLs. We use an implementation here that doesn't report errors in
     * interp if interp is NULL.
     */

    errno = 0;
    newDouble = TclStrToD(string, &end);
    if (end == string) {
	badDouble:
	if (interp != NULL) {
	    Tcl_Obj *msg = Tcl_NewStringObj(
		    "expected floating-point number but got \"", -1);
	    TclAppendLimitedToObj(msg, string, length, 50, "");
	    Tcl_AppendToObj(msg, "\"", -1);

 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclParseExpr.c,v 1.23.2.1 2005/02/02 15:53:27 kennykb Exp $
 */

#include "tclInt.h"

/*
 * The stuff below is a bit of a hack so that this file can be used in
 * environments that include no UNIX, i.e. no errno: just arrange to use

	} else if ((length = ParseMaxDoubleLength(src, end))) {
	    /*
	     * There are length characters that could be a double.
	     * Let strtod() tells us for sure.  Need a writable copy
	     * so we can set an terminating NULL to keep strtod from
	     * scanning too far.
	     */
	    char *startPtr;
	    CONST char *termPtr;
	    double doubleValue;
	    Tcl_DString toParse;

	    errno = 0;
	    Tcl_DStringInit(&toParse);
	    startPtr = Tcl_DStringAppend(&toParse, src, length);
	    doubleValue = TclStrToD(startPtr, &termPtr);
	    Tcl_DStringFree(&toParse);
	    if (termPtr != startPtr) {
		if (errno != 0) {
		    if (interp != NULL) {
			TclExprFloatError(interp, doubleValue);
		    }
		    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;

/* 
 * tclScan.c --
 *
 *	This file contains the implementation of the "scan" command.
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclScan.c,v 1.16.2.1 2005/02/02 15:53:27 kennykb Exp $
 */

#include "tclInt.h"

/*
 * Flag values used by Tcl_ScanObjCmd.
 */

		/*
		 * Scan the value from the temporary buffer.
		 */

		if (!(flags & SCAN_SUPPRESS)) {
		    double dvalue;
		    *end = '\0';
		    dvalue = TclStrToD(buf, NULL);
		    objPtr = Tcl_NewDoubleObj(dvalue);
		    Tcl_IncrRefCount(objPtr);
		    objs[objIndex++] = objPtr;
		}
		break;
	}
	nconversions++;

/*
 *----------------------------------------------------------------------
 *
 * tclStrToD.c --
 *
 *	This file contains a TclStrToD procedure that handles conversion
 *	of string to double, with correct rounding even where extended
 *	precision is needed to achieve that.
 *
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.1 2005/02/02 15:53:27 kennykb Exp $
 */

#include <tclInt.h>
#include <stdio.h>
#include <stdlib.h>
#include <float.h>
#include <limits.h>
#include <math.h>
#include <ctype.h>
#include <tommath.h>

#if ( FLT_RADIX == 2 ) && ( DBL_MANT_DIG == 53 ) && ( DBL_MAX_EXP == 1024 )
#define IEEE_FLOATING_POINT
#endif

TCL_DECLARE_MUTEX( initMutex );

/* The powers of ten that can be represented exactly as IEEE754 doubles. */

#define MAXPOW 22
static double pow10 [MAXPOW+1];

/* Inexact higher powers of ten */

static CONST double pow_10_2_n [] = {
    1.0,
    100.0,
    10000.0,
    1.0e+8,
    1.0e+16,
    1.0e+32,
    1.0e+64,
    1.0e+128,
    1.0e+256
};

/* Flag for whether the constants have been initialized */

static volatile int constantsInitialized = 0;

/* Logarithm of the floating point radix. */

static int log2FLT_RADIX;

/* Number of bits in a double's significand */

static int mantBits;

/* Table of powers of 5**(2**n), up to 5**256 */

static mp_int pow5[9];

/* Static functions defined in this file */

static void InitializeConstants _ANSI_ARGS_((void));
static void FreeConstants _ANSI_ARGS_((ClientData));
static double RefineResult _ANSI_ARGS_((double approx, CONST char* start,
					int nDigits, long exponent));
static double BignumToDouble _ANSI_ARGS_(( mp_int* a ));
static double ParseNaN _ANSI_ARGS_(( int signum, CONST char** end ));

/*
 *----------------------------------------------------------------------
 *
 * TclStrToD --
 *
 *	Scans a double from a string.
 *
 * Results:
 *	Returns the scanned number. In the case of underflow, returns
 *	an appropriately signed zero; in the case of overflow, returns
 *	an appropriately signed HUGE_VAL.
 *
 * Side effects:
 *	Stores a pointer to the end of the scanned number in '*endPtr',
 *	if endPtr is not NULL. If '*endPtr' is equal to 's' on return from
 *	this function, it indicates that the input string could not be
 *	recognized as a number.
 *	In the case of underflow or overflow, 'errno' is set to ERANGE.
 *
 *------------------------------------------------------------------------
 */

double
TclStrToD( CONST char* s, 
				/* String to scan */
	   CONST char ** endPtr )
				/* Pointer to the end of the scanned number */
{

    CONST char* p = s;
    CONST char* startOfSignificand = NULL;
				/* Start of the significand in the
				 * string */
    int signum = 0;		/* Sign of the significand */
    double exactSignificand = 0.0;
				/* Significand, represented exactly
				 * as a floating-point number */
    int seenDigit = 0;		/* Flag == 1 if a digit has been seen */
    int nSigDigs = 0;		/* Number of significant digits presented */
    int nDigitsAfterDp = 0;	/* Number of digits after the decimal point */
    int nTrailZero = 0;		/* Number of trailing zeros in the 
				 * significand */
    long exponent = 0;		/* Exponent */
    int seenDp = 0;		/* Flag == 1 if decimal point has been seen */

    char c;			/* One character extracted from the input */

    static int mmaxpow = 0;	/* Largest power of ten that can be
				 * represented exactly in a 'double'. */
    double v;			/* Scanned value */
    int machexp;		/* Exponent of the machine rep of the
				 * scanned value */
    int expt2;			/* Exponent for computing first
				 * approximation to the true value */
    int i, j;

    InitializeConstants();

    if ( mmaxpow == 0 ) {
	int x = (int) (DBL_MANT_DIG * log((double) FLT_RADIX) / log( 5.0 ))
	    - 1;
	if ( x < MAXPOW ) {
	    mmaxpow = x;
	} else {
	    mmaxpow = MAXPOW;
	}
    }

    /* Discard leading whitespace */

    while ( isspace( *p ) ) {
	++p;
    }

    /* Determine the sign of the significand */

    switch( *p ) {
	case '-':
	    signum = 1;
	    /* FALLTHROUGH */
	case '+':
	    ++p;
    }

    /* Discard leading zeroes */

    while ( *p == '0' ) {
	seenDigit = 1;
	++p;
    }

    /* 
     * Scan digits from the significand. Simultaneously, keep track
     * of the number of digits after the decimal point. Maintain
     * a pointer to the start of the significand. Keep "exactSignificand"
     * equal to the conversion of the DBL_DIG most significant digits.
     */

    for ( ; ; ) {
	c = *p;
	if ( c == '.' && !seenDp ) {
	    seenDp = 1;
	    ++p;
	} else if ( isdigit(c) ) {
	    if ( c == '0' ) {
		if ( startOfSignificand != NULL ) {
		    ++nTrailZero;
		}
	    } else {
		if ( startOfSignificand == NULL ) {
		    startOfSignificand = p;
		} else if ( nTrailZero ) {
		    if ( nTrailZero + nSigDigs < DBL_DIG ) {
			exactSignificand *= pow10[ nTrailZero ];
		    } else if ( nSigDigs < DBL_DIG ) {
			exactSignificand *= pow10[ DBL_DIG - nSigDigs ];
		    }
		    nSigDigs += nTrailZero;
		}
		if ( nSigDigs < DBL_DIG ) {
		    exactSignificand = 10. * exactSignificand + (c - '0');
		}
		++nSigDigs;
		nTrailZero = 0;
	    }
	    if ( seenDp ) {
		++nDigitsAfterDp;
	    }
	    seenDigit = 1;
	    ++p;
	} else {
	    break;
	}
    }

    /*
     * At this point, we've scanned the significand, and p points
     * to the character beyond it.  "startOfSignificand" is the first
     * non-zero character in the significand. "nSigDigs" is the number
     * of significant digits of the significand, not including any
     * trailing zeroes. "exactSignificand" is a floating point number
     * that represents, without loss of precision, the first
     * min(DBL_DIG,n) digits of the significand.  "nDigitsAfterDp"
     * is the number of digits after the decimal point, again excluding
     * trailing zeroes.
     *
     * Now scan 'E' format
     */

    exponent = 0;
    if ( seenDigit && ( *p == 'e' || *p == 'E' ) ) {
	CONST char* stringSave = p;
	++p;
	c = *p;
	if ( isdigit( c ) || c == '+' || c == '-' ) {
	    exponent = strtol( p, (char**)&p, 10 );
	}
	if ( p == stringSave + 1 ) {
	    p = stringSave;
	    exponent = 0;
	}
    }

    exponent = exponent + nTrailZero - nDigitsAfterDp;

    if ( !seenDigit ) {

	/* Test for Inf */

	if ( c == 'I' || c == 'i' ) {

	    if ( ( p[1] == 'N' || p[1] == 'n' )
		 && ( p[2] == 'F' || p[2] == 'f' ) ) {
		p += 3;
		if ( ( p[0] == 'I' || p[0] == 'i' )
		     && ( p[1] == 'N' || p[1] == 'n' )
		     && ( p[2] == 'I' || p[2] == 'i' )
		     && ( p[3] == 'T' || p[3] == 't' )
		     && ( p[4] == 'Y' || p[1] == 'y' ) ) {
		    p += 5;
		}
		errno = ERANGE;
		v = HUGE_VAL;
		if ( endPtr != NULL ) {
		    *endPtr = p;
		}
		goto returnValue;
	    }


#ifdef IEEE_FLOATING_POINT

	    /* IEEE floating point supports NaN */

	} else if ( (c == 'N' || c == 'n' )
		    && ( sizeof(Tcl_WideUInt) == sizeof( double ) ) ) {
	    
	    if ( ( p[1] == 'A' || p[1] == 'a' )
		 && ( p[2] == 'N' || p[2] == 'n' ) ) {
		p += 3;
		
	        if ( endPtr != NULL ) {
		    *endPtr = p;
		}
		
		return ParseNaN( signum, endPtr );

	    }
#endif

	}

	goto error;
    }

    if ( endPtr != NULL ) {
	*endPtr = p;
    }

    /* Test for zero. */

    if ( nSigDigs == 0 ) {
	v = 0.0;
	goto returnValue;
    }

    /*
     * The easy cases are where we have an exact significand and
     * the exponent is small enough that we can compute the value
     * with only one roundoff.  The code below that is surrounded
     * with #if 0 corresponds to cases that Gay and Clinger claim
     * function correctly. but have been observed to fail on mingw,
     * returning some results that are off by 1 ulp.
     * (Oddly enough, they function correctly on VC++6 on the same
     * machine - and they pretty obviously are computing the products
     * and quotients of exact floating point numbers.)
     */

    if ( nSigDigs <= DBL_DIG ) {
	if ( exponent >= 0 ) {
	    if ( exponent <= mmaxpow ) {
		v = exactSignificand * pow10[ exponent ];
		goto returnValue;
	    } else {
#if 0
		int diff = DBL_DIG - nSigDigs;
		if ( exponent - diff <= mmaxpow ) {
		    volatile double factor = exactSignificand * pow10[ diff ];
		    v = factor * pow10[ exponent - diff ];
		    goto returnValue;
		}
#endif
	    }
	} else {
#if 0
	    if ( exponent >= -mmaxpow ) {
		v = exactSignificand / pow10[ -exponent ];
		goto returnValue;
	    }
#endif
	}
    }

    /* 
     * We don't have one of the easy cases, so we can't compute the
     * scanned number exactly, and have to do it in multiple precision.
     * Begin by testing for obvious overflows and underflows.
     */

    if ( nSigDigs + exponent - 1
	 > DBL_MAX_EXP * log( (double) FLT_RADIX ) / log( 10. ) ) {
	v = HUGE_VAL;
	errno = ERANGE;
	goto returnValue;
    }
    if ( nSigDigs + exponent - 1
	 < floor ( ( DBL_MIN_EXP - DBL_MANT_DIG )
		   * log( (double) FLT_RADIX ) / log( 10. ) ) ) {
	v = 0.;
	goto returnValue;
    }

    /*
     * Nothing exceeds the boundaries of the tables, at least.
     * Compute an approximate value for the number, with
     * no possibility of overflow because we manage the exponent
     * separately.
     */

    if ( nSigDigs > DBL_DIG ) {
	expt2 = exponent + nSigDigs - DBL_DIG;
    } else {
	expt2 = exponent;
    }
    v = frexp( exactSignificand, &machexp );
    if ( expt2 > 0 ) {
	v = frexp( v * pow10[ expt2 & 0xf ], &j );
	machexp += j;
	for ( i = 4; i < 9; ++i ) {
	    if ( expt2 & ( 1 << i ) ) {
		v = frexp( v * pow_10_2_n[ i ], &j );
		machexp += j;
	    }
	}
    } else {
	v = frexp( v / pow10[ (-expt2) & 0xf ], &j );
	machexp += j;
	for ( i = 4; i < 9; ++i ) {
	    if ( (-expt2) & ( 1 << i ) ) {
		v = frexp( v / pow_10_2_n[ i ], &j );
		machexp += j;
	    }
	}
    }

    /*
     * A first approximation is that the result will be v * 2 ** machexp.
     * v is greater than or equal to 0.5 and less than 1.
     * If machexp > DBL_MAX_EXP * log2(FLT_RADIX), there is an overflow.
     */

    if ( machexp > DBL_MAX_EXP * log2FLT_RADIX ) {
	v = HUGE_VAL;
	errno = ERANGE;
	goto returnValue;
    }
	
    v = ldexp( v, machexp );
    if ( v == 0 ) {
	/* DBL_MIN is known to be incorrect on MSVC6, and ldexp
	 * doesn't work with denormals. */
	v = ldexp( 1.0, DBL_MIN_EXP * log2FLT_RADIX );
	v *= ldexp( 1.0, (-DBL_MANT_DIG) * log2FLT_RADIX );
    }

    /* 
     * We have a first approximation in v. Now we need to refine it.
     */

    v = RefineResult( v, startOfSignificand, nSigDigs, exponent );

    /* In a very few cases, a second iteration is needed. e.g., 457e-102 */
    
    v = RefineResult( v, startOfSignificand, nSigDigs, exponent );

    /* Handle underflow */

  returnValue:
    if ( nSigDigs != 0 && v == 0.0 ) {
	errno = ERANGE;
    }

    /* Return a number with correct sign */

    if ( signum ) {
	return -v;
    } else {
	return v;
    }
	
    
    /* Come here on an invalid input */

  error:
    if ( endPtr != NULL ) {
	*endPtr = s;
    }
    return 0.0;
}

/*
 *----------------------------------------------------------------------
 *
 * InitializeConstants --
 *
 *	Initializes constants that are needed for string-to-double
 *      conversion.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The log base 2 of the floating point radix, the number of
 *	bits in a double mantissa, and a table of the powers of five
 *	and ten are computed and stored.
 *
 *----------------------------------------------------------------------
 */

static void
InitializeConstants( void )
{
    int i;
    double d;
    if ( !constantsInitialized ) {
	Tcl_MutexLock( &initMutex );
	if ( !constantsInitialized ) {
	    frexp( (double) FLT_RADIX, &log2FLT_RADIX );
	    --log2FLT_RADIX;
	    mantBits = DBL_MANT_DIG * log2FLT_RADIX;
	    d = 1.0;
	    for ( i = 0; i <= MAXPOW; ++i ) {
		pow10[i] = d;
		d *= 10.0;
	    }
	    for ( i = 0; i < 9; ++i ) {
		mp_init( pow5 + i );
	    }
	    mp_set( pow5, 5 );
	    for ( i = 0; i < 8; ++i ) {
		mp_sqr( pow5+i, pow5+i+1 );
	    }
	    Tcl_CreateExitHandler( FreeConstants, (ClientData) NULL );
	}
	constantsInitialized = 1;
	Tcl_MutexUnlock( &initMutex );
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FreeConstants --
 *
 *	Cleans up this file on exit.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Memory allocated by InitializeConstants is freed.
 *
 *----------------------------------------------------------------------
 */

static void
FreeConstants( ClientData unused )
{
    int i;
    Tcl_MutexLock( &initMutex );
    constantsInitialized = 0;
    for ( i = 0; i < 9; ++i ) {
	mp_clear( pow5 + i );
    }
    Tcl_MutexUnlock( &initMutex );
}

/*
 *----------------------------------------------------------------------
 *
 * RefineResult --
 *
 *	Given a poor approximation to a floating point number, returns
 *	a better one (The better approximation is correct to within
 *	1 ulp, and is entirely correct if the poor approximation is
 *	correct to 1 ulp.)
 *
 * Results:
 *	Returns the improved result.
 *
 *----------------------------------------------------------------------
 */

static double
RefineResult( double approxResult, 
				/* Approximate result of conversion */
	      CONST char* sigStart,
				/* Pointer to start of significand in
				 * input string. */
	      int nSigDigs,	/* Number of significant digits */
	      long exponent )	/* Power of ten to multiply by significand */
{

    int M2, M5;			/*  Powers of 2 and of 5 needed to put
				 * the decimal and binary numbers over
				 * a common denominator. */
    double significand;		/* Sigificand of the binary number */
    int binExponent;		/* Exponent of the binary number */

    int msb;			/* Most significant bit position of an
				 * intermediate result */
    int nDigits;		/* Number of mp_digit's in an intermediate
				 * result */
    mp_int twoMv;		/* Approx binary value expressed as an
				 * exact integer scaled by the multiplier 2M */
    mp_int twoMd;		/* Exact decimal value expressed as an
				 * exact integer scaled by the multiplier 2M */
    int scale;			/* Scale factor for M */
    int multiplier;		/* Power of two to scale M */
    double num, den;		/* Numerator and denominator of the
				 * correction term */
    double quot;		/* Correction term */
    double minincr;		/* Lower bound on the absolute value
				 * of the correction term. */
    int i;
    CONST char* p;

    /*
     * Find a common denominator for the decimal and binary fractions.
     * The common denominator will be 2**M2 + 5**M5.
     */

    significand = frexp( approxResult, &binExponent );
    i = mantBits - binExponent;
    if ( i < 0 ) {
	M2 = 0;
    } else {
	M2 = i;
    }
    if ( exponent > 0 ) {
	M5 = 0;
    } else {
	M5 = -exponent;
	if ( (M5-1) > M2 ) {
	    M2 = M5-1;
	}
    }

    /* 
     * The floating point number is significand*2**binExponent.
     * The 2**-1 bit of the significand (the most significant) 
     * corresponds to the 2**(binExponent+M2 + 1) bit of 2*M2*v.
     * Allocate enough digits to hold that quantity, then
     * convert the significand to a large integer, scaled
     * appropriately. Then multiply by the appropriate power of 5.
     */

    msb = binExponent + M2;  /* 1008 */
    nDigits = msb / DIGIT_BIT + 1;
    mp_init_size( &twoMv, nDigits );
    i = ( msb % DIGIT_BIT + 1 ); 
    twoMv.used = nDigits;
    significand *= ldexp( 1.0, i );
    while ( -- nDigits >= 0 ) {
	twoMv.dp[nDigits] = (mp_digit) significand;
	significand -= (mp_digit) significand;
	significand = ldexp( significand, DIGIT_BIT );
    }
    for ( i = 0; i <= 8; ++i ) {
	if ( M5 & ( 1 << i ) ) {
	    mp_mul( &twoMv, pow5+i, &twoMv );
	}
    }
    
    /* 
     * Collect the decimal significand as a high precision integer.
     * The least significant bit corresponds to bit M2+exponent+1
     * so it will need to be shifted left by that many bits after
     * being multiplied by 5**(M5+exponent).
     */

    mp_init( &twoMd ); mp_zero( &twoMd );
    i = nSigDigs;
    for ( p = sigStart ; ; ++p ) {
	char c = *p;
	if ( isdigit( c ) ) {
	    mp_mul_d( &twoMd, (unsigned) 10, &twoMd );
	    mp_add_d( &twoMd, (unsigned) (c - '0'), &twoMd );
	    --i;
	    if ( i == 0 ) break;
	}
    }
    for ( i = 0; i <= 8; ++i ) {
	if ( (M5+exponent) & ( 1 << i ) ) {
	    mp_mul( &twoMd, pow5+i, &twoMd );
	}
    }
    mp_mul_2d( &twoMd, M2+exponent+1, &twoMd );
    mp_sub( &twoMd, &twoMv, &twoMd );

    /*
     * The result, 2Mv-2Md, needs to be divided by 2M to yield a correction
     * term. Because 2M may well overflow a double, we need to scale the
     * denominator by a factor of 2**binExponent-mantBits
     */

    scale = binExponent - mantBits - 1;

    mp_set( &twoMv, 1 );
    for ( i = 0; i <= 8; ++i ) {
	if ( M5 & ( 1 << i ) ) {
	    mp_mul( &twoMv, pow5+i, &twoMv );
	}
    }
    multiplier = M2 + scale + 1;
    if ( multiplier > 0 ) {
	mp_mul_2d( &twoMv, multiplier, &twoMv );
    } else if ( multiplier < 0 ) {
	mp_div_2d( &twoMv, -multiplier, &twoMv, NULL );
    }

    /*
     * If the result is less than unity, the error is less than 1/2 unit
     * in the last place, so there's no correction to make.
     */

    if ( mp_cmp_mag( &twoMd, &twoMv ) == MP_LT ) {
	return approxResult;
    }

    /* 
     * Convert the numerator and denominator of the corrector term
     * accurately to floating point numbers.
     */

    num = BignumToDouble( &twoMd );
    den = BignumToDouble( &twoMv );

    /* 
     * MSVC's ldexp underflows suddenly; avoid sudden underflow by
     * doing ldexp in two steps.
     */

    if ( scale < DBL_MIN_EXP * log2FLT_RADIX ) {
	quot = ldexp( 1., DBL_MIN_EXP * log2FLT_RADIX + mantBits )
	    * ldexp( num/den, scale - DBL_MIN_EXP * log2FLT_RADIX - mantBits );
    } else {
	quot = ldexp( num/den, scale );
    }

    minincr = ldexp( 1.0, binExponent - mantBits );
    if ( quot < 0. && quot > -minincr ) {
	quot = -minincr;
    } else if ( quot > 0. && quot < minincr ) {
	quot = minincr;
    }

    mp_clear( &twoMd );
    mp_clear( &twoMv );

    
    return approxResult + quot;
}

/*
 *----------------------------------------------------------------------
 *
 * BignumToDouble --
 *
 *	Convert an arbitrary-precision integer to a native floating 
 *	point number.
 *
 * Results:
 *	Returns the converted number.  Sets errno to ERANGE if the
 *	number is too large to convert.
 *
 *----------------------------------------------------------------------
 */

static double
BignumToDouble( mp_int* a )
				/* Integer to convert */
{
    mp_int b;
    int bits;
    int shift;
    int i;
    double r;

    /* Determine how many bits we need, and extract that many from 
     * the input. Round to nearest unit in the last place. */

    bits = mp_count_bits( a );
    shift = mantBits + 1 - bits;
    mp_init( &b );
    if ( shift > 0 ) {
	mp_mul_2d( a, shift, &b );
    } else if ( shift < 0 ) {
	mp_div_2d( a, -shift, &b, NULL );
    } else {
	mp_copy( a, &b );
    }
    mp_add_d( &b, 1, &b );
    mp_div_2d( &b, 1, &b, NULL );

    /* Accumulate the result, one mp_digit at a time */

    r = 0.0;
    for ( i = b.used-1; i >= 0; --i ) {
	r = ldexp( r, DIGIT_BIT ) + b.dp[i];
    }
    mp_clear( &b );

    /* 
     * Test for overflow, and scale the result to the correct number 
     * of bits. 
     */

    if ( bits / log2FLT_RADIX > DBL_MAX_EXP ) {
	errno = ERANGE;
	r = HUGE_VAL;
    } else {
	r = ldexp( r, bits - mantBits );
    }

    /* Return the result with the appropriate sign. */

    if ( a->sign == MP_ZPOS ) {
	return r;
    } else {
	return -r;
    }
}		

/*
 *----------------------------------------------------------------------
 *
 * ParseNaN --
 *
 *	Parses a "not a number" from an input string, and returns the
 *	double precision NaN corresponding to it.
 *
 * Side effects:
 *	Advances endPtr to follow any (hex) in the input string.
 *
 *	If the NaN is followed by a left paren, a string of spaes
 *	and hexadecimal digits, and a right paren, endPtr is advanced
 *	to follow it.
 *
 * The string of hexadecimal digits is OR'ed into the resulting
 * NaN, and the signum is set as well.  Note that a signalling NaN
 * is never returned.
 *
 *----------------------------------------------------------------------
 */

double
ParseNaN( int signum,		/* Flag == 1 if minus sign has been
				 * seen in front of NaN */
	  CONST char** endPtr )
				/* Pointer-to-pointer to char following "NaN" 
				 * in the input string */
{
    CONST char* p = *endPtr;
    char c;
    union {
	Tcl_WideUInt iv;
	double dv;
    } theNaN;

    /* Scan off a hex number in parentheses.  Embedded blanks are ok. */

    theNaN.iv = 0;
    if ( *p == '(' ) {
	++p;
	for ( ; ; ) {
	    c = *p++;
	    if ( isspace(c) ) {
		continue;
	    } else if ( c == ')' ) {
		*endPtr = p;
		break;
	    } else if ( isdigit(c) ) {
		c -= '0';
	    } else if ( c >= 'A' && c <= 'F' ) {
		c = c - 'A' + 10;
	    } else if ( c >= 'a' && c <= 'f' ) {
		c = c - 'a' + 10;
	    } else {
		theNaN.iv = ( ((Tcl_WideUInt) 0x7ff8) << 48 )
		    | ( ((Tcl_WideUInt) signum) << 63 );
		return theNaN.dv;
	    }
	    theNaN.iv = (theNaN.iv << 4) | c;
	}
    }

    /* 
     * Mask the hex number down to the least significant 52 bits.
     *
     * If the result is zero, make it 1 so that we don't return Inf
     * instead of NaN 
     */

    theNaN.iv &= ( ((Tcl_WideUInt) 1) << 51 ) - 1;
    if ( theNaN.iv == 0 ) {
	theNaN.iv = 1;
    }
    if ( signum ) {
	theNaN.iv |= ((Tcl_WideUInt) 0xfff8) << 48;
    } else {
	theNaN.iv |= ((Tcl_WideUInt) 0x7ff8) << 48;
    }

    *endPtr = p;
    return theNaN.dv;
}

/* 
 * tclStubInit.c --
 *
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.109.2.5 2005/02/02 15:53:27 kennykb Exp $
 */

#include "tclInt.h"

/*
 * Remove macros that will interfere with the definitions below.
 */

    Tcl_SetEnsembleUnknownHandler, /* 545 */
    Tcl_SetEnsembleFlags, /* 546 */
    Tcl_GetEnsembleSubcommandList, /* 547 */
    Tcl_GetEnsembleMappingDict, /* 548 */
    Tcl_GetEnsembleUnknownHandler, /* 549 */
    Tcl_GetEnsembleFlags, /* 550 */
    Tcl_GetEnsembleNamespace, /* 551 */
    Tcl_SetTimeProc, /* 552 */
    Tcl_QueryTimeProc, /* 553 */
    Tcl_ChannelThreadActionProc, /* 554 */
    Tcl_NewBignumObj, /* 555 */
    Tcl_DbNewBignumObj, /* 556 */
    Tcl_SetBignumObj, /* 557 */
    Tcl_GetBignumFromObj, /* 558 */
};

/* !END!: Do not edit above this line. */

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTest.c,v 1.86.2.2 2005/02/02 15:53:29 kennykb Exp $
 */

#define TCL_TEST
#include "tclInt.h"

/*
 * Required for Testregexp*Cmd

    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    CONST char **argv;			/* Argument strings. */
{
    long exprResult;
    char buf[4 + TCL_INTEGER_SPACE];
    int result;

    if (argc != 2) {
        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
                " expression\"", (char *) NULL);
        return TCL_ERROR;
    }
    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
    result = Tcl_ExprLong(interp, argv[1], &exprResult);
    if (result != TCL_OK) {
        return result;
    }
    sprintf(buf, ": %ld", exprResult);
    Tcl_AppendResult(interp, buf, NULL);
    return TCL_OK;
}

/* 
 * tclThread.c --
 *
 *	This file implements   Platform independent thread operations.
 *	Most of the real work is done in the platform dependent files.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclThread.c,v 1.8.2.1 2005/02/02 15:53:29 kennykb Exp $
 */

#include "tclInt.h"

/*
 * There are three classes of synchronization objects:
 * mutexes, thread data keys, and condition variables.

{
    RememberSyncObject((char *)mutexPtr, &mutexRecord);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexFinalize --
 *
 *      Finalize a single mutex and remove it from the
 *	list of remembered objects.
 *
 * Results:
 *	None.
 *

{
    RememberSyncObject((char *)condPtr, &condRecord);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionFinalize --
 *
 *      Finalize a single condition variable and remove it from the
 *	list of remembered objects.
 *
 * Results:
 *	None.
 *

# auto.tcl --
#
# utility procs formerly in init.tcl dealing with auto execution
# of commands and can be auto loaded themselves.
#
# RCS: @(#) $Id: auto.tcl,v 1.21.2.1 2005/02/02 15:53:30 kennykb Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# auto_reset --
#
# Destroy all cached information for auto-loading and auto-execution,
# so that the information gets recomputed the next time it's needed.
# Also delete any commands that are listed in the auto-load index.

#
# Arguments: 
# None.

proc auto_reset {} {
    if {[array exists ::auto_index]} {
	foreach cmdName [array names ::auto_index] {
	    set fqcn [namespace which $cmdName]
	    if {$fqcn eq ""} {continue}
	    rename $fqcn {}
	}
    }
    unset -nocomplain ::auto_execs ::auto_index ::tcl::auto_oldpath
    if {[catch {llength $::auto_path}]} {
	set ::auto_path [list [info library]]
    } else {
	if {[info library] ni $::auto_path} {
	    lappend ::auto_path [info library]
	}
    }
}

# tcl_findLibrary --
#
#	This is a utility for extensions that searches for a library directory
#	using a canonical searching algorithm. A side effect is to source
#	the initialization script and set a global library variable.

#include <tommath.h>
#ifdef BN_FAST_S_MP_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
 */

/* fast squaring
 *
 * This is the comba method where the columns of the product
 * are computed first then the carries are computed.  This
 * has the effect of making a very simple inner loop that
 * is executed the most
 *
 * W2 represents the outer products and W the inner.
 *
 * A further optimizations is made because the inner
 * products are of the form "A * B * 2".  The *2 part does
 * not need to be computed until the end which is good
 * because 64-bit shifts are slow!
 *
 * Based on Algorithm 14.16 on pp.597 of HAC.
 *
 */
/* the jist of squaring...

you do like mult except the offset of the tmpx [one that starts closer to zero]
can't equal the offset of tmpy.  So basically you set up iy like before then you min it with
(ty-tx) so that it never happens.  You double all those you add in the inner loop

After that loop you do the squares and add them in.

Remove W2 and don't memset W

*/

int fast_s_mp_sqr (mp_int * a, mp_int * b)
{
  int       olduse, res, pa, ix, iz;
  mp_digit   W[MP_WARRAY], *tmpx;
  mp_word   W1;

  /* grow the destination as required */
  pa = a->used + a->used;
  if (b->alloc < pa) {
    if ((res = mp_grow (b, pa)) != MP_OKAY) {
      return res;
    }
  }

  /* number of output digits to produce */
  W1 = 0;
  for (ix = 0; ix < pa; ix++) { 
      int      tx, ty, iy;
      mp_word  _W;
      mp_digit *tmpy;

      /* clear counter */
      _W = 0;

      /* get offsets into the two bignums */
      ty = MIN(a->used-1, ix);
      tx = ix - ty;

      /* setup temp aliases */
      tmpx = a->dp + tx;
      tmpy = a->dp + ty;

      /* this is the number of times the loop will iterrate, essentially its 
         while (tx++ < a->used && ty-- >= 0) { ... }
       */
      iy = MIN(a->used-tx, ty+1);

      /* now for squaring tx can never equal ty 
       * we halve the distance since they approach at a rate of 2x
       * and we have to round because odd cases need to be executed
       */
      iy = MIN(iy, (ty-tx+1)>>1);

      /* execute loop */
      for (iz = 0; iz < iy; iz++) {
         _W += ((mp_word)*tmpx++)*((mp_word)*tmpy--);
      }

      /* double the inner product and add carry */
      _W = _W + _W + W1;

      /* even columns have the square term in them */
      if ((ix&1) == 0) {
         _W += ((mp_word)a->dp[ix>>1])*((mp_word)a->dp[ix>>1]);
      }

      /* store it */
      W[ix] = (mp_digit) _W;

      /* make next carry */
      W1 = _W >> ((mp_word)DIGIT_BIT);
  }

  /* setup dest */
  olduse  = b->used;
  b->used = a->used+a->used;

  {
    mp_digit *tmpb;
    tmpb = b->dp;
    for (ix = 0; ix < pa; ix++) {
      *tmpb++ = W[ix] & MP_MASK;
    }

    /* clear unused digits [that existed in the old copy of c] */
    for (; ix < olduse; ix++) {
      *tmpb++ = 0;
    }
  }
  mp_clamp (b);
  return MP_OKAY;
}
#endif

# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: expr-old.test,v 1.22.2.1 2005/02/02 15:53:30 kennykb Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {

    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use integer value too large to represent as operand of "+"}}

testConstraint testexprlong   [llength [info commands testexprlong]]
testConstraint testexprstring [llength [info commands testexprstring]]

test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
    testexprlong 4+1
} {This is a result: 5}
#Check for [Bug 1109484]
test expr-old-37.2 {Tcl_ExprLong handles wide ints gracefully} testexprlong {
    testexprlong wide(1)+2
} {This is a result: 3}

test expr-old-38.1 {Verify Tcl_ExprString's basic operation} testexprstring {
    list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
	    [catch {testexprstring "1+"} msg] $msg
} {5 10.2 1 {syntax error in expression "1+": premature end of expression}}

#

# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: io.test,v 1.65.2.1 2005/02/02 15:53:31 kennykb Exp $

if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}
namespace eval ::tcl::test::io {

	set f [open "|[list [info nameofexecutable] $path(cat) $path(test1)]" r]
	puts [gets $f]
    }
    close $f
    set f [open "|[list [interpreter] $path(script) [array get path]]" r]
    set c [gets $f]
    close $f
    # Added delay to give Windows time to stop the spawned process and clean
    # up its grip on the file test1. Added delete as proper test cleanup.
    # The failing tests were 18.1 and 18.2 as first re-users of file "test1".
    after 10000
    file delete $path(script)
    file delete $path(test1)
    set c
} hello

test io-15.1 {Tcl_CreateCloseHandler} emptyTest {
} {}

test io-16.1 {Tcl_DeleteCloseHandler} emptyTest {

	    	# FreeBSD-3 doesn't handle version numbers with dots.
	    	UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
	    	SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
	    	TCL_LIB_VERSIONS_OK=nodots
		;;
	    esac
	    ;;
	Darwin-*)
	    SHLIB_CFLAGS="-fno-common"
	    SHLIB_LD="cc -dynamiclib \${LDFLAGS}"
	    TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TCL_LIB_FILE} -prebind -seg1addr 0xa000000"
	    TK_SHLIB_LD_EXTRAS="-compatibility_version ${TK_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TK_LIB_FILE} -prebind -seg1addr 0xb000000"
	    SHLIB_LD_LIBS='${LIBS}'
	    SHLIB_SUFFIX=".dylib"
	    DL_OBJS="tclLoadDyld.o"
	    PLAT_OBJS=\$\(MAC\_OSX_OBJS\)
	    DL_LIBS=""
	    LDFLAGS="$LDFLAGS -prebind -Wl,-search_paths_first"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    CFLAGS_OPTIMIZE="-Os"
	    LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH"

cat >>confdefs.h <<\_ACEOF
#define MAC_OSX_TCL 1

	    SHLIB_CFLAGS="-KPIC"

	    # Check to enable 64-bit flags for compiler/linker
	    if test "$do64bit" = "yes" ; then
		arch=`isainfo`
		if test "$arch" = "sparcv9 sparc" ; then
			if test "$GCC" = "yes" ; then
			    if test "`gcc -dumpversion | awk -F. '{print $1}'`" -lt "3" ; then
				{ echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5
echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;}
			    else
				do64bit_ok=yes
				CFLAGS="$CFLAGS -m64 -mcpu=v9"
				LDFLAGS="$LDFLAGS -m64 -mcpu=v9"
				SHLIB_CFLAGS="-fPIC"
				SHLIB_LD_FLAGS=""
			    fi
			else
			    do64bit_ok=yes
			    if test "$do64bitVIS" = "yes" ; then
				CFLAGS="$CFLAGS -xarch=v9a"
			    	LDFLAGS_ARCH="-xarch=v9a"
			    else
				CFLAGS="$CFLAGS -xarch=v9"
			    	LDFLAGS_ARCH="-xarch=v9"
			    fi
			fi
		else
		    { echo "$as_me:$LINENO: WARNING: 64bit mode only supported sparcv9 system" >&5
echo "$as_me: WARNING: 64bit mode only supported sparcv9 system" >&2;}
		fi
	    fi

	    # Note: need the LIBS below, otherwise Tk won't find Tcl's
	    # symbols when dynamically loaded into tclsh.

	    SHLIB_LD_LIBS='${LIBS}'
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    if test "$GCC" = "yes" ; then
		SHLIB_LD="$CC -shared"
		CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
		if test "$do64bit_ok" = "yes" ; then
		    # We need to specify -static-libgcc or we need to
		    # add the path to the sparv9 libgcc.
		    SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc"
		    # for finding sparcv9 libgcc, get the regular libgcc
		    # path, remove so name and append 'sparcv9'
		    #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..."
		    #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir"
		fi
	    else
		SHLIB_LD="/usr/ccs/bin/ld -G -z text"
		CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
	    fi
	    ;;
	ULTRIX-4.*)

echo "${ECHO_T}$found" >&6
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
    esac

    if test "$do64bit" = "yes" -a "$do64bit_ok" = "no" ; then
	{ echo "$as_me:$LINENO: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5
echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;}
    fi

    if test "$do64bit" = "yes" -a "$do64bit_ok" = "yes" ; then

cat >>confdefs.h <<\_ACEOF
#define TCL_CFG_DO64BIT 1
_ACEOF

		    ;;
		BSD/OS*)
		    ;;
		IRIX*)
		    ;;
		NetBSD-*|FreeBSD-*)
		    ;;
		Darwin-*)
		    ;;
		RISCos-*)
		    ;;
		SCO_SV-3.2*)
		    ;;
		ULTRIX-4.*)
		    ;;

	echo "$as_me:$LINENO: result: standard shared library" >&5
echo "${ECHO_T}standard shared library" >&6
	FRAMEWORK_BUILD=0
    fi


# tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed
# since on some platforms TCL_LIB_FILE contains shell escapes.
# (See also: TCL_TRIM_DOTS).

eval "TCL_LIB_FILE=${TCL_LIB_FILE}"

# Note:  in the following variable, it's important to use the absolute
# path name of the Tcl directory rather than "..":  this is because
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.

if test "$FRAMEWORK_BUILD" = "1" ; then

#--------------------------------------------------------------------
#       The statements below define various symbols relating to Tcl
#       stub support.
#--------------------------------------------------------------------

# Replace ${VERSION} with contents of ${TCL_VERSION}
# double-eval to account for TCL_TRIM_DOTS.
#
eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}"
eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""

if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
    TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}"
else
    TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`"
fi

#! /bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.
#
# RCS: @(#) $Id: configure.in,v 1.123.2.4 2005/02/02 15:53:59 kennykb Exp $

AC_INIT([tcl],[8.5])
AC_PREREQ(2.57)
dnl AC_CONFIG_HEADERS([tclConfig.h])
dnl AC_CONFIG_COMMANDS_PRE([DEFS=-DHAVE_TCL_CONFIG_H])

TCL_VERSION=8.5

TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}
eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}"

SC_ENABLE_FRAMEWORK

# tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed
# since on some platforms TCL_LIB_FILE contains shell escapes. 
# (See also: TCL_TRIM_DOTS).

eval "TCL_LIB_FILE=${TCL_LIB_FILE}"

# Note:  in the following variable, it's important to use the absolute
# path name of the Tcl directory rather than "..":  this is because
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.

if test "$FRAMEWORK_BUILD" = "1" ; then

#--------------------------------------------------------------------
#       The statements below define various symbols relating to Tcl
#       stub support.
#--------------------------------------------------------------------

# Replace ${VERSION} with contents of ${TCL_VERSION}
# double-eval to account for TCL_TRIM_DOTS.
#
eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}"
eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""

if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
    TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}"
else
    TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`"
fi

	    	# FreeBSD-3 doesn't handle version numbers with dots.
	    	UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
	    	SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
	    	TCL_LIB_VERSIONS_OK=nodots
		;;
	    esac
	    ;;
	Darwin-*)
	    SHLIB_CFLAGS="-fno-common"
	    SHLIB_LD="cc -dynamiclib \${LDFLAGS}"
	    TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TCL_LIB_FILE} -prebind -seg1addr 0xa000000"
	    TK_SHLIB_LD_EXTRAS="-compatibility_version ${TK_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TK_LIB_FILE} -prebind -seg1addr 0xb000000"
	    SHLIB_LD_LIBS='${LIBS}'
	    SHLIB_SUFFIX=".dylib"
	    DL_OBJS="tclLoadDyld.o"
	    PLAT_OBJS=\$\(MAC\_OSX_OBJS\)
	    DL_LIBS=""
	    LDFLAGS="$LDFLAGS -prebind -Wl,-search_paths_first"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    CFLAGS_OPTIMIZE="-Os"
	    LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH"
	    AC_DEFINE(MAC_OSX_TCL, 1, ["Is this a Mac I see before me?"])
	    AC_DEFINE(HAVE_CFBUNDLE, 1, [Do we have access to Mac bundles?])
	    AC_DEFINE(USE_VFORK, 1, [Should we use vfork() instead of fork()?])

	    # won't define thread-safe library routines.

	    AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?])
	    AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1,
		[Do we really want to follow the standard? Yes we do!])

	    SHLIB_CFLAGS="-KPIC"

	    # Check to enable 64-bit flags for compiler/linker
	    if test "$do64bit" = "yes" ; then
		arch=`isainfo`
		if test "$arch" = "sparcv9 sparc" ; then
			if test "$GCC" = "yes" ; then
			    if test "`gcc -dumpversion | awk -F. '{print [$]1}'`" -lt "3" ; then
				AC_MSG_WARN([64bit mode not supported with GCC < 3.2 on $system])
			    else
				do64bit_ok=yes
				CFLAGS="$CFLAGS -m64 -mcpu=v9"
				LDFLAGS="$LDFLAGS -m64 -mcpu=v9"
				SHLIB_CFLAGS="-fPIC"
				SHLIB_LD_FLAGS=""
			    fi
			else
			    do64bit_ok=yes
			    if test "$do64bitVIS" = "yes" ; then
				CFLAGS="$CFLAGS -xarch=v9a"
			    	LDFLAGS_ARCH="-xarch=v9a"
			    else
				CFLAGS="$CFLAGS -xarch=v9"
			    	LDFLAGS_ARCH="-xarch=v9"
			    fi
			fi
		else
		    AC_MSG_WARN([64bit mode only supported sparcv9 system])
		fi
	    fi
	    
	    # Note: need the LIBS below, otherwise Tk won't find Tcl's
	    # symbols when dynamically loaded into tclsh.

	    SHLIB_LD_LIBS='${LIBS}'
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    if test "$GCC" = "yes" ; then
		SHLIB_LD="$CC -shared"
		CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
		if test "$do64bit_ok" = "yes" ; then
		    # We need to specify -static-libgcc or we need to
		    # add the path to the sparv9 libgcc.
		    SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc"
		    # for finding sparcv9 libgcc, get the regular libgcc
		    # path, remove so name and append 'sparcv9'
		    #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..."
		    #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir"
		fi
	    else
		SHLIB_LD="/usr/ccs/bin/ld -G -z text"
		CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
	    fi
	    ;;
	ULTRIX-4.*)

	    AC_MSG_RESULT($found)
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
    esac

    if test "$do64bit" = "yes" -a "$do64bit_ok" = "no" ; then
	AC_MSG_WARN([64bit support being disabled -- don't know magic for this platform])
    fi

    if test "$do64bit" = "yes" -a "$do64bit_ok" = "yes" ; then
	AC_DEFINE(TCL_CFG_DO64BIT, 1, [Is this a 64-bit build?])
    fi

    # Step 4: If pseudo-static linking is in use (see K. B. Kenny, "Dynamic

		    ;;
		BSD/OS*)
		    ;;
		IRIX*)
		    ;;
		NetBSD-*|FreeBSD-*)
		    ;;
		Darwin-*)
		    ;;
		RISCos-*)
		    ;;
		SCO_SV-3.2*)
		    ;;
		ULTRIX-4.*)
		    ;;

/* 
 * tclUnixChan.c
 *
 *	Common channel driver for Unix channels based on files, command
 *	pipes and TCP sockets.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixChan.c,v 1.53.2.1 2005/02/02 15:54:01 kennykb Exp $
 */

#include "tclInt.h"	/* Internal definitions for Tcl. */
#include "tclIO.h"	/* To get Channel type declaration. */

/*
 * sys/ioctl.h has already been included by tclPort.h.	Including termios.h

static int		FileInputProc _ANSI_ARGS_((ClientData instanceData,
			    char *buf, int toRead, int *errorCode));
static int		FileOutputProc _ANSI_ARGS_((
			    ClientData instanceData, CONST char *buf,
			    int toWrite, int *errorCode));
static int		FileSeekProc _ANSI_ARGS_((ClientData instanceData,
			    long offset, int mode, int *errorCode));
#ifdef DEPRECATED
static void             FileThreadActionProc _ANSI_ARGS_ ((
			   ClientData instanceData, int action));
#endif
static Tcl_WideInt	FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
			    Tcl_WideInt offset, int mode, int *errorCode));
static void		FileWatchProc _ANSI_ARGS_((ClientData instanceData,
			    int mask));
static void		TcpAccept _ANSI_ARGS_((ClientData data, int mask));
static int		TcpBlockModeProc _ANSI_ARGS_((ClientData data,
			    int mode));

/*
 * This structure describes the channel type structure for file based IO:
 */

static Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_4,	/* v4 channel */
    FileCloseProc,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
    FileSeekProc,		/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    NULL,			/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    FileWideSeekProc,		/* wide seek proc. */
#ifdef DEPRECATED
    FileThreadActionProc,       /* thread actions */
#else
    NULL,
#endif
};

#ifdef SUPPORTS_TTY
/*
 * This structure describes the channel type structure for serial IO.
 * Note that this type is a subclass of the "file" type.
 */

static Tcl_ChannelType ttyChannelType = {
    "tty",			/* Type name. */
    TCL_CHANNEL_VERSION_4,	/* v4 channel */
    TtyCloseProc,		/* Close proc. */
    FileInputProc,		/* Input proc. */
#if BAD_TIP35_FLUSH
    TtyOutputProc,		/* Output proc. */
#else /* !BAD_TIP35_FLUSH */
    FileOutputProc,		/* Output proc. */
#endif /* BAD_TIP35_FLUSH */
    NULL,			/* Seek proc. */
    TtySetOptionProc,		/* Set option proc. */
    TtyGetOptionProc,		/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    NULL,			/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc. */
    NULL,			/* thread action proc. */
};
#endif	/* SUPPORTS_TTY */

/*
 * This structure describes the channel type structure for TCP socket
 * based IO:
 */

static Tcl_ChannelType tcpChannelType = {
    "tcp",			/* Type name. */
    TCL_CHANNEL_VERSION_4,	/* v4 channel */
    TcpCloseProc,		/* Close proc. */
    TcpInputProc,		/* Input proc. */
    TcpOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    NULL,			/* Set option proc. */
    TcpGetOptionProc,		/* Get option proc. */
    TcpWatchProc,		/* Initialize notifier. */
    TcpGetHandleProc,		/* Get OS handles out of channel. */
    NULL,			/* close2proc. */
    TcpBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc. */
    NULL,			/* thread action proc. */
};


/*
 *----------------------------------------------------------------------
 *
 * FileBlockModeProc --

#endif	/* SUPPORTS_TTY */
    {
	translation = NULL;
	channelTypePtr = &fileChannelType;
	fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
    }

#ifdef DEPRECATED
    if (channelTypePtr == &fileChannelType) {
        /* TIP #218. Removed the code inserting the new structure
	 * into the global list. This is now handled in the thread
	 * action callbacks, and only there.
	 */
        fsPtr->nextPtr = NULL;
    }
#endif /* DEPRECATED */
    fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
    fsPtr->fd = fd;

    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    (ClientData) fsPtr, channelPermissions);

    if (translation != NULL) {

		&& (abortTime.usec <= now.usec))) {
	    break;
	}
    }
    return result;
}

#ifdef DEPRECATED
/*
 *----------------------------------------------------------------------
 *
 * FileThreadActionProc --
 *
 *	Insert or remove any thread local refs to this channel.

 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None. This is a no-op under unix.
 *
 *----------------------------------------------------------------------
 */

static void
FileThreadActionProc (instanceData, action)

     ClientData instanceData;
     int action;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileState *fsPtr = (FileState *) instanceData;

    if (action == TCL_CHANNEL_THREAD_INSERT) {

        fsPtr->nextPtr       = tsdPtr->firstFilePtr;

	tsdPtr->firstFilePtr = fsPtr;
    } else {
        FileState **nextPtrPtr;
	int removed = 0;

	for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
	     nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
	    if ((*nextPtrPtr) == fsPtr) {
	        (*nextPtrPtr) = fsPtr->nextPtr;
		removed = 1;
		break;

	    }
	}


	/*
	 * This could happen if the channel was created in one
	 * thread and then moved to another without updating
	 * the thread local data in each thread.
	 */





	if (!removed) {
	    Tcl_Panic("file info ptr not on thread channel list");
	}






    }
}
#endif

/* 
 * tclUnixEvent.c --
 *
 *	This file implements Unix specific event related routines.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixEvent.c,v 1.5.2.1 2005/02/02 15:54:01 kennykb Exp $
 */

#include "tclInt.h"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Sleep --
 *
 *	Delay execution for the specified number of milliseconds.

 */

void
Tcl_Sleep(ms)
    int ms;			/* Number of milliseconds to sleep. */
{
    struct timeval delay;
    Tcl_Time before, after, vdelay;

    /*
     * The only trick here is that select appears to return early
     * under some conditions, so we have to check to make sure that
     * the right amount of time really has elapsed.  If it's too
     * early, go back to sleep again.
     */

    Tcl_GetTime(&before);
    after = before;
    after.sec += ms/1000;
    after.usec += (ms%1000)*1000;
    if (after.usec > 1000000) {
	after.usec -= 1000000;
	after.sec += 1;
    }
    while (1) {
        /* TIP #233: Scale from virtual time to real-time for select */

	vdelay.sec  = after.sec  - before.sec;
	vdelay.usec = after.usec - before.usec;

	if (vdelay.usec < 0) {
	    vdelay.usec += 1000000;
	    vdelay.sec  -= 1;
	}

	if ((vdelay.sec != 0) || (vdelay.usec != 0)) {
	    (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
	}

	delay.tv_sec  = vdelay.sec;
	delay.tv_usec = vdelay.usec;

	/*
	 * Special note:  must convert delay.tv_sec to int before comparing
	 * to zero, since delay.tv_usec is unsigned on some platforms.
	 */

	if ((((int) delay.tv_sec) < 0)
		|| ((delay.tv_usec == 0) && (delay.tv_sec == 0))) {

/*
 * tclUnixNotify.c --
 *
 *	This file contains the implementation of the select-based
 *	Unix-specific notifier, which is the lowest-level part of the
 *	Tcl event loop.  This file works together with
 *	../generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixNotfy.c,v 1.18.2.2 2005/02/02 15:54:01 kennykb Exp $
 */

#include "tclInt.h"
#include <signal.h> 

extern TclStubs tclStubs;
extern Tcl_NotifierProcs tclOriginalNotifier;

int
Tcl_WaitForEvent(timePtr)
    Tcl_Time *timePtr;		/* Maximum block time, or NULL. */
{
    FileHandler *filePtr;
    FileHandlerEvent *fileEvPtr;

    int mask;
    Tcl_Time myTime;
#ifdef TCL_THREADS
    int waitForFiles;
    Tcl_Time *myTimePtr;
#else
    /* Impl. notes: timeout & timeoutPtr are used if, and only if
     * threads are not enabled. They are the arguments for the regular
     * select() used when the core is not thread-enabled. */

    struct timeval timeout, *timeoutPtr;
    int numFound;
#endif
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
	return tclStubs.tcl_WaitForEvent(timePtr);
    }

    /*
     * Set up the timeout structure.  Note that if there are no events to
     * check for, we return with a negative result rather than blocking
     * forever.
     */

    if (timePtr) {
	/* TIP #233 (Virtualized Time). Is virtual time in effect ?
	 * And do we actually have something to scale ? If yes to both
	 * then we call the handler to do this scaling */

        myTime.sec  = timePtr->sec;
	myTime.usec = timePtr->usec;

	(*tclScaleTimeProcPtr) (&myTime, tclTimeClientData);

#ifdef TCL_THREADS
	myTimePtr = &myTime;
#else
	timeout.tv_sec  = myTime.sec;
	timeout.tv_usec = myTime.usec;
	timeoutPtr      = &timeout;
#endif

#ifndef TCL_THREADS
    } else if (tsdPtr->numFdBits == 0) {
	/*
	 * If there are no threads, no timeout, and no fds registered,
	 * then there are no events possible and we must avoid deadlock.
	 * Note that this is not entirely correct because there might
	 * be a signal that could interrupt the select call, but we
	 * don't handle that case if we aren't using threads.
	 */

	return -1;
#endif
    } else {
#ifdef TCL_THREADS
        myTimePtr  = NULL;
#else
	timeoutPtr = NULL;
#endif
    }

#ifdef TCL_THREADS
    /*
     * Place this thread on the list of interested threads, signal the
     * notifier thread, and wait for a response or a timeout.
     */

    Tcl_MutexLock(&notifierMutex);

    waitForFiles = (tsdPtr->numFdBits > 0);
    if (myTimePtr != NULL && myTimePtr->sec == 0 && myTimePtr->usec == 0) {
	/*
	 * Cannot emulate a polling select with a polling condition variable.
	 * Instead, pretend to wait for files and tell the notifier
	 * thread what we are doing.  The notifier thread makes sure
	 * it goes through select with its select mask in the same state
	 * as ours currently is.  We block until that happens.
	 */

	waitForFiles = 1;
	tsdPtr->pollState = POLL_WANT;
	myTimePtr = NULL;
    } else {
	tsdPtr->pollState = 0;
    }

    if (waitForFiles) {
        /*
         * Add the ThreadSpecificData structure of this thread to the list

    }

    FD_ZERO( &(tsdPtr->readyMasks.readable) );
    FD_ZERO( &(tsdPtr->readyMasks.writable) );
    FD_ZERO( &(tsdPtr->readyMasks.exceptional) );

    if (!tsdPtr->eventReady) {
        Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, myTimePtr);
    }
    tsdPtr->eventReady = 0;

    if (waitForFiles && tsdPtr->onList) {
	/*
	 * Remove the ThreadSpecificData structure of this thread from the
	 * waiting list.  Alert the notifier thread to recompute its select

/* 
 * tclUnixPipe.c --
 *
 *	This file implements the UNIX-specific exec pipeline functions,
 *	the "pipe" channel driver, and the "pid" Tcl command.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixPipe.c,v 1.26.2.1 2005/02/02 15:54:01 kennykb Exp $
 */

#include "tclInt.h"

#ifdef USE_VFORK
#define fork vfork
#endif

/*
 * This structure describes the channel type structure for command pipe
 * based IO:
 */

static Tcl_ChannelType pipeChannelType = {
    "pipe",			/* Type name. */
    TCL_CHANNEL_VERSION_4,	/* v4 channel */
    PipeCloseProc,		/* Close proc. */
    PipeInputProc,		/* Input proc. */
    PipeOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    PipeWatchProc,		/* Initialize notifier. */
    PipeGetHandleProc,		/* Get OS handles out of channel. */
    NULL,			/* close2proc. */
    PipeBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,                       /* wide seek proc */
    NULL,                       /* thread action proc */
};

/*
 *----------------------------------------------------------------------
 *
 * TclpMakeFile --
 *

/* 
 * tclUnixSock.c --
 *
 *	This file contains Unix-specific socket related code.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixSock.c,v 1.9.2.1 2005/02/02 15:54:02 kennykb Exp $
 */

#include "tclInt.h"

/*
 * There is no portable macro for the maximum length
 * of host names returned by gethostbyname().  We should only

 */

int
TclpHasSockets(interp)
    Tcl_Interp *interp;		/* Not used. */
{
    return TCL_OK;
}

/* 
 * tclUnixTime.c --
 *
 *	Contains Unix specific versions of Tcl functions that
 *	obtain time values from the operating system.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixTime.c,v 1.22.2.1 2005/02/02 15:54:02 kennykb Exp $
 */

#include "tclInt.h"
#include <locale.h>
#define TM_YEAR_BASE 1900
#define IsLeapYear(x)   ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))

				 * empty string if the variable was
				 * not set. */

/* Static functions declared in this file */

static void SetTZIfNecessary _ANSI_ARGS_((void));
static void CleanupMemory _ANSI_ARGS_((ClientData));

static void NativeScaleTime _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));
static void NativeGetTime   _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));

/* TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */

Tcl_GetTimeProc*   tclGetTimeProcPtr    = NativeGetTime;
Tcl_ScaleTimeProc* tclScaleTimeProcPtr  = NativeScaleTime;
ClientData         tclTimeClientData    = NULL;

/*
 *-----------------------------------------------------------------------------
 *
 * TclpGetSeconds --
 *
 *	This procedure returns the number of seconds from the epoch.  On

 *-----------------------------------------------------------------------------
 */

unsigned long
TclpGetClicks()
{
    unsigned long now;

#ifdef NO_GETTOD
    if (tclGetTimeProcPtr != NativeGetTime) {
        Tcl_Time time;
        (*tclGetTimeProcPtr) (&time, tclTimeClientData);
	now = time.sec*1000000 + time.usec;
    } else {
        /* A semi-NativeGetTime, specialized to clicks */
        struct tms dummy;
        now = (unsigned long) times(&dummy);

    }


#else
    Tcl_Time time;

    (*tclGetTimeProcPtr) (&time, tclTimeClientData);
    now = time.sec*1000000 + time.usec;
#endif

    return now;
}

/*
 *----------------------------------------------------------------------

 *----------------------------------------------------------------------
 *
 * Tcl_GetTime --
 *
 *	Gets the current system time in seconds and microseconds
 *	since the beginning of the epoch: 00:00 UCT, January 1, 1970.
 *
 *	This function is hooked, allowing users to specify their
 *	own virtual system time.
 *
 * Results:
 *	Returns the current time in timePtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_GetTime(timePtr)
    Tcl_Time *timePtr;		/* Location to store time information. */
{


    (*tclGetTimeProcPtr) (timePtr, tclTimeClientData);



}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetDate --
 *

 */
struct tm*
TclpLocaltime_unix( timePtr )
    CONST time_t* timePtr;
{
    return TclpLocaltime( timePtr );
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimeProc --
 *
 *      TIP #233 (Virtualized Time)
 *	Registers two handlers for the virtualization of Tcl's
 *	access to time information.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Remembers the handlers, alters core behaviour.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetTimeProc (getProc, scaleProc, clientData)
     Tcl_GetTimeProc*   getProc;
     Tcl_ScaleTimeProc* scaleProc;
     ClientData         clientData;
{
    tclGetTimeProcPtr   = getProc;
    tclScaleTimeProcPtr = scaleProc;
    tclTimeClientData   = clientData;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_QueryTimeProc --
 *
 *      TIP #233 (Virtualized Time)
 *	Query which time handlers are registered.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_QueryTimeProc (getProc, scaleProc, clientData)
     Tcl_GetTimeProc**   getProc;
     Tcl_ScaleTimeProc** scaleProc;
     ClientData*         clientData;
{
    if (getProc) {
        *getProc    = tclGetTimeProcPtr;
    }
    if (scaleProc) {
        *scaleProc  = tclScaleTimeProcPtr;
    }
    if (clientData) {
        *clientData = tclTimeClientData;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * NativeScaleTime --
 *
 *	TIP #233
 *	Scale from virtual time to the real-time. For native scaling the
 *	relationship is 1:1 and nothing has to be done.
 *
 * Results:
 *	Scales the time in timePtr.
 *
 * Side effects:
 *	See above.
 *
 *----------------------------------------------------------------------
 */

static void
NativeScaleTime (timePtr, clientData)
     Tcl_Time*  timePtr;
     ClientData clientData;
{
  /* Native scale is 1:1. Nothing is done */
}

/*
 *----------------------------------------------------------------------
 *
 * NativeGetTime --
 *
 *	TIP #233
 *	Gets the current system time in seconds and microseconds
 *	since the beginning of the epoch: 00:00 UCT, January 1, 1970.
 *
 * Results:
 *	Returns the current time in timePtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
NativeGetTime (timePtr, clientData)
     Tcl_Time*  timePtr;
     ClientData clientData;
{
    struct timeval tv;
    struct timezone tz;

    (void) gettimeofday(&tv, &tz);
    timePtr->sec  = tv.tv_sec;
    timePtr->usec = tv.tv_usec;
}
/*
 *----------------------------------------------------------------------
 *
 * SetTZIfNecessary --
 *
 *	Determines whether a call to 'tzset' is needed prior to the
 *	next call to 'localtime' or examination of the 'timezone' variable.

#
# This file is a Makefile for Tcl.  If it has the name "Makefile.in"
# then it is a template for a Makefile;  to generate the actual Makefile,
# run "./configure", which is a configuration script generated by the
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.84.2.5 2005/02/02 15:54:02 kennykb Exp $

VERSION = @TCL_VERSION@

#----------------------------------------------------------------
# Things you can change to personalize the Makefile for your own
# site (you can make these changes in either Makefile.in or
# Makefile, but changes to Makefile will get lost if you re-run

	tclPreserve.$(OBJEXT) \
	tclProc.$(OBJEXT) \
	tclRegexp.$(OBJEXT) \
	tclResolve.$(OBJEXT) \
	tclResult.$(OBJEXT) \
	tclScan.$(OBJEXT) \
	tclStringObj.$(OBJEXT) \
	tclStrToD.$(OBJEXT) \
	tclStubInit.$(OBJEXT) \
	tclStubLib.$(OBJEXT) \
	tclThread.$(OBJEXT) \
	tclThreadAlloc.$(OBJEXT) \
	tclThreadJoin.$(OBJEXT) \
	tclThreadStorage.$(OBJEXT) \
	tclTimer.$(OBJEXT) \
	tclTomMathInterface.$(OBJEXT) \
	tclTrace.$(OBJEXT) \
	tclUtf.$(OBJEXT) \
	tclUtil.$(OBJEXT) \
	tclVar.$(OBJEXT)

TOMMATH_OBJS = \
	bncore.${OBJEXT} \
	bn_reverse.${OBJEXT} \
	bn_fast_s_mp_mul_digs.${OBJEXT} \
	bn_fast_s_mp_sqr.${OBJEXT} \
	bn_mp_add.${OBJEXT} \
	bn_mp_add_d.${OBJEXT} \
	bn_mp_clamp.${OBJEXT} \
	bn_mp_clear.${OBJEXT} \
	bn_mp_clear_multi.${OBJEXT} \
	bn_mp_cmp.${OBJEXT} \
	bn_mp_cmp_mag.${OBJEXT} \

	bn_mp_exch.${OBJEXT} \
	bn_mp_grow.${OBJEXT} \
	bn_mp_init.${OBJEXT} \
	bn_mp_init_copy.${OBJEXT} \
	bn_mp_init_multi.${OBJEXT} \
	bn_mp_init_size.${OBJEXT} \
	bn_mp_karatsuba_mul.${OBJEXT} \
	bn_mp_karatsuba_sqr.$(OBJEXT) \
	bn_mp_lshd.${OBJEXT} \
	bn_mp_mod.${OBJEXT} \
	bn_mp_mod_2d.${OBJEXT} \
	bn_mp_mul.${OBJEXT} \
	bn_mp_mul_2.${OBJEXT} \
	bn_mp_mul_2d.${OBJEXT} \
	bn_mp_mul_d.${OBJEXT} \
	bn_mp_radix_size.${OBJEXT} \
	bn_mp_radix_smap.${OBJEXT} \
	bn_mp_read_radix.${OBJEXT} \
	bn_mp_rshd.${OBJEXT} \
	bn_mp_set.${OBJEXT} \
	bn_mp_sqr.${OBJEXT} \
	bn_mp_sub.${OBJEXT} \
	bn_mp_sub_d.${OBJEXT} \
	bn_mp_toom_mul.${OBJEXT} \
	bn_mp_toom_sqr.${OBJEXT} \
	bn_mp_toradix_n.${OBJEXT} \
	bn_mp_zero.${OBJEXT} \
	bn_s_mp_add.${OBJEXT} \
	bn_s_mp_mul_digs.${OBJEXT} \
	bn_s_mp_sqr.${OBJEXT} \
	bn_s_mp_sub.${OBJEXT}


WIN_OBJS = \
	tclWin32Dll.$(OBJEXT) \
	tclWinChan.$(OBJEXT) \
	tclWinConsole.$(OBJEXT) \

# 
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2001 ActiveState Corporation.
# Copyright (c) 2001-2004 David Gravereaux.
#
#------------------------------------------------------------------------------
# RCS: @(#) $Id: makefile.vc,v 1.135.2.1 2005/02/02 15:54:02 kennykb Exp $
#------------------------------------------------------------------------------

!if !defined(MSDEVDIR) && !defined(MSVCDIR)
MSG = ^
You'll need to run vcvars32.bat from Developer Studio, first, to setup^
the environment.  Jump to this line to read the new instructions.
!error $(MSG)

	$(TMP_DIR)\tclPreserve.obj \
	$(TMP_DIR)\tclProc.obj \
	$(TMP_DIR)\tclRegexp.obj \
	$(TMP_DIR)\tclResolve.obj \
	$(TMP_DIR)\tclResult.obj \
	$(TMP_DIR)\tclScan.obj \
	$(TMP_DIR)\tclStringObj.obj \
	$(TMP_DIR)\tclStrToD.obj \
	$(TMP_DIR)\tclStubInit.obj \
	$(TMP_DIR)\tclStubLib.obj \
	$(TMP_DIR)\tclThread.obj \
	$(TMP_DIR)\tclThreadAlloc.obj \
	$(TMP_DIR)\tclThreadJoin.obj \
	$(TMP_DIR)\tclThreadStorage.obj \
	$(TMP_DIR)\tclTimer.obj \
	$(TMP_DIR)\tclTomMathInterface.obj \
	$(TMP_DIR)\tclTrace.obj \
	$(TMP_DIR)\tclUtf.obj \
	$(TMP_DIR)\tclUtil.obj \
	$(TMP_DIR)\tclVar.obj \
	$(TMP_DIR)\tclWin32Dll.obj \
	$(TMP_DIR)\tclWinChan.obj \
	$(TMP_DIR)\tclWinConsole.obj \
	$(TMP_DIR)\tclWinSerial.obj \
	$(TMP_DIR)\tclWinError.obj \
	$(TMP_DIR)\tclWinFCmd.obj \
	$(TMP_DIR)\tclWinFile.obj \
	$(TMP_DIR)\tclWinInit.obj \
	$(TMP_DIR)\tclWinLoad.obj \
	$(TMP_DIR)\tclWinNotify.obj \
	$(TMP_DIR)\tclWinPipe.obj \
	$(TMP_DIR)\tclWinSock.obj \
	$(TMP_DIR)\tclWinThrd.obj \
	$(TMP_DIR)\tclWinTime.obj \
	$(TMP_DIR)\bncore.obj \
	$(TMP_DIR)\bn_reverse.obj \
	$(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \
	$(TMP_DIR)\bn_fast_s_mp_sqr.obj \
	$(TMP_DIR)\bn_mp_add.obj \
	$(TMP_DIR)\bn_mp_add_d.obj \
	$(TMP_DIR)\bn_mp_clamp.obj \
	$(TMP_DIR)\bn_mp_clear.obj \
	$(TMP_DIR)\bn_mp_clear_multi.obj \
	$(TMP_DIR)\bn_mp_cmp.obj \
	$(TMP_DIR)\bn_mp_cmp_mag.obj \
	$(TMP_DIR)\bn_mp_copy.obj \
	$(TMP_DIR)\bn_mp_count_bits.obj \
	$(TMP_DIR)\bn_mp_div.obj \
	$(TMP_DIR)\bn_mp_div_d.obj \
	$(TMP_DIR)\bn_mp_div_2.obj \
	$(TMP_DIR)\bn_mp_div_2d.obj \
	$(TMP_DIR)\bn_mp_div_3.obj \
	$(TMP_DIR)\bn_mp_exch.obj \
	$(TMP_DIR)\bn_mp_grow.obj \
	$(TMP_DIR)\bn_mp_init.obj \
	$(TMP_DIR)\bn_mp_init_copy.obj \
	$(TMP_DIR)\bn_mp_init_multi.obj \
	$(TMP_DIR)\bn_mp_init_size.obj \
	$(TMP_DIR)\bn_mp_karatsuba_mul.obj \
	$(TMP_DIR)\bn_mp_karatsuba_sqr.obj \
	$(TMP_DIR)\bn_mp_lshd.obj \
	$(TMP_DIR)\bn_mp_mod.obj \
	$(TMP_DIR)\bn_mp_mod_2d.obj \
	$(TMP_DIR)\bn_mp_mul.obj \
	$(TMP_DIR)\bn_mp_mul_2.obj \
	$(TMP_DIR)\bn_mp_mul_2d.obj \
	$(TMP_DIR)\bn_mp_mul_d.obj \
	$(TMP_DIR)\bn_mp_radix_size.obj \
	$(TMP_DIR)\bn_mp_radix_smap.obj \
	$(TMP_DIR)\bn_mp_read_radix.obj \
	$(TMP_DIR)\bn_mp_rshd.obj \
	$(TMP_DIR)\bn_mp_set.obj \
	$(TMP_DIR)\bn_mp_sqr.obj \
	$(TMP_DIR)\bn_mp_sub.obj \
	$(TMP_DIR)\bn_mp_sub_d.obj \
	$(TMP_DIR)\bn_mp_toom_mul.obj \
	$(TMP_DIR)\bn_mp_toom_sqr.obj \
	$(TMP_DIR)\bn_mp_toradix_n.obj \
	$(TMP_DIR)\bn_mp_zero.obj \
	$(TMP_DIR)\bn_s_mp_add.obj \
	$(TMP_DIR)\bn_s_mp_mul_digs.obj \
	$(TMP_DIR)\bn_s_mp_sqr.obj \
	$(TMP_DIR)\bn_s_mp_sub.obj \
!if !$(STATIC_BUILD)
	$(TMP_DIR)\tcl.res
!endif

TCLSTUBOBJS = $(TMP_DIR)\tclStubLib.obj

### The following paths CANNOT have spaces in them.
COMPATDIR	= $(ROOT)\compat
DOCDIR		= $(ROOT)\doc
GENERICDIR	= $(ROOT)\generic
TOMMATHDIR	= $(ROOT)\libtommath
TOOLSDIR	= $(ROOT)\tools
WINDIR		= $(ROOT)\win


#---------------------------------------------------------------------
# Compile flags
#---------------------------------------------------------------------

!if $(DEBUG) && !$(UNCHECKED)
crt = -MTd
!else
crt = -MT
!endif
!endif

TCL_INCLUDES	= -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
BASE_CFLAGS	= $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) \
			-DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH
CON_CFLAGS	= $(cflags) $(cdebug) $(crt) -DCONSOLE
TCL_CFLAGS	= $(BASE_CFLAGS) $(OPTDEFINES)
STUB_CFLAGS     = $(cflags) $(cdebug) $(OPTDEFINES)


#---------------------------------------------------------------------
# Link flags

# Implicit rules
#---------------------------------------------------------------------

{$(WINDIR)}.c{$(TMP_DIR)}.obj::
    $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<

{$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj::
    $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<

{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
    $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<

{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::

/*
 * tclWinChan.c
 *
 *	Channel drivers for Windows channels based on files, command
 *	pipes and TCP sockets.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinChan.c,v 1.37.2.2 2005/02/02 15:54:03 kennykb Exp $
 */

#include "tclWinInt.h"
#include "tclIO.h"

/*
 * State flags used in the info structures below.

static int		FileSeekProc _ANSI_ARGS_((ClientData instanceData,
			    long offset, int mode, int *errorCode));
static Tcl_WideInt	FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
			    Tcl_WideInt offset, int mode, int *errorCode));
static void		FileSetupProc _ANSI_ARGS_((ClientData clientData,
			    int flags));
static void		FileWatchProc _ANSI_ARGS_((ClientData instanceData,
		            int mask));
static void             FileThreadActionProc _ANSI_ARGS_ ((
			   ClientData instanceData, int action));

/*
 * This structure describes the channel type structure for file based IO.
 */

static Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_4,	/* v4 channel */
    FileCloseProc,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
    FileSeekProc,		/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    FileWatchProc,		/* Set up the notifier to watch the channel. */
    FileGetHandleProc,		/* Get an OS handle from channel. */
    NULL,			/* close2proc. */
    FileBlockProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    FileWideSeekProc,		/* Wide seek proc. */
    FileThreadActionProc,	/* Thread action proc. */
};

#if defined(HAVE_NO_SEH) && defined(TCL_MEM_DEBUG)
static void *INITIAL_ESP, *INITIAL_EBP, *INITIAL_HANDLER;
static void *RESTORED_ESP, *RESTORED_EBP, *RESTORED_HANDLER;
#endif /* HAVE_NO_SEH && TCL_MEM_DEBUG */

     */
    tsdPtr = TCL_TSD_INIT(&dataKey);
    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr == fileInfoPtr) {
            /*
             * This channel exists on the thread local list. It should
             * have been removed by an earlier Threadaction call,
             * but do that now since just deallocating fileInfoPtr would
             * leave an deallocated pointer on the thread local list.
             */
	    FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
            break;
        }
    }
    ckfree((char *)fileInfoPtr);
    return errorCode;
}


	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->handle == (HANDLE) handle) {
	    return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL;
	}
    }

    infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
    /* TIP #218. Removed the code inserting the new structure
     * into the global list. This is now handled in the thread
     * action callbacks, and only there.
     */
    infoPtr->nextPtr = NULL;

    infoPtr->validMask = permissions;
    infoPtr->watchMask = 0;
    infoPtr->flags = appendMode;
    infoPtr->handle = handle;
    infoPtr->dirty = 0;
    wsprintfA(channelName, "file%lx", (int) infoPtr);

	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FileThreadActionProc --
 *
 *	Insert or remove any thread local refs to this channel.

 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Changes thread local list of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
FileThreadActionProc (instanceData, action)

     ClientData instanceData;
     int action;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    FileInfo *infoPtr = (FileInfo *) instanceData;

    if (action == TCL_CHANNEL_THREAD_INSERT) {
        infoPtr->nextPtr = tsdPtr->firstFilePtr;
	tsdPtr->firstFilePtr = infoPtr;
    } else {
        FileInfo **nextPtrPtr;
	int removed = 0;







	for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
	     nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
	    if ((*nextPtrPtr) == infoPtr) {
	        (*nextPtrPtr) = infoPtr->nextPtr;
		removed = 1;
		break;
	    }
	}

	/*
	 * This could happen if the channel was created in one thread
	 * and then moved to another without updating the thread
	 * local data in each thread.
	 */

	if (!removed) {
	    Tcl_Panic("file info ptr not on thread channel list");
	}
    }




































}

/* 
 * tclWinConsole.c --
 *
 *	This file implements the Windows-specific console functions,
 *	and the "console" channel driver.
 *
 * Copyright (c) 1999 by Scriptics Corp.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinConsole.c,v 1.12.2.1 2005/02/02 15:54:04 kennykb Exp $
 */

#include "tclWinInt.h"

#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>

static void		ConsoleCheckProc(ClientData clientData, int flags);
static int		ConsoleCloseProc(ClientData instanceData,
			    Tcl_Interp *interp);
static int		ConsoleEventProc(Tcl_Event *evPtr, int flags);
static void		ConsoleExitHandler(ClientData clientData);
static int		ConsoleGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static void             ConsoleInit(void);
static int		ConsoleInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		ConsoleOutputProc(ClientData instanceData,
			    CONST char *buf, int toWrite, int *errorCode);
static DWORD WINAPI	ConsoleReaderThread(LPVOID arg);
static void		ConsoleSetupProc(ClientData clientData, int flags);
static void		ConsoleWatchProc(ClientData instanceData, int mask);
static DWORD WINAPI	ConsoleWriterThread(LPVOID arg);
static void		ProcExitHandler(ClientData clientData);
static int		WaitForRead(ConsoleInfo *infoPtr, int blocking);

static void             ConsoleThreadActionProc _ANSI_ARGS_ ((
			   ClientData instanceData, int action));

/*
 * This structure describes the channel type structure for command console
 * based IO.
 */

static Tcl_ChannelType consoleChannelType = {
    "console",			/* Type name. */
    TCL_CHANNEL_VERSION_4,	/* v4 channel */
    ConsoleCloseProc,		/* Close proc. */
    ConsoleInputProc,		/* Input proc. */
    ConsoleOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    ConsoleWatchProc,		/* Set up notifier to watch the channel. */
    ConsoleGetHandleProc,	/* Get an OS handle from channel. */
    NULL,			/* close2proc. */
    ConsoleBlockModeProc,	/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,                       /* wide seek proc */
    ConsoleThreadActionProc,    /* thread action proc */
};

/*
 *----------------------------------------------------------------------
 *
 * ConsoleInit --
 *
 *	This function initializes the static variables for this file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new event source.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleInit()
{
    ThreadSpecificData *tsdPtr;

    /*
     * Check the initialized flag first, then check again in the mutex.
     * This is a speed enhancement.

    tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
    if (tsdPtr == NULL) {
	tsdPtr = TCL_TSD_INIT(&dataKey);
	tsdPtr->firstConsolePtr = NULL;
	Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
	Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
    }

}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleExitHandler --
 *

	/*
	 * Alert the foreground thread.  Note that we need to treat this like
	 * a critical section so the foreground thread does not terminate
	 * this thread while we are holding a mutex in the notifier code.
	 */

	Tcl_MutexLock(&consoleMutex);
	if (infoPtr->threadId != NULL) {
	    /* TIP #218. When in flight ignore the event, no one will receive it anyway */
	    Tcl_ThreadAlert(infoPtr->threadId);
	}
	Tcl_MutexUnlock(&consoleMutex);
    }

    return 0;
}

/*

	/*
	 * Alert the foreground thread.  Note that we need to treat this like
	 * a critical section so the foreground thread does not terminate
	 * this thread while we are holding a mutex in the notifier code.
	 */

	Tcl_MutexLock(&consoleMutex);
	if (infoPtr->threadId != NULL) {
	    /* TIP #218. When in flight ignore the event, no one will receive it anyway */
	    Tcl_ThreadAlert(infoPtr->threadId);
	}
	Tcl_MutexUnlock(&consoleMutex);
    }

    return 0;
}

TclWinOpenConsoleChannel(handle, channelName, permissions)
    HANDLE handle;
    char *channelName;
    int permissions;
{
    char encoding[4 + TCL_INTEGER_SPACE];
    ConsoleInfo *infoPtr;

    DWORD id, modes;

    ConsoleInit();

    /*
     * See if a channel with this handle already exists.
     */
    
    infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo));
    memset(infoPtr, 0, sizeof(ConsoleInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;

    wsprintfA(encoding, "cp%d", GetConsoleCP());

    infoPtr->threadId = Tcl_GetCurrentThread();

    /*
     * Use the pointer for the name of the result channel.
     * This keeps the channel names unique, since some may share
     * handles (stdin/stdout/stderr for instance).
     */

    wsprintfA(channelName, "file%lx", (int) infoPtr);
    
    infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
            (ClientData) infoPtr, permissions);



    if (permissions & TCL_READABLE) {
	/*
	 * Make sure the console input buffer is ready for only character
	 * input notifications and the buffer is set for line buffering.
	 * IOW, we only want to catch when complete lines are ready for
	 * reading.
	 */

    
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);

    return infoPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleThreadActionProc --
 *
 *	Insert or remove any thread local refs to this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Changes thread local list of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleThreadActionProc (instanceData, action)
     ClientData instanceData;
     int action;
{
    ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;

    /* We do not access firstConsolePtr in the thread structures. This is
     * not for all serials managed by the thread, but only those we are
     * watching. Removal of the filevent handlers before transfer thus
     * takes care of this structure.
     */

    Tcl_MutexLock(&consoleMutex);
    if (action == TCL_CHANNEL_THREAD_INSERT) {
        /* We can't copy the thread information from the channel when
	 * the channel is created. At this time the channel back
	 * pointer has not been set yet. However in that case the
	 * threadId has already been set by TclpCreateCommandChannel
	 * itself, so the structure is still good.
	 */

        ConsoleInit ();
        if (infoPtr->channel != NULL) {
	    infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
	}
    } else {
	infoPtr->threadId = NULL;
    }
    Tcl_MutexUnlock(&consoleMutex);
}

/* 
 * tclWinNotify.c --
 *
 *	This file contains Windows-specific procedures for the notifier,
 *	which is the lowest-level part of the Tcl event loop.  This file
 *	works together with ../generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinNotify.c,v 1.16.2.1 2005/02/02 15:54:04 kennykb Exp $
 */

#include "tclInt.h"

/*
 * The follwing static indicates whether this module has been initialized.
 */

    }

    /*
     * Compute the timeout in milliseconds.
     */

    if (timePtr) {
        /* TIP #233 (Virtualized Time). Convert virtual domain delay
	 * to real-time.
	 */

        Tcl_Time myTime;
        myTime.sec  = timePtr->sec;
	myTime.usec = timePtr->usec;

	(*tclScaleTimeProcPtr) (&myTime, tclTimeClientData);

	timeout = myTime.sec * 1000 + myTime.usec / 1000;
    } else {
	timeout = INFINITE;
    }

    /*
     * Check to see if there are any messages in the queue before waiting
     * because MsgWaitForMultipleObjects will not wake up if there are events

     * up some of the corner cases in the test suite.  We get around
     * this problem by repeating the 'Sleep' call as many times
     * as necessary to make the clock advance by the requisite amount.
     */

    Tcl_Time now;		/* Current wall clock time */
    Tcl_Time desired;		/* Desired wakeup time */
    Tcl_Time vdelay;            /* Time to sleep, for scaling virtual -> real */
    DWORD sleepTime;		/* Time to sleep, real-time */

    vdelay.sec  = ms / 1000;
    vdelay.usec = (ms % 1000) * 1000;

    Tcl_GetTime( &now );
    desired.sec  = now.sec  + vdelay.sec;
    desired.usec = now.usec + vdelay.usec;
    if ( desired.usec > 1000000 ) {
	++desired.sec;
	desired.usec -= 1000000;
    }

    /* TIP #233: Scale delay from virtual to real-time */

    (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
    sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
	
    for ( ; ; ) {
	Sleep( sleepTime );
	Tcl_GetTime( &now );
	if ( now.sec > desired.sec ) {
	    break;
	} else if ( ( now.sec == desired.sec )
	     && ( now.usec >= desired.usec ) ) {
	    break;
	}

	vdelay.sec  = desired.sec  - now.sec;
	vdelay.usec = desired.usec - now.usec;

	(*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
	sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
    }

}

/* 
 * tclWinPipe.c --
 *
 *	This file implements the Windows-specific exec pipeline functions,
 *	the "pipe" channel driver, and the "pid" Tcl command.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinPipe.c,v 1.53.2.1 2005/02/02 15:54:04 kennykb Exp $
 */

#include "tclWinInt.h"

#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>

static void		PipeSetupProc(ClientData clientData, int flags);
static void		PipeWatchProc(ClientData instanceData, int mask);
static DWORD WINAPI	PipeWriterThread(LPVOID arg);
static void		ProcExitHandler(ClientData clientData);
static int		TempFileName(WCHAR name[MAX_PATH]);
static int		WaitForRead(PipeInfo *infoPtr, int blocking);

static void             PipeThreadActionProc _ANSI_ARGS_ ((
			   ClientData instanceData, int action));

/*
 * This structure describes the channel type structure for command pipe
 * based IO.
 */

static Tcl_ChannelType pipeChannelType = {
    "pipe",			/* Type name. */
    TCL_CHANNEL_VERSION_4,	/* v4 channel */
    TCL_CLOSE2PROC,		/* Close proc. */
    PipeInputProc,		/* Input proc. */
    PipeOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    PipeWatchProc,		/* Set up notifier to watch the channel. */
    PipeGetHandleProc,		/* Get an OS handle from channel. */
    PipeClose2Proc,		/* close2proc */
    PipeBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,                       /* wide seek proc */
    PipeThreadActionProc,       /* thread action proc */
};

/*
 *----------------------------------------------------------------------
 *
 * PipeInit --
 *

    infoPtr->writeFile = writeFile;
    infoPtr->errorFile = errorFile;
    infoPtr->numPids = numPids;
    infoPtr->pidPtr = pidPtr;
    infoPtr->writeBuf = 0;
    infoPtr->writeBufLen = 0;
    infoPtr->writeError = 0;
    infoPtr->channel = (Tcl_Channel) NULL;

    /*
     * Use one of the fds associated with the channel as the
     * channel id.
     */

    if (readFile) {

	/*
	 * Alert the foreground thread.  Note that we need to treat this like
	 * a critical section so the foreground thread does not terminate
	 * this thread while we are holding a mutex in the notifier code.
	 */

	Tcl_MutexLock(&pipeMutex);
	if (infoPtr->threadId != NULL) {
	    /* TIP #218. When in flight ignore the event, no one will receive it anyway */
	    Tcl_ThreadAlert(infoPtr->threadId);
	}
	Tcl_MutexUnlock(&pipeMutex);
    }

    return 0;
}

/*

	/*
	 * Alert the foreground thread.  Note that we need to treat this like
	 * a critical section so the foreground thread does not terminate
	 * this thread while we are holding a mutex in the notifier code.
	 */

	Tcl_MutexLock(&pipeMutex);
	if (infoPtr->threadId != NULL) {
	    /* TIP #218. When in flight ignore the event, no one will receive it anyway */
	    Tcl_ThreadAlert(infoPtr->threadId);
	}
	Tcl_MutexUnlock(&pipeMutex);
    }

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * PipeThreadActionProc --
 *
 *	Insert or remove any thread local refs to this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Changes thread local list of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
PipeThreadActionProc (instanceData, action)
     ClientData instanceData;
     int action;
{
    PipeInfo *infoPtr = (PipeInfo *) instanceData;

    /* We do not access firstPipePtr in the thread structures. This is
     * not for all pipes managed by the thread, but only those we are
     * watching. Removal of the filevent handlers before transfer thus
     * takes care of this structure.
     */

    Tcl_MutexLock(&pipeMutex);
    if (action == TCL_CHANNEL_THREAD_INSERT) {
        /* We can't copy the thread information from the channel when
	 * the channel is created. At this time the channel back
	 * pointer has not been set yet. However in that case the
	 * threadId has already been set by TclpCreateCommandChannel
	 * itself, so the structure is still good.
	 */

        PipeInit ();
        if (infoPtr->channel != NULL) {
	    infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
	}
    } else {
	infoPtr->threadId = NULL;
    }
    Tcl_MutexUnlock(&pipeMutex);
}

/*
 * tclWinSerial.c --
 *
 *  This file implements the Windows-specific serial port functions,
 *  and the "serial" channel driver.
 *
 * Copyright (c) 1999 by Scriptics Corp.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * Serial functionality implemented by Rolf.Schroedter@dlr.de
 *
 * RCS: @(#) $Id: tclWinSerial.c,v 1.28.2.1 2005/02/02 15:54:05 kennykb Exp $
 */

#include "tclWinInt.h"

#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>

				    Tcl_DString *dsPtr));
static int			SerialSetOptionProc _ANSI_ARGS_((
				    ClientData instanceData,
				    Tcl_Interp *interp, CONST char *optionName,
				    CONST char *value));
static DWORD WINAPI		SerialWriterThread(LPVOID arg);

static void             SerialThreadActionProc _ANSI_ARGS_ ((
			   ClientData instanceData, int action));

/*
 * This structure describes the channel type structure for command serial
 * based IO.
 */

static Tcl_ChannelType serialChannelType = {
    "serial",			/* Type name. */
    TCL_CHANNEL_VERSION_4,	/* v4 channel */
    SerialCloseProc,		/* Close proc. */
    SerialInputProc,		/* Input proc. */
    SerialOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    SerialSetOptionProc,	/* Set option proc. */
    SerialGetOptionProc,	/* Get option proc. */
    SerialWatchProc,		/* Set up notifier to watch the channel. */
    SerialGetHandleProc,	/* Get an OS handle from channel. */
    NULL,			/* close2proc. */
    SerialBlockProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,                       /* wide seek proc */
    SerialThreadActionProc,     /* thread action proc */
};

/*
 *----------------------------------------------------------------------
 *
 * SerialInit --
 *

	 * Alert the foreground thread.  Note that we need to treat
	 * this like a critical section so the foreground thread does
	 * not terminate this thread while we are holding a mutex in
	 * the notifier code.
	 */

	Tcl_MutexLock(&serialMutex);
	if (infoPtr->threadId != NULL) {
	    /* TIP #218. When in flight ignore the event, no one will receive it anyway */
	    Tcl_ThreadAlert(infoPtr->threadId);
	}
	Tcl_MutexUnlock(&serialMutex);
    }

    return 0;
}

/*

Tcl_Channel
TclWinOpenSerialChannel(handle, channelName, permissions)
    HANDLE handle;
    char *channelName;
    int permissions;
{
    SerialInfo *infoPtr;

    DWORD id;

    SerialInit();

    infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
    memset(infoPtr, 0, sizeof(SerialInfo));

    infoPtr->validMask     = permissions;
    infoPtr->handle        = handle;
    infoPtr->channel       = (Tcl_Channel) NULL;
    infoPtr->readable      = 0; 
    infoPtr->writable      = 1;
    infoPtr->toWrite       = infoPtr->writeQueue = 0;
    infoPtr->blockTime     = SERIAL_DEFAULT_BLOCKTIME;
    infoPtr->lastEventTime = 0;
    infoPtr->lastError     = infoPtr->error = 0;
    infoPtr->threadId      = Tcl_GetCurrentThread();
    infoPtr->sysBufRead    = 4096;
    infoPtr->sysBufWrite   = 4096;

    /*
     * Use the pointer to keep the channel names unique, in case
     * the handles are shared between multiple channels (stdin/stdout).
     */

    wsprintfA(channelName, "file%lx", (int) infoPtr);

    infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
	    (ClientData) infoPtr, permissions);










    SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
    PurgeComm(handle,
	    PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR);

    /*
     * default is blocking

    if (valid) {
	return TCL_OK;
    } else {
	return Tcl_BadChannelOption(interp, optionName,
		"mode pollinterval lasterror queue sysbuffer ttystatus xchar");
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SerialThreadActionProc --
 *
 *	Insert or remove any thread local refs to this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Changes thread local list of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
SerialThreadActionProc (instanceData, action)
     ClientData instanceData;
     int action;
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;

    /* We do not access firstSerialPtr in the thread structures. This is
     * not for all serials managed by the thread, but only those we are
     * watching. Removal of the filevent handlers before transfer thus
     * takes care of this structure.
     */

    Tcl_MutexLock(&serialMutex);
    if (action == TCL_CHANNEL_THREAD_INSERT) {
        /* We can't copy the thread information from the channel when
	 * the channel is created. At this time the channel back
	 * pointer has not been set yet. However in that case the
	 * threadId has already been set by TclpCreateCommandChannel
	 * itself, so the structure is still good.
	 */

        SerialInit ();
        if (infoPtr->channel != NULL) {
	    infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
	}
    } else {
	infoPtr->threadId = NULL;
    }
    Tcl_MutexUnlock(&serialMutex);
}

/* 
 * tclWinSock.c --
 *
 *	This file contains Windows-specific socket related code.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinSock.c,v 1.44.2.1 2005/02/02 15:54:05 kennykb Exp $
 */

#include "tclWinInt.h"

/*
 * Make sure to remove the redirection defines set in tclWinPort.h
 * that is in use in other sections of the core, except for us.

static Tcl_DriverOutputProc	TcpOutputProc;
static Tcl_DriverWatchProc	TcpWatchProc;
static Tcl_DriverGetHandleProc	TcpGetHandleProc;
static int		    WaitForSocketEvent _ANSI_ARGS_((
				SocketInfo *infoPtr, int events,
				int *errorCodePtr));
static DWORD WINAPI	    SocketThread _ANSI_ARGS_((LPVOID arg));

static void             TcpThreadActionProc _ANSI_ARGS_ ((
			   ClientData instanceData, int action));


/*
 * This structure describes the channel type structure for TCP socket
 * based IO.
 */

static Tcl_ChannelType tcpChannelType = {
    "tcp",		    /* Type name. */
    TCL_CHANNEL_VERSION_4,  /* v4 channel */
    TcpCloseProc,	    /* Close proc. */
    TcpInputProc,	    /* Input proc. */
    TcpOutputProc,	    /* Output proc. */
    NULL,		    /* Seek proc. */
    TcpSetOptionProc,	    /* Set option proc. */
    TcpGetOptionProc,	    /* Get option proc. */
    TcpWatchProc,	    /* Set up notifier to watch this channel. */
    TcpGetHandleProc,	    /* Get an OS handle from channel. */
    NULL,		    /* close2proc. */
    TcpBlockProc,	    /* Set socket into (non-)blocking mode. */
    NULL,		    /* flush proc. */
    NULL,		    /* handler proc. */
    NULL,                   /* wide seek proc */
    TcpThreadActionProc,    /* thread action proc */
};


/*
 *----------------------------------------------------------------------
 *
 * InitSockets --

    /* ARGSUSED */
static int
TcpCloseProc(instanceData, interp)
    ClientData instanceData;	/* The socket to close. */
    Tcl_Interp *interp;		/* Unused. */
{
    SocketInfo *infoPtr = (SocketInfo *) instanceData;
    /* TIP #218 */
    int errorCode = 0;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * Check that WinSock is initialized; do not call it if not, to
     * prevent system crashes. This can happen at exit time if the exit
     * handler for WinSock ran before other exit handlers that want to

    
        if (winSock.closesocket(infoPtr->socket) == SOCKET_ERROR) {
            TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
            errorCode = Tcl_GetErrno();
        }
    }

    /* TIP #218. Removed the code removing the structure
     * from the global socket list. This is now done by
     * the thread action callbacks, and only there. This
     * happens before this code is called. We can free
     * without fear of damaging the list.
     */











    ckfree((char *) infoPtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * NewSocketInfo --
 *
 *	This function allocates and initializes a new SocketInfo
 *	structure.
 *
 * Results:
 *	Returns a newly allocated SocketInfo.
 *
 * Side effects:
 *	None, except for allocation of memory.
 *
 *----------------------------------------------------------------------
 */

static SocketInfo *
NewSocketInfo(socket)
    SOCKET socket;

    infoPtr->readyEvents = 0;
    infoPtr->selectEvents = 0;
    infoPtr->acceptEventCount = 0;
    infoPtr->acceptProc = NULL;
    infoPtr->acceptProcData = NULL;
    infoPtr->lastError = 0;

    /* TIP #218. Removed the code inserting the new structure
     * into the global list. This is now handled in the thread
     * action callbacks, and only there.
     */
    infoPtr->nextPtr = NULL;



    return infoPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * CreateSocket --
 *
 *	This function opens a new socket and initializes the
 *	SocketInfo structure.
 *
 * Results:
 *	Returns a new SocketInfo, or NULL with an error in interp.
 *
 * Side effects:
 *	None, except for allocation of memory.
 *
 *----------------------------------------------------------------------
 */

static SocketInfo *
CreateSocket(interp, port, host, server, myaddr, myport, async)
    Tcl_Interp *interp;		/* For error reporting; can be NULL. */

     */
    if (!SocketsEnabled()) {
        return (struct servent *) NULL;
    }

    return winSock.getservbyname(name, proto);
}



/*
 *----------------------------------------------------------------------
 *
 * TcpThreadActionProc --
 *
 *	Insert or remove any thread local refs to this channel.

 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Changes thread local list of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
TcpThreadActionProc (instanceData, action)

     ClientData instanceData;
     int action;
{
    ThreadSpecificData *tsdPtr;
    SocketInfo *infoPtr = (SocketInfo *) instanceData;

    int      notifyCmd;

    if (action == TCL_CHANNEL_THREAD_INSERT) {
        /*
	 * Ensure that socket subsystem is initialized in this thread, or
	 * else sockets will not work.
	 */

        Tcl_MutexLock(&socketMutex);
	InitSockets();
	Tcl_MutexUnlock(&socketMutex);

	tsdPtr = TCL_TSD_INIT(&dataKey);


	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
	infoPtr->nextPtr = tsdPtr->socketList;
	tsdPtr->socketList = infoPtr;
	SetEvent(tsdPtr->socketListLock);

	notifyCmd = SELECT;
    } else {
        SocketInfo **nextPtrPtr;

	int removed = 0;

	tsdPtr  = TCL_TSD_INIT(&dataKey);


	/* TIP #218, Bugfix: All access to socketList has to be protected by the lock */
	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
	for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
	     nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
	    if ((*nextPtrPtr) == infoPtr) {
	        (*nextPtrPtr) = infoPtr->nextPtr;
		removed = 1;
		break;
	    }
	}
	SetEvent(tsdPtr->socketListLock);

	/*
	 * This could happen if the channel was created in one thread
	 * and then moved to another without updating the thread
	 * local data in each thread.
	 */

	if (!removed) {
	    Tcl_Panic("file info ptr not on thread channel list");
	}




	notifyCmd = UNSELECT;


    }

    /*






















































     * Ensure that, or stop, notifications for the socket occur in this thread.
     */

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
		(WPARAM) notifyCmd, (LPARAM) infoPtr);
}

/* 
 * tclWinTime.c --
 *
 *	Contains Windows specific versions of Tcl functions that
 *	obtain time values from the operating system.
 *
 * Copyright 1995-1998 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinTime.c,v 1.28.2.1 2005/02/02 15:54:07 kennykb Exp $
 */

#include "tclInt.h"

#define SECSPERDAY (60L * 60L * 24L)
#define SECSPERYEAR (SECSPERDAY * 365L)
#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY)

                            Tcl_WideInt perfCounter,
			    Tcl_WideInt perfFreq
			));
static Tcl_WideInt		AccumulateSample _ANSI_ARGS_((
			    Tcl_WideInt perfCounter,
			    Tcl_WideUInt fileTime
			));

static void NativeScaleTime _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));
static void NativeGetTime   _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));

/* TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */

Tcl_GetTimeProc*   tclGetTimeProcPtr    = NativeGetTime;
Tcl_ScaleTimeProc* tclScaleTimeProcPtr  = NativeScaleTime;
ClientData         tclTimeClientData    = NULL;

/*
 *----------------------------------------------------------------------
 *
 * TclpGetSeconds --
 *
 *	This procedure returns the number of seconds from the epoch.

 *----------------------------------------------------------------------
 */

unsigned long
TclpGetSeconds()
{
    Tcl_Time t;
    /* Tcl_GetTime inlined */
    (*tclGetTimeProcPtr) (&t, tclTimeClientData);
    return t.sec;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetClicks --

     * Use the Tcl_GetTime abstraction to get the time in microseconds,
     * as nearly as we can, and return it.
     */

    Tcl_Time now;		/* Current Tcl time */
    unsigned long retval;	/* Value to return */

    /* Tcl_GetTime inlined */
    (*tclGetTimeProcPtr) (&now, tclTimeClientData);

    retval = ( now.sec * 1000000 ) + now.usec;
    return retval;

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

 *
 *----------------------------------------------------------------------
 */

void
Tcl_GetTime(timePtr)
    Tcl_Time *timePtr;		/* Location to store time information. */
{
    (*tclGetTimeProcPtr) (timePtr, tclTimeClientData);
}

/*
 *----------------------------------------------------------------------
 *
 * NativeScaleTime --
 *
 *	TIP #233
 *	Scale from virtual time to the real-time. For native scaling the
 *	relationship is 1:1 and nothing has to be done.
 *
 * Results:
 *	Scales the time in timePtr.
 *
 * Side effects:
 *	See above.
 *
 *----------------------------------------------------------------------
 */

static void
NativeScaleTime (timePtr, clientData)
     Tcl_Time*  timePtr;
     ClientData clientData;
{
  /* Native scale is 1:1. Nothing is done */
}

/*
 *----------------------------------------------------------------------
 *
 * NativeGetTime --
 *
 *	TIP #233
 *	Gets the current system time in seconds and microseconds
 *	since the beginning of the epoch: 00:00 UCT, January 1, 1970.
 *
 * Results:
 *	Returns the current time in timePtr.
 *
 * Side effects:
 *	On the first call, initializes a set of static variables to
 *	keep track of the base value of the performance counter, the
 *	corresponding wall clock (obtained through ftime) and the
 *	frequency of the performance counter.  Also spins a thread
 *	whose function is to wake up periodically and monitor these
 *	values, adjusting them as necessary to correct for drift
 *	in the performance counter's oscillator.
 *
 *----------------------------------------------------------------------
 */

static void
NativeGetTime (timePtr, clientData)
     Tcl_Time*  timePtr;
     ClientData clientData;
{
	
    struct timeb t;

    int useFtime = 1;		/* Flag == TRUE if we need to fall back
				 * on ftime rather than using the perf
				 * counter */

    /*
     * The MS implementation of localtime is thread safe because
     * it returns the time in a block of thread-local storage,
     * and Windows does not provide a Posix localtime_r function.
     */
    return localtime( timePtr );
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimeProc --
 *
 *      TIP #233 (Virtualized Time)
 *	Registers two handlers for the virtualization of Tcl's
 *	access to time information.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Remembers the handlers, alters core behaviour.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetTimeProc (getProc, scaleProc, clientData)
     Tcl_GetTimeProc*   getProc;
     Tcl_ScaleTimeProc* scaleProc;
     ClientData         clientData;
{
    tclGetTimeProcPtr   = getProc;
    tclScaleTimeProcPtr = scaleProc;
    tclTimeClientData   = clientData;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_QueryTimeProc --
 *
 *      TIP #233 (Virtualized Time)
 *	Query which time handlers are registered.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_QueryTimeProc (getProc, scaleProc, clientData)
     Tcl_GetTimeProc**   getProc;
     Tcl_ScaleTimeProc** scaleProc;
     ClientData*         clientData;
{
    if (getProc) {
        *getProc    = tclGetTimeProcPtr;
    }
    if (scaleProc) {
        *scaleProc  = tclScaleTimeProcPtr;
    }
    if (clientData) {
        *clientData = tclTimeClientData;
    }
}