Tcl Source Code

2001-11-28  Andreas Kupries  <[email protected]> 

	* NOTES: New file. Read here about the new modularization macros,
	  interdependencies, implications, etc.

	* static.sizes.html: New file. Report on the cuts achieved so
	  far. Regarding the object files only the files which did change
	  in size are reported. Usage of the MODULAR_TCL macro currently
	  cuts about 17 % of the code (measured using strip'ped object
	  files and libraries).

	* Changed files so far
	* tcl.decls
	* tcl.h
	* tclBasic.c
	* tclCmdAH.c
	* tclCmdMZ.c
	* tclEncoding.c
	* tclEvent.c
	* tclFCmd.c
	* tclFileName.c
	* tclIO.c
	* tclIOCmd.c
	* tclIOGT.c
	* tclIOUtil.c
	* tclInt.decls
	* tclInterp.c
	* tclLoad.c
	* tclLoadNone.c
	* tclMain.c
	* tclPipe.c
	* tclStubInit.c
	* tclUtil.c
	* genStubs.tcl
	* tclLoadAout.c
	* tclLoadDl.c
	* tclLoadDld.c
	* tclLoadDyld.c
	* tclLoadNext.c
	* tclLoadOSF.c
	* tclLoadShl.c
	* tclUnixChan.c
	* tclUnixFCmd.c
	* tclUnixFile.c
	* tclUnixInit.c
	* tclUnixNotfy.c
	* tclUnixPipe.c
	* tclUnixSock.c

	* Working on modularization of the tcl core.

	***************************
	****  mod-8-3-4-branch ****
	***************************

2001-11-20  Kevin B. Kenny  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_TimeObjCmd) Added extra parentheses to a
	cast expression to remove ambiguity and conform with Tcl
	Engineering Manual. [Suggestion by Donal Fellows in commentary on
	patch #483500]
	

Pre-notes

	The cutting of the channel system is not as clean as I would like
	it to be, simply because cisco has the special need of a channel
	system trimmed down to the std* channels, without complete removal.
	I am not sure that I have removed the maximum amount of C Api's
	and functions possible for this specific configuration.

	A first step in rationalizing this section would be NO_CHANNELS
	to remove the I/O system completely, and then NO_NONSTDCHAN
	for minial exposure of channels. NO_FILEEVENTS is orthogonal
	to NO_NONSTDCHAN. Drivers are possible only if not NO_CHANNELS,
	but can be disabled separately. The standard channels need the
	"file" driver (currently not disable-able), should use #ifdef's
	to ensure integrity.

	=>	Would be interesting to have a configuration tool which
		is able to express and enforce these constraints.

	=>	The linux core configuration uses the domain specific
		language CML2 (Eric Raymond, written in Python).

	!	Investigate possible usage of SourceNavigator as
		basic for parsing the Tcl core. Use custom tools to
		follow dependencies between structures and functions.

		(What-If tools: What if I exclude this function/struct,
		what else can be removed, or requires this).

		Also: What are the leaf functions in the system ...

	!	Mapping help: Associate functions with functional areas
		and see how the areas relate, how much can be removed
		whenever an area is excluded ...

------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------

Shrinking the core.
	Filesystem

Shrinking the usage of stack
	Large static arrays on the stack
	Look for #define's, check usage, create #defines if necessary
	DString !! (initial dstring data in structure!)
	RE's ?
	NRE1

	== running a stack test of the full test suite for a build is 1.5 hours ==
	== something for the evening and the night ==

Document methodology of testing stack

Macros
	TCL_NO_<feature>	to deactivate/cut feature
	MODULAR_TCL		activates all TCL_NO_<feature> macros
------------------------------------------------------------------------
Cut 1
	The cut currently restricts itself to the UNIX and GENERIC parts.
	No changes in Win* and Mac areas.

	channel system
	-	no sockets		TCL_NO_SOCKETS			/
	-	no serial/tty		TCL_NO_TTY			/
	-	no pipes		TCL_NO_PIPES			/
	-	no pid command		TCL_NO_PIDCMD			/
	-	channel system provides	TCL_NO_NONSTDCHAN		/
		only std* channels [x]
	-	no channel copying	TCL_NO_CHANNELCOPY		/
	-	no [read]ing		TCL_NO_CHANNEL_READ		/
	-	no [eof] [/]		TCL_NO_CHANNEL_EOF		/
	-	no channel set/get cfg	TCL_NO_CHANNEL_CONFIG	[+]	/
	-	no [fblocked]		TCL_NO_CHANNEL_BLOCKED	[/]	/
	-	no fileevents		TCL_NO_FILEEVENTS	[=]	/

	filesystem
	-	disable filesystem	TCL_NO_FILESYSTEM	[%]	/*
	-	disable load'ing	TCL_NO_LOADCMD			/

	master/slave interpreters
	-	disable slave interp	TCL_NO_SLAVEINTERP		/*
	-	disable command aliases	TCL_NO_CMDALIASES		/*

[*]	Access from the C level is not removed.

[x]	Implies that no .rc can be read during unix init.
	Implies that no startup script can be read by tclsh.
	Implies NO_SOCKETS, NO_TTY, NO_PIPES
	Implies currently 'no "source" cmd' and	no loading of encoding files.
	In the generic case this functionality can the reimplemented by direct
	OS calls without using the channel system. Makes the
	implementation platform dependent. As Cisco doesn't want this functionality
	we disable them without adding a new implementation.
	Implies that channels cannot be moved/shared between master/slave interps.
	(seek is removed under the assumption that the std* channels are not seekable)

[/]	Tcl_Eof, Tcl_InputBlocked stay because they are required by [gets].

[+]	Tcl_SetChannelOption stays, required for initial config of std channels.

[=]	Implies no socket servers. Reason: Accept callback for socket server
	is done through fev's

[%]	Ripping the filesystem intrudes heavily on the startup sequence of the
	interpreter as auto_path, package paths, etc. can't be initialized anymore.
	This also cuts into the initialization of encodings.

	Given that encodings will be changed later to not use UTF internally this
	is no big deal. For Cisco. Others might want to have 'no fs', but UTF.

	We have to check that the startup sequence is still operational.

	Given that without a FS loading of encoding from files is
	impossible the loss of initialization is again not so big a deal.

------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------

Handling of stub table when cutting features:

1.	Disable all functions for the feature, from the bottom up to
	the top (script level command). This includes full disabling
	of stub functions too.

	The bottom-up approach enforces link errors in the higher
	levels and thus allows us to use the compiler to find all
	relevant places where we have to cut.

	Cutting stub functions is essential to find everything.

2.	Go through the functions causing link errors in tclStubInit.o
	== stub functions. Add variants which are empty, return errors
	etc. and compile these when the feature is disabled.

	** Changed **
	Add suppressor definitions to "tcl*.decls" and regen the code.

------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------

Future:
	Implement a mechanism for 'tcl.decls'
	which allows the definition of (static, loadable) sub packages.
	So that the stub table is minimally initialized and
	sub packages initialize their slots when loaded.

------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------

# 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.
# 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.33.2.2.2.1 2001/11/28 17:58:35 andreas_kupries Exp $

library tcl

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

    char * Tcl_DbCkrealloc(char *ptr, unsigned int size, char *file, int line)
}

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

declare 9 unix {TCL_NO_FILEEVENTS} {
    void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, \
	    ClientData clientData)
}
declare 10 unix {TCL_NO_FILEEVENTS} {
    void Tcl_DeleteFileHandler(int fd)
}

declare 11 generic {
    void Tcl_SetTimer(Tcl_Time *timePtr)
}
declare 12 generic {

declare 84 generic {
    int Tcl_ConvertElement(CONST char *src, char *dst, int flags)
}
declare 85 generic {
    int Tcl_ConvertCountedElement(CONST char *src, int length, char *dst, \
	    int flags)
}
declare 86 generic {TCL_NO_CMDALIASES} {
    int Tcl_CreateAlias(Tcl_Interp *slave, char *slaveCmd, \
	    Tcl_Interp *target, char *targetCmd, int argc, char **argv)
}
declare 87 generic {TCL_NO_CMDALIASES} {
    int Tcl_CreateAliasObj(Tcl_Interp *slave, char *slaveCmd, \
	    Tcl_Interp *target, char *targetCmd, int objc, \
	    Tcl_Obj *CONST objv[])
}
declare 88 generic {
    Tcl_Channel Tcl_CreateChannel(Tcl_ChannelType *typePtr, char *chanName, \
	    ClientData instanceData, int mask)
}
declare 89 generic {TCL_NO_FILEEVENTS} {
    void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, \
	    Tcl_ChannelProc *proc, ClientData clientData)
}
declare 90 generic {
    void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, \
	    ClientData clientData)
}

	    Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData)
}
declare 96 generic {
    Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, char *cmdName, \
	    Tcl_ObjCmdProc *proc, ClientData clientData, \
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 97 generic {TCL_NO_SLAVEINTERP} {
    Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, char *slaveName, \
	    int isSafe)
}
declare 98 generic {
    Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, \
	    Tcl_TimerProc *proc, ClientData clientData)
}
declare 99 generic {
    Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, \
	    Tcl_CmdTraceProc *proc, ClientData clientData)
}
declare 100 generic {
    void Tcl_DeleteAssocData(Tcl_Interp *interp, char *name)
}
declare 101 generic {TCL_NO_FILEEVENTS} {
    void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, \
	    ClientData clientData)
}
declare 102 generic {
    void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, \
	    ClientData clientData)
}

}
declare 109 generic {
    void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr)
}
declare 110 generic {
    void Tcl_DeleteInterp(Tcl_Interp *interp)
}
declare 111 {unix win} {TCL_NO_PIPES} {
    void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr)
}
declare 112 generic {
    void Tcl_DeleteTimerHandler(Tcl_TimerToken token)
}
declare 113 generic {
    void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace)

}
declare 128 generic {
    char * Tcl_ErrnoMsg(int err)
}
declare 129 generic {
    int Tcl_Eval(Tcl_Interp *interp, char *string)
}
declare 130 generic {TCL_NO_FILESYSTEM TCL_NO_NONSTDCHAN} {
    int Tcl_EvalFile(Tcl_Interp *interp, char *fileName)
}
declare 131 generic {
    int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 132 generic {
    void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)

}
declare 146 generic {
    int Tcl_Flush(Tcl_Channel chan)
}
declare 147 generic {
    void Tcl_FreeResult(Tcl_Interp *interp)
}
declare 148 generic {TCL_NO_CMDALIASES} {
    int Tcl_GetAlias(Tcl_Interp *interp, char *slaveCmd, \
	    Tcl_Interp **targetInterpPtr, char **targetCmdPtr, int *argcPtr, \
	    char ***argvPtr)
}
declare 149 generic {TCL_NO_CMDALIASES} {
    int Tcl_GetAliasObj(Tcl_Interp *interp, char *slaveCmd, \
	    Tcl_Interp **targetInterpPtr, char **targetCmdPtr, int *objcPtr, \
	    Tcl_Obj ***objv)
}
declare 150 generic {
    ClientData Tcl_GetAssocData(Tcl_Interp *interp, char *name, \
	    Tcl_InterpDeleteProc **procPtr)

}
declare 155 generic {
    int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 generic {
    char * Tcl_GetChannelName(Tcl_Channel chan)
}
declare 157 generic {TCL_NO_CHANNEL_CONFIG} {
    int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, \
	    char *optionName, Tcl_DString *dsPtr)
}
declare 158 generic {
    Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan)
}
declare 159 generic {
    int Tcl_GetCommandInfo(Tcl_Interp *interp, char *cmdName, \
	    Tcl_CmdInfo *infoPtr)
}
declare 160 generic {
    char * Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command)
}
declare 161 generic {
    int Tcl_GetErrno(void)
}
declare 162 generic {
    char * Tcl_GetHostName(void)
}
declare 163 generic {{TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES}} {
    int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
}
declare 164 generic {{TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES}} {
    Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp)
}
declare 165 generic {
    CONST char * Tcl_GetNameOfExecutable(void)
}
declare 166 generic {
    Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp)
}

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

declare 167 unix {
    int Tcl_GetOpenFile(Tcl_Interp *interp, char *str, int forWriting, \
	    int checkUsage, ClientData *filePtr)
}

declare 168 generic {TCL_NO_FILESYSTEM} {
    Tcl_PathType Tcl_GetPathType(char *path)
}
declare 169 generic {
    int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr)
}
declare 170 generic {
    int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 171 generic {
    int Tcl_GetServiceMode(void)
}
declare 172 generic {{TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES}} {
    Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, char *slaveName)
}
declare 173 generic {
    Tcl_Channel Tcl_GetStdChannel(int type)
}
declare 174 generic {
    char * Tcl_GetStringResult(Tcl_Interp *interp)

}
declare 184 generic {
    int Tcl_InterpDeleted(Tcl_Interp *interp)
}
declare 185 generic {
    int Tcl_IsSafe(Tcl_Interp *interp)
}
declare 186 generic {TCL_NO_FILESYSTEM} {
    char * Tcl_JoinPath(int argc, char **argv, Tcl_DString *resultPtr)
}
declare 187 generic {
    int Tcl_LinkVar(Tcl_Interp *interp, char *varName, char *addr, int type)
}

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

declare 189 generic {
    Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode)
}
declare 190 generic {
    int Tcl_MakeSafe(Tcl_Interp *interp)
}
declare 191 generic {TCL_NO_SOCKETS} {
    Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
}
declare 192 generic {
    char * Tcl_Merge(int argc, char **argv)
}
declare 193 generic {
    Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
}
declare 194 generic {TCL_NO_FILEEVENTS} {
    void Tcl_NotifyChannel(Tcl_Channel channel, int mask)
}
declare 195 generic {
    Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, \
	    Tcl_Obj *part2Ptr, int flags)
}
declare 196 generic {
    Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, \
	    Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags)
}
declare 197 {unix win} {TCL_NO_FILESYSTEM TCL_NO_PIPES} {
    Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, \
	    char **argv, int flags)
}
declare 198 generic {TCL_NO_FILESYSTEM TCL_NO_FILEEVENTS} {
    Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, char *fileName, \
	    char *modeString, int permissions)
}
declare 199 generic {TCL_NO_SOCKETS} {
    Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, \
	    char *address, char *myaddr, int myport, int async)
}
declare 200 generic {TCL_NO_SOCKETS TCL_NO_FILEEVENTS} {
    Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, char *host, \
	    Tcl_TcpAcceptProc *acceptProc, ClientData callbackData)
}
declare 201 generic {
    void Tcl_Preserve(ClientData data)
}
declare 202 generic {

}
declare 205 generic {
    void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
}
declare 206 generic {
    int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead)
}
declare 207 {unix win} {TCL_NO_PIPES} {
    void Tcl_ReapDetachedProcs(void)
}
declare 208 generic {
    int Tcl_RecordAndEval(Tcl_Interp *interp, char *cmd, int flags)
}
declare 209 generic {
    int Tcl_RecordAndEvalObj(Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags)
}
declare 210 generic {TCL_NO_NONSTDCHAN} {
    void Tcl_RegisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 211 generic {
    void Tcl_RegisterObjType(Tcl_ObjType *typePtr)
}
declare 212 generic {
    Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, char *string)

}
declare 218 generic {
    int Tcl_ScanElement(CONST char *str, int *flagPtr)
}
declare 219 generic {
    int Tcl_ScanCountedElement(CONST char *str, int length, int *flagPtr)
}
declare 220 generic {TCL_NO_NONSTDCHAN} {
    int Tcl_Seek(Tcl_Channel chan, int offset, int mode)
}
declare 221 generic {
    int Tcl_ServiceAll(void)
}
declare 222 generic {
    int Tcl_ServiceEvent(int flags)

declare 241 generic {
    void Tcl_SourceRCFile(Tcl_Interp *interp)
}
declare 242 generic {
    int Tcl_SplitList(Tcl_Interp *interp, CONST char *listStr, int *argcPtr, \
	    char ***argvPtr)
}
declare 243 generic {TCL_NO_FILESYSTEM} {
    void Tcl_SplitPath(CONST char *path, int *argcPtr, char ***argvPtr)
}
declare 244 generic {
    void Tcl_StaticPackage(Tcl_Interp *interp, char *pkgName, \
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}
declare 245 generic {
    int Tcl_StringMatch(CONST char *str, CONST char *pattern)
}
declare 246 generic {
    int Tcl_Tell(Tcl_Channel chan)
}
declare 247 generic {
    int Tcl_TraceVar(Tcl_Interp *interp, char *varName, int flags, \
	    Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 248 generic {
    int Tcl_TraceVar2(Tcl_Interp *interp, char *part1, char *part2, \
	    int flags, Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 249 generic {TCL_NO_FILESYSTEM} {
    char * Tcl_TranslateFileName(Tcl_Interp *interp, char *name, \
	    Tcl_DString *bufferPtr)
}
declare 250 generic {
    int Tcl_Ungets(Tcl_Channel chan, char *str, int len, int atHead)
}
declare 251 generic {

}
declare 275 generic {
    void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
}
declare 276 generic {
    int  Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
}
declare 277 generic {TCL_NO_PIPES} {
    Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
declare 278 {unix win} {
    void Tcl_PanicVA(char *format, va_list argList)
}
declare 279 generic {
    void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)

declare 311 generic {
    void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, \
	    Tcl_Time *timePtr)
}
declare 312 generic {
    int Tcl_NumUtfChars(CONST char *src, int len)
}
declare 313 generic {{TCL_NO_CHANNEL_READ TCL_NO_PIPES}} {
    int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, \
	    int appendFlag)
}
declare 314 generic {
    void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
}
declare 315 generic {

}
declare 339 generic {
    int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 generic {
    char * Tcl_GetString(Tcl_Obj *objPtr)
}
declare 341 generic {TCL_NO_FILESYSTEM} {
    char * Tcl_GetDefaultEncodingDir(void)
}
declare 342 generic {TCL_NO_FILESYSTEM} {
    void Tcl_SetDefaultEncodingDir(char *path)
}
declare 343 generic {
    void Tcl_AlertNotifier(ClientData clientData)
}
declare 344 generic {
    void Tcl_ServiceModeHook(int mode)

    int Tcl_ParseQuotedString(Tcl_Interp *interp, char *string, int numBytes, \
	    Tcl_Parse *parsePtr, int append, char **termPtr)
}
declare 364 generic {
    int Tcl_ParseVarName (Tcl_Interp *interp, char *string, \
	    int numBytes, Tcl_Parse *parsePtr, int append)
}
declare 365 generic {TCL_NO_FILESYSTEM} {
    char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 366 generic {TCL_NO_FILESYSTEM} {
   int Tcl_Chdir(CONST char *dirName)
}
declare 367 generic {TCL_NO_FILESYSTEM} {
   int Tcl_Access(CONST char *path, int mode)
}
declare 368 generic {TCL_NO_FILESYSTEM} {
    int Tcl_Stat(CONST char *path, struct stat *bufPtr)
}
declare 369 generic {
    int Tcl_UtfNcmp(CONST char *s1, CONST char *s2, unsigned long n)
}
declare 370 generic {
    int Tcl_UtfNcasecmp(CONST char *s1, CONST char *s2, unsigned long n)

 * Copyright (c) 1993-1996 Lucent Technologies.
 * Copyright (c) 1994-1998 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: tcl.h,v 1.70.2.9.2.1 2001/11/28 17:58:35 andreas_kupries Exp $
 */

#ifndef _TCL
#define _TCL

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

#ifdef __cplusplus
extern "C" {
#endif

/* The following are
 * - a clause to activate all macros cutting features out of the core.
 * - feature dependencies
 */

#ifdef MODULAR_TCL
#define TCL_NO_SOCKETS         /* Disable "tcp"  channel driver */
#define TCL_NO_TTY             /* Disable "tty"  channel driver */
#define TCL_NO_PIPES           /* Disable "pipe" channel driver */
#define TCL_NO_PIDCMD          /* Disable "pid" command */
#define TCL_NO_NONSTDCHAN      /* Disable creation of channels beyond std* */
#define TCL_NO_CHANNELCOPY     /* Disable channel copying, C/Tcl [fcopy] */
#define TCL_NO_CHANNEL_READ    /* Disable Tcl_ReadChars, [read] */
#define TCL_NO_CHANNEL_EOF     /* Disable [eof] */
#define TCL_NO_CHANNEL_CONFIG  /* Disable [fconfigure] and Tcl_GetChannelOption */
#define TCL_NO_CHANNEL_BLOCKED /* Disable [fblocked] */
#define TCL_NO_FILEEVENTS      /* Disable [fileevent] and underlying APIs */
#define TCL_NO_FILESYSTEM      /* Disable everything related to the filesystem */
#define TCL_NO_LOADCMD         /* Disable [load] and machinery below */
#define TCL_NO_SLAVEINTERP     /* No slave interp's */
#define TCL_NO_CMDALIASES      /* No command aliases */
#endif

#ifdef TCL_NO_NONSTDCHAN
#define TCL_NO_SOCKETS    /* Disable "tcp"  channel driver */
#define TCL_NO_TTY        /* Disable "tty"  channel driver */
#define TCL_NO_PIPES      /* Disable "pipe" channel driver */
#endif

/*
 * The following defines are used to indicate the various release levels.
 */

#define TCL_ALPHA_RELEASE	0
#define TCL_BETA_RELEASE	1
#define TCL_FINAL_RELEASE	2

 * Copyright (c) 1987-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: tclBasic.c,v 1.27.6.1 2001/11/28 17:58:35 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#ifndef TCL_GENERIC_ONLY
#   include "tclPort.h"
#endif

        (CompileProc *) NULL,		1},
    {"eval",		(Tcl_CmdProc *) NULL,	Tcl_EvalObjCmd,
        (CompileProc *) NULL,		1},
    {"exit",		(Tcl_CmdProc *) NULL,	Tcl_ExitObjCmd,
        (CompileProc *) NULL,		0},
    {"expr",		(Tcl_CmdProc *) NULL,	Tcl_ExprObjCmd,
        TclCompileExprCmd,		1},
#ifndef TCL_NO_CHANNELCOPY
    {"fcopy",		(Tcl_CmdProc *) NULL,	Tcl_FcopyObjCmd,
        (CompileProc *) NULL,		1},
#endif
#ifndef TCL_NO_FILEEVENTS
    {"fileevent",	(Tcl_CmdProc *) NULL,	Tcl_FileEventObjCmd,
        (CompileProc *) NULL,		1},
#endif
    {"for",		(Tcl_CmdProc *) NULL,	Tcl_ForObjCmd,
        TclCompileForCmd,		1},
    {"foreach",		(Tcl_CmdProc *) NULL,	Tcl_ForeachObjCmd,
        TclCompileForeachCmd,		1},
    {"format",		(Tcl_CmdProc *) NULL,	Tcl_FormatObjCmd,
        (CompileProc *) NULL,		1},
    {"global",		(Tcl_CmdProc *) NULL,	Tcl_GlobalObjCmd,

        (CompileProc *) NULL,		1},
    {"linsert",		(Tcl_CmdProc *) NULL,	Tcl_LinsertObjCmd,
        (CompileProc *) NULL,		1},
    {"list",		(Tcl_CmdProc *) NULL,	Tcl_ListObjCmd,
        (CompileProc *) NULL,		1},
    {"llength",		(Tcl_CmdProc *) NULL,	Tcl_LlengthObjCmd,
        (CompileProc *) NULL,		1},
#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_LOADCMD
    {"load",		(Tcl_CmdProc *) NULL,	Tcl_LoadObjCmd,
        (CompileProc *) NULL,		0},
#endif
#endif
    {"lrange",		(Tcl_CmdProc *) NULL,	Tcl_LrangeObjCmd,
        (CompileProc *) NULL,		1},
    {"lreplace",	(Tcl_CmdProc *) NULL,	Tcl_LreplaceObjCmd,
        (CompileProc *) NULL,		1},
    {"lsearch",		(Tcl_CmdProc *) NULL,	Tcl_LsearchObjCmd,
        (CompileProc *) NULL,		1},
    {"lsort",		(Tcl_CmdProc *) NULL,	Tcl_LsortObjCmd,

    /*
     * Commands in the UNIX core:
     */

#ifndef TCL_GENERIC_ONLY
    {"after",		(Tcl_CmdProc *) NULL,	Tcl_AfterObjCmd,
        (CompileProc *) NULL,		1},
#ifndef TCL_NO_FILESYSTEM
    {"cd",		(Tcl_CmdProc *) NULL,	Tcl_CdObjCmd,
        (CompileProc *) NULL,		0},
#endif
#ifndef TCL_NO_NONSTDCHAN
    {"close",		(Tcl_CmdProc *) NULL,	Tcl_CloseObjCmd,
        (CompileProc *) NULL,		1},
#endif
#ifndef TCL_NO_CHANNEL_EOF
    {"eof",		(Tcl_CmdProc *) NULL,	Tcl_EofObjCmd,
        (CompileProc *) NULL,		1},
#endif
#ifndef TCL_NO_CHANNEL_BLOCKED
    {"fblocked",	(Tcl_CmdProc *) NULL,	Tcl_FblockedObjCmd,
        (CompileProc *) NULL,		1},
#endif
#ifndef TCL_NO_CHANNEL_CONFIG
    {"fconfigure",	(Tcl_CmdProc *) NULL,	Tcl_FconfigureObjCmd,
        (CompileProc *) NULL,		0},
#endif
#ifndef TCL_NO_FILESYSTEM
    {"file",		(Tcl_CmdProc *) NULL,	Tcl_FileObjCmd,
        (CompileProc *) NULL,		0},
#endif
    {"flush",		(Tcl_CmdProc *) NULL,	Tcl_FlushObjCmd,
        (CompileProc *) NULL,		1},
    {"gets",		(Tcl_CmdProc *) NULL,	Tcl_GetsObjCmd,
        (CompileProc *) NULL,		1},
#ifndef TCL_NO_FILESYSTEM
    {"glob",		(Tcl_CmdProc *) NULL,	Tcl_GlobObjCmd,
        (CompileProc *) NULL,		0},
#endif
#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
    {"open",		(Tcl_CmdProc *) NULL,	Tcl_OpenObjCmd,
        (CompileProc *) NULL,		0},
#endif
#endif
#ifndef TCL_NO_PIDCMD
    {"pid",		(Tcl_CmdProc *) NULL,	Tcl_PidObjCmd,
        (CompileProc *) NULL,		1},
#endif
    {"puts",		(Tcl_CmdProc *) NULL,	Tcl_PutsObjCmd,
        (CompileProc *) NULL,		1},
#ifndef TCL_NO_FILESYSTEM
    {"pwd",		(Tcl_CmdProc *) NULL,	Tcl_PwdObjCmd,
        (CompileProc *) NULL,		0},
#endif
#ifndef TCL_NO_CHANNEL_READ
    {"read",		(Tcl_CmdProc *) NULL,	Tcl_ReadObjCmd,
        (CompileProc *) NULL,		1},
#endif
#ifndef TCL_NO_NONSTDCHAN
    {"seek",		(Tcl_CmdProc *) NULL,	Tcl_SeekObjCmd,
        (CompileProc *) NULL,		1},
#endif
#ifndef TCL_NO_SOCKETS
    {"socket",		(Tcl_CmdProc *) NULL,	Tcl_SocketObjCmd,
        (CompileProc *) NULL,		0},
#endif
    {"tell",		(Tcl_CmdProc *) NULL,	Tcl_TellObjCmd,
        (CompileProc *) NULL,		1},
    {"time",		(Tcl_CmdProc *) NULL,	Tcl_TimeObjCmd,
        (CompileProc *) NULL,		1},
    {"update",		(Tcl_CmdProc *) NULL,	Tcl_UpdateObjCmd,
        (CompileProc *) NULL,		1},
    {"vwait",		(Tcl_CmdProc *) NULL,	Tcl_VwaitObjCmd,
        (CompileProc *) NULL,		1},
    
#ifdef MAC_TCL
    {"beep",		(Tcl_CmdProc *) NULL,	Tcl_BeepObjCmd,
        (CompileProc *) NULL,		0},
    {"echo",		Tcl_EchoCmd,		(Tcl_ObjCmdProc *) NULL,
        (CompileProc *) NULL,		0},
    {"ls",		(Tcl_CmdProc *) NULL, 	Tcl_LsObjCmd,
        (CompileProc *) NULL,		0},
    {"resource",	(Tcl_CmdProc *) NULL,	Tcl_ResourceObjCmd,
        (CompileProc *) NULL,		1},
#ifndef TCL_NO_FILESYSTEM
    {"source",		(Tcl_CmdProc *) NULL,	Tcl_MacSourceObjCmd,
        (CompileProc *) NULL,		0},
#endif
#else
#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_PIPES
    {"exec",		(Tcl_CmdProc *) NULL,	Tcl_ExecObjCmd,
        (CompileProc *) NULL,		0},
#endif
#endif
#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
    /* IOS FIXME : in the generic case this functionality can be made
     * available, it just has to read the file directly instead of using
     * the channel system. This makes the code platform dependent.
     *
     * => See Tcl_EvalFile
     */
    {"source",		(Tcl_CmdProc *) NULL,	Tcl_SourceObjCmd,
        (CompileProc *) NULL,		0},
#endif
#endif /* TCL_NO_FILESYSTEM */
#endif /* MAC_TCL */
    
#endif /* TCL_GENERIC_ONLY */
    {NULL,		(Tcl_CmdProc *) NULL,	(Tcl_ObjCmdProc *) NULL,
        (CompileProc *) NULL,		0}
};

	}
	mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
	mathFuncPtr->builtinFuncIndex = i;
	i++;
    }
    iPtr->flags |= EXPR_INITIALIZED;

#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
    /*
     * Do Multiple/Safe Interps Tcl init stuff
     */

    TclInterpInit(interp);
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */

    /*
     * We used to create the "errorInfo" and "errorCode" global vars at this
     * point because so much of the Tcl implementation assumes they already
     * exist. This is not quite enough, however, since they can be unset
     * at any time.
     *

{
    Interp *iPtr = (Interp *) interp;
    char *newTail;
    Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2;
    Tcl_Command cmd;
    Command *cmdPtr;
    Tcl_HashEntry *hPtr, *oldHPtr;
    int new;
#ifndef TCL_NO_CMDALIASES
    int result;
#endif

    /*
     * Find the existing command. An error is returned if cmdName can't
     * be found.
     */

    cmd = Tcl_FindCommand(interp, oldName, (Tcl_Namespace *) NULL,

    oldHPtr = cmdPtr->hPtr;
    hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &new);
    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = newNsPtr;
    TclResetShadowedCmdRefs(interp, cmdPtr);

#ifndef TCL_NO_CMDALIASES
    /*
     * Now check for an alias loop. If we detect one, put everything back
     * the way it was and report the error.
     */

    result = TclPreventAliasLoop(interp, interp, (Tcl_Command) cmdPtr);
    if (result != TCL_OK) {
        Tcl_DeleteHashEntry(cmdPtr->hPtr);
        cmdPtr->hPtr = oldHPtr;
        cmdPtr->nsPtr = cmdNsPtr;
        return result;
    }
#endif

    /*
     * The new command name is okay, so remove the command from its
     * current namespace. This is like deleting the command, so bump
     * the cmdEpoch to invalidate any cached references to the command.
     */
    

/* 
 * 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.12.2.2.2.1 2001/11/28 17:58:35 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#ifdef MAC_TCL
#include "tclMacInt.h"
#endif
#include <locale.h>

typedef int (StatProc)_ANSI_ARGS_((CONST char *path, struct stat *buf));

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

#ifndef TCL_NO_FILESYSTEM
static int		CheckAccess _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr, int mode));
static int		GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr, StatProc *statProc,
			    struct stat *statPtr));
static char *		GetTypeFromMode _ANSI_ARGS_((int mode));
static int		SplitPath _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr, int *argcPtr, char ***argvPtr));
static int		StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
			    char *varName, struct stat *statPtr));
static char **		StringifyObjects _ANSI_ARGS_((int objc,
			    Tcl_Obj *CONST objv[]));
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_BreakObjCmd --
 *
 *	This procedure is invoked to process the "break" Tcl command.

 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
	/* ARGSUSED */
int
Tcl_CdObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */

    if (result != 0) {
	Tcl_AppendResult(interp, "couldn't change working directory to \"",
		dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConcatObjCmd --
 *
 *	This object-based procedure is invoked to process the "concat" Tcl

 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
	/* ARGSUSED */
int
Tcl_FileObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */

	}
    }

    only3Args:
    Tcl_WrongNumArgs(interp, 2, objv, "name");
    return TCL_ERROR;
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * SplitPath --
 *
 *	Utility procedure used by Tcl_FileObjCmd() to split a path.

 * Side effects:
 *	Memory allocated.  The caller must eventually free this memory
 *	by calling ckfree() on *argvPtr.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static int
SplitPath(interp, objPtr, argcPtr, argvPtr)
    Tcl_Interp *interp;		/* Interp for error return.  May be NULL. */
    Tcl_Obj *objPtr;		/* Path to be split. */
    int *argcPtr;		/* Filled with length of following array. */
    char ***argvPtr;		/* Filled with array of strings representing
				 * the elements of the specified path. */

	    return TCL_ERROR;
	}
	Tcl_SplitPath(fileName, argcPtr, argvPtr);
	Tcl_DStringFree(&ds);
    }
    return TCL_OK;
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * CheckAccess --
 *
 *	Utility procedure used by Tcl_FileObjCmd() to query file
 *	attributes available through the access() system call.
 *
 * Results:
 *	Always returns TCL_OK.  Sets interp's result to boolean true or
 *	false depending on whether the file has the specified attribute.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
  
#ifndef TCL_NO_FILESYSTEM
static int
CheckAccess(interp, objPtr, mode)
    Tcl_Interp *interp;		/* Interp for status return.  Must not be
				 * NULL. */
    Tcl_Obj *objPtr;		/* Name of file to check. */
    int mode;			/* Attribute to check; passed as argument to
				 * access(). */

	value = (TclAccess(fileName, mode) == 0);
        Tcl_DStringFree(&ds);
    }
    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);

    return TCL_OK;
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * GetStatBuf --
 *
 *	Utility procedure used by Tcl_FileObjCmd() to query file

 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static int
GetStatBuf(interp, objPtr, statProc, statPtr)
    Tcl_Interp *interp;		/* Interp for error return.  May be NULL. */
    Tcl_Obj *objPtr;		/* Path name to examine. */
    StatProc *statProc;		/* Either stat() or lstat() depending on
				 * desired behavior. */
    struct stat *statPtr;	/* Filled with info about file obtained by

		    Tcl_GetString(objPtr), "\": ",
		    Tcl_PosixError(interp), (char *) NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * StoreStatData --
 *
 *	This is a utility procedure that breaks out the fields of a
 *	"stat" structure and stores them in textual form into the
 *	elements of an associative array.
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs then
 *	a message is left in interp's result.
 *
 * Side effects:
 *	Elements of the associative array given by "varName" are modified.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static int
StoreStatData(interp, varName, statPtr)
    Tcl_Interp *interp;			/* Interpreter for error reports. */
    char *varName;			/* Name of associative array variable
					 * in which to store stat results. */
    struct stat *statPtr;		/* Pointer to buffer containing
					 * stat data to store in varName. */

    if (Tcl_SetVar2(interp, varName, "type",
	    GetTypeFromMode((unsigned short) statPtr->st_mode), 
	    TCL_LEAVE_ERR_MSG) == NULL) {
	return TCL_ERROR;
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * GetTypeFromMode --
 *
 *	Given a mode word, returns a string identifying the type of a
 *	file.
 *
 * Results:
 *	A static text string giving the file type from mode.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static char *
GetTypeFromMode(mode)
    int mode;
{
    if (S_ISREG(mode)) {
	return "file";
    } else if (S_ISDIR(mode)) {

#ifdef S_ISSOCK
    } else if (S_ISSOCK(mode)) {
	return "socket";
#endif
    }
    return "unknown";
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ForObjCmd --
 *
 *      This procedure is invoked to process the "for" Tcl command.

 * Side effects:
 *	Memory allocated.  The caller must eventually free this memory
 *	by calling ckfree() on the return value.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static char **
StringifyObjects(objc, objv)
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int i;
    char **argv;
    
    argv = (char **) ckalloc((objc + 1) * sizeof(char *));
    for (i = 0; i < objc; i++) {
    	argv[i] = Tcl_GetString(objv[i]);
    }
    argv[i] = NULL;
    return argv;
}
#endif

 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 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: tclCmdMZ.c,v 1.26.2.5.2.1 2001/11/28 17:58:35 andreas_kupries Exp $
 */

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

/*

 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
	/* ARGSUSED */
int
Tcl_PwdObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */

    if (Tcl_GetCwd(interp, &ds) == NULL) {
	return TCL_ERROR;
    }
    Tcl_DStringResult(interp, &ds);
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RegexpObjCmd --
 *
 *	This procedure is invoked to process the "regexp" Tcl command.

 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
/* IOS FIXME : in the generic case this functionality can be made
 * available, it just has to read the file directly instead of using
 * the channel system. This makes the code platform dependent.
 *
 * => See Tcl_EvalFile
 */
	/* ARGSUSED */
int
Tcl_SourceObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    char *bytes;
    int result;
    
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "fileName");
	return TCL_ERROR;
    }

    bytes = Tcl_GetString(objv[1]);
    result = Tcl_EvalFile(interp, bytes);
    return result;
}
#endif
#endif /* TCL_NO_FILESYSTEM */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SplitObjCmd --
 *
 *	This procedure is invoked to process the "split" Tcl command.

/*
 * tclEncoding.c --
 *
 *	Contains the implementation of the encoding conversion package.
 *
 * Copyright (c) 1996-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.
 *
 * RCS: @(#) $Id: tclEncoding.c,v 1.5.2.1.2.1 2001/11/28 17:58:35 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

typedef size_t (LengthProc)_ANSI_ARGS_((CONST char *src));

 * If NULL is passed to one of the conversion routines, the current setting 
 * of the system encoding will be used to perform the conversion.
 */

static Tcl_Encoding defaultEncoding;
static Tcl_Encoding systemEncoding;

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
/*
 * The following variable is used in the sparse matrix code for a
 * TableEncoding to represent a page in the table that has no entries.
 */

static unsigned short emptyPage[256];
#endif
#endif /* TCL_NO_FILESYSTEM */

/*
 * Procedures used only in this module.
 */

static int		BinaryProc _ANSI_ARGS_((ClientData clientData,
			    CONST char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr));
#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
static void		EscapeFreeProc _ANSI_ARGS_((ClientData clientData));
static int		EscapeFromUtfProc _ANSI_ARGS_((ClientData clientData,
			    CONST char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr));
static int		EscapeToUtfProc _ANSI_ARGS_((ClientData clientData,
			    CONST char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr));
#endif
#endif /* TCL_NO_FILESYSTEM */
static void		FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
static Encoding *	GetTableEncoding _ANSI_ARGS_((
			    EscapeEncodingData *dataPtr, int state));
static Tcl_Encoding	LoadEncodingFile _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *name));

/* IOS FIXME : in the generic case this functionality can be made
 * available, it just has to read the file directly instead of using
 * the channel system. This makes the code platform dependent.
 * See also LoadEncodingFile.
 */
static Tcl_Encoding	LoadTableEncoding _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *name, int type, Tcl_Channel chan));
static Tcl_Encoding	LoadEscapeEncoding _ANSI_ARGS_((CONST char *name, 
			    Tcl_Channel chan));
static Tcl_Channel	OpenEncodingFile _ANSI_ARGS_((CONST char *dir,
			    CONST char *name));
static void		TableFreeProc _ANSI_ARGS_((ClientData clientData));
static int		TableFromUtfProc _ANSI_ARGS_((ClientData clientData,
			    CONST char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr));
static int		TableToUtfProc _ANSI_ARGS_((ClientData clientData,
			    CONST char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr));
#endif /* TCL_NO_NONSTDCHAN */
#endif /* TCL_NO_FILESYSTEM */
static size_t		unilen _ANSI_ARGS_((CONST char *src));
static int		UnicodeToUtfProc _ANSI_ARGS_((ClientData clientData,
			    CONST char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr));
static int		UtfToUnicodeProc _ANSI_ARGS_((ClientData clientData,

 * Results:
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
char *
Tcl_GetDefaultEncodingDir()
{
    return tclDefaultEncodingDir;
}
#endif

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_SetDefaultEncodingDir --
 *
 *
 * Results:
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
void
Tcl_SetDefaultEncodingDir(path)
    char *path;
{
    tclDefaultEncodingDir = (char *)ckalloc((unsigned) strlen(path) + 1);
    strcpy(tclDefaultEncodingDir, path);
}
#endif

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncoding --
 *
 *	Given the name of a encoding, find the corresponding Tcl_Encoding

    if (hPtr != NULL) {
	encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
	encodingPtr->refCount++;
	Tcl_MutexUnlock(&encodingMutex);
	return (Tcl_Encoding) encodingPtr;
    }
    Tcl_MutexUnlock(&encodingMutex);
#if defined(TCL_NO_FILESYSTEM) || defined(TCL_NO_NONSTDCHAN)
    return NULL;
#else
    return LoadEncodingFile(interp, name);
#endif
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FreeEncoding --
 *

void
Tcl_GetEncodingNames(interp)
    Tcl_Interp *interp;		/* Interp to hold result. */
{
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
#ifndef TCL_NO_FILESYSTEM
    Tcl_Obj *pathPtr;
#endif
    Tcl_Obj *resultPtr;
    int dummy;

    Tcl_HashTable table;

    Tcl_MutexLock(&encodingMutex);
    Tcl_InitHashTable(&table, TCL_STRING_KEYS);
    hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
    while (hPtr != NULL) {
	Encoding *encodingPtr;
	
	encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
	Tcl_CreateHashEntry(&table, encodingPtr->name, &dummy);
	hPtr = Tcl_NextHashEntry(&search);
    }
    Tcl_MutexUnlock(&encodingMutex);

#ifndef TCL_NO_FILESYSTEM
    pathPtr = TclGetLibraryPath();
    if (pathPtr != NULL) {
	int i, objc;
	Tcl_Obj **objv;
	Tcl_DString pwdString;
	char globArgString[10];

		    }
		}
	    }
	    Tcl_Chdir(Tcl_DStringValue(&pwdString));
	}
	Tcl_DStringFree(&pwdString);
    }
#endif

    /*
     * Clear any values placed in the result by globbing.
     */

    Tcl_ResetResult(interp);
    resultPtr = Tcl_GetObjResult(interp);

 */

void
Tcl_FindExecutable(argv0)
    CONST char *argv0;		/* The value of the application's argv[0]
				 * (native). */
{
#ifndef TCL_NO_FILESYSTEM
    CONST char *name;
    Tcl_DString buffer, nameString;
#endif

    TclInitSubsystems(argv0);

    if (argv0 == NULL) {
	goto done;
    }
    if (tclExecutableName != NULL) {
	ckfree(tclExecutableName);
	tclExecutableName = NULL;
    }
#ifndef TCL_NO_FILESYSTEM
    if ((name = TclpFindExecutable(argv0)) == NULL) {
	goto done;
    }

    /*
     * The value returned from TclpNameOfExecutable is a UTF string that
     * is possibly dirty depending on when it was initialized.  To assure

	ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
    strcpy(tclExecutableName, Tcl_DStringValue(&nameString));

    Tcl_DStringFree(&buffer);
    Tcl_DStringFree(&nameString);
    return;
	
#endif
    done:
    TclFindEncodings(argv0);
}

/*
 *---------------------------------------------------------------------------
 *

 *
 * Side effects:
 *	File read from disk.  
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
    /* IOS FIXME: Add error message
     * Also see OpenEncodingFile below.
     */
static Tcl_Encoding
LoadEncodingFile(interp, name)
    Tcl_Interp *interp;		/* Interp for error reporting, if not NULL. */
    CONST char *name;		/* The name of the encoding file on disk
				 * and also the name for new encoding. */
{
    int objc, i, ch;

    unknown:
    if (interp != NULL) {
	Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
    }
    return NULL;
}
#endif
#endif /* TCL_NO_FILESYSTEM */

/*
 *----------------------------------------------------------------------
 *
 * OpenEncodingFile --
 *
 *	Look for the file encoding/<name>.enc in the specified
 *	directory.
 *
 * Results:
 *	Returns an open file channel if the file exists.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN

/* IOS FIXME : in the generic case this functionality can be made
 * available, it just has to read the file directly instead of using
 * the channel system. This makes the code platform dependent.
 * See also LoadEncodingFile.
 */

static Tcl_Channel
OpenEncodingFile(dir, name)
    CONST char *dir;
    CONST char *name;

{

    type.fromUtfProc    = EscapeFromUtfProc;
    type.freeProc	= EscapeFreeProc;
    type.nullSize	= 1;
    type.clientData	= (ClientData) dataPtr;

    return Tcl_CreateEncoding(&type);
}
#endif /* TCL_NO_NONSTDCHAN */
#endif /* TCL_NO_FILESYSTEM */

/*
 *-------------------------------------------------------------------------
 *
 * BinaryProc --
 *
 *	The default conversion when no other conversion is specified.

 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
static int 
TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
	srcReadPtr, dstWrotePtr, dstCharsPtr)
    ClientData clientData;	/* TableEncodingData that specifies
				 * encoding. */
    CONST char *src;		/* Source string in specified encoding. */
    int srcLen;			/* Source string length in bytes. */

        src++;
    }
    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}
#endif
#endif

/*
 *-------------------------------------------------------------------------
 *
 * TableFromUtfProc --
 *
 *	Convert from UTF-8 into the encoding specified by the
 *	TableEncodingData.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
static int 
TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
	srcReadPtr, dstWrotePtr, dstCharsPtr)
    ClientData clientData;	/* TableEncodingData that specifies
				 * encoding. */
    CONST char *src;		/* Source string in UTF-8. */
    int srcLen;			/* Source string length in bytes. */

	src += len;
    }
    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}
#endif
#endif

/*
 *---------------------------------------------------------------------------
 *
 * TableFreeProc --
 *
 *	This procedure is invoked when an encoding is deleted.  It deletes
 *	the memory used by the TableEncodingData.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory freed.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
static void
TableFreeProc(clientData)
    ClientData clientData;	/* TableEncodingData that specifies
				 * encoding. */
{
    TableEncodingData *dataPtr;

    dataPtr = (TableEncodingData *) clientData;
    ckfree((char *) dataPtr->toUnicode);
    ckfree((char *) dataPtr->fromUnicode);
    ckfree((char *) dataPtr);
}
#endif
#endif

/*
 *-------------------------------------------------------------------------
 *
 * EscapeToUtfProc --
 *
 *	Convert from the encoding specified by the EscapeEncodingData into
 *	UTF-8.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
static int 
EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
	srcReadPtr, dstWrotePtr, dstCharsPtr)
    ClientData clientData;	/* EscapeEncodingData that specifies
				 * encoding. */
    CONST char *src;		/* Source string in specified encoding. */
    int srcLen;			/* Source string length in bytes. */

    *statePtr = (Tcl_EncodingState) state;
    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}
#endif
#endif

/*
 *-------------------------------------------------------------------------
 *
 * EscapeFromUtfProc --
 *
 *	Convert from UTF-8 into the encoding specified by the
 *	EscapeEncodingData.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
static int 
EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
	srcReadPtr, dstWrotePtr, dstCharsPtr)
    ClientData clientData;	/* EscapeEncodingData that specifies
				 * encoding. */
    CONST char *src;		/* Source string in UTF-8. */
    int srcLen;			/* Source string length in bytes. */

    *statePtr = (Tcl_EncodingState) state;
    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}
#endif
#endif

/*
 *---------------------------------------------------------------------------
 *
 * EscapeFreeProc --
 *
 *	This procedure is invoked when an EscapeEncodingData encoding is 
 *	deleted.  It deletes the memory used by the encoding.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory freed.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
static void
EscapeFreeProc(clientData)
    ClientData clientData;	/* EscapeEncodingData that specifies encoding. */
{
    EscapeEncodingData *dataPtr;
    EscapeSubTable *subTablePtr;
    int i;

    dataPtr = (EscapeEncodingData *) clientData;
    if (dataPtr == NULL) {
	return;
    }
    subTablePtr = dataPtr->subTables;
    for (i = 0; i < dataPtr->numSubTables; i++) {
	FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
	subTablePtr++;
    }
    ckfree((char *) dataPtr);
}
#endif
#endif /* TCL_NO_FILESYSTEM */

/*
 *---------------------------------------------------------------------------
 *
 * GetTableEncoding --
 *
 *	Helper function for the EscapeEncodingData conversions.  Gets the

 *	If the encoding that represents the specified state has not
 *	already been used by this EscapeEncoding, it will be loaded
 *	and cached in the dataPtr.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
static Encoding *
GetTableEncoding(dataPtr, state)
    EscapeEncodingData *dataPtr;/* Contains names of encodings. */
    int state;			/* Index in dataPtr of desired Encoding. */
{
    EscapeSubTable *subTablePtr;
    Encoding *encodingPtr;
    
    subTablePtr = &dataPtr->subTables[state];
    encodingPtr = subTablePtr->encodingPtr;
    if (encodingPtr == NULL) {
	encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, subTablePtr->name);
	if ((encodingPtr == NULL) 
		|| (encodingPtr->toUtfProc != TableToUtfProc)) {
	    panic("EscapeToUtfProc: invalid sub table");
	}
	subTablePtr->encodingPtr = encodingPtr;
    }
    return encodingPtr;
}
#endif
#endif /* TCL_NO_FILESYSTEM */

/*
 *---------------------------------------------------------------------------
 *
 * unilen --
 *
 *	A helper function for the Tcl_ExternalToUtf functions.  This

 */

void
TclFindEncodings(argv0)
    CONST char *argv0;		/* Name of executable from argv[0] to main()
				 * in native multi-byte encoding. */
{
#ifndef TCL_NO_FILESYSTEM
    char *native;
    Tcl_Obj *pathPtr;
    Tcl_DString libPath, buffer;
#endif

    if (encodingsInitialized == 0) {
	/* 
	 * Double check inside the mutex.  There may be calls
	 * back into this routine from some of the procedures below.
	 */

	TclpInitLock();
	if (encodingsInitialized == 0) {
	    /*
	     * Have to set this bit here to avoid deadlock with the
	     * routines below us that call into TclInitSubsystems.
	     */

	    encodingsInitialized = 1;

#ifndef TCL_NO_FILESYSTEM
	    native = TclpFindExecutable(argv0);
	    TclpInitLibraryPath(native);

	    /*
	     * The library path was set in the TclpInitLibraryPath routine.
	     * The string set is a dirty UTF string.  To preserve the value
	     * convert the UTF string back to native before setting the new
	     * default encoding.
	     */
	    
	    pathPtr = TclGetLibraryPath();
	    if (pathPtr != NULL) {
		Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1,
			&libPath);
	    }
#endif

	    TclpSetInitialEncodings();

#ifndef TCL_NO_FILESYSTEM
	    /*
	     * Now convert the native string back to UTF.
	     */
	     
	    if (pathPtr != NULL) {
		Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&libPath), -1,
			&buffer);
		pathPtr = Tcl_NewStringObj(Tcl_DStringValue(&buffer), -1);
		TclSetLibraryPath(pathPtr);

		Tcl_DStringFree(&libPath);
		Tcl_DStringFree(&buffer);
	    }
#endif
	}
	TclpInitUnlock();
    }
}
	

/* 
 * tclEvent.c --
 *
 *	This file implements some general event related interfaces including
 *	background errors, exit handlers, and the "vwait" and "update"
 *	command procedures. 
 *
 * Copyright (c) 1990-1994 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.
 *
 * RCS: @(#) $Id: tclEvent.c,v 1.8.2.5.2.1 2001/11/28 17:58:35 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The data structure below is used to report background errors.  One

 *
 *	The refcount of the new library path is incremented and the 
 *	refcount of the old path is decremented.
 *
 *-------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
void
TclSetLibraryPath(pathPtr)
    Tcl_Obj *pathPtr;		/* A Tcl list object whose elements are
				 * the new library path. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     *  No mutex locking is needed here as up the stack we're within
     *  TclpInitLock().
     */
    tclLibraryPathStr = Tcl_GetStringFromObj(pathPtr, NULL);
}
#endif

/*
 *-------------------------------------------------------------------------
 *
 * TclGetLibraryPath --
 *
 *	Return a Tcl list object whose elements are the library path.
 *	The caller should not modify the contents of the returned object.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
Tcl_Obj *
TclGetLibraryPath()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->tclLibraryPath == NULL) {
	/*
	 * Grab the shared string and place it into a new thread specific
	 * Tcl_Obj.
	 */
	tsdPtr->tclLibraryPath = Tcl_NewStringObj(tclLibraryPathStr, -1);

	/* take ownership */
	Tcl_IncrRefCount(tsdPtr->tclLibraryPath);
    }
    return tsdPtr->tclLibraryPath;
}
#endif

/*
 *-------------------------------------------------------------------------
 *
 * TclInitSubsystems --
 *
 *	Initialize various subsytems in Tcl.  This should be called the

/*
 * tclFCmd.c
 *
 *      This file implements the generic portion of file manipulation 
 *      subcommands of the "file" command. 
 *
 * Copyright (c) 1996-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.
 *
 * RCS: @(#) $Id: tclFCmd.c,v 1.6.20.1 2001/11/28 17:58:36 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

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

#ifndef TCL_NO_FILESYSTEM
static int		CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp,
			    char *source, char *dest, int copyFlag,
			    int force));
static char *		FileBasename _ANSI_ARGS_((Tcl_Interp *interp,
			    char *path, Tcl_DString *bufferPtr));
static int		FileCopyRename _ANSI_ARGS_((Tcl_Interp *interp,
			    int argc, char **argv, int copyFlag));
static int		FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
			    int argc, char **argv, int *forcePtr));
#endif

/*
 *---------------------------------------------------------------------------
 *
 * TclFileRenameCmd
 *
 *	This procedure implements the "rename" subcommand of the "file"
 *      command.  Filename arguments need to be translated to native
 *	format before being passed to platform-specific code that
 *	implements rename functionality.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclFileRenameCmd(interp, argc, argv)
    Tcl_Interp *interp;		/* Interp for error reporting. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
{
    return FileCopyRename(interp, argc, argv, 0);
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * TclFileCopyCmd
 *
 *	This procedure implements the "copy" subcommand of the "file"
 *	command.  Filename arguments need to be translated to native
 *	format before being passed to platform-specific code that
 *	implements copy functionality.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclFileCopyCmd(interp, argc, argv)
    Tcl_Interp *interp;		/* Used for error reporting */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
{
    return FileCopyRename(interp, argc, argv, 1);
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * FileCopyRename --
 *
 *	Performs the work of TclFileRenameCmd and TclFileCopyCmd.
 *	See comments for those procedures.
 *
 * Results:
 *	See above.
 *
 * Side effects:
 *	See above.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static int
FileCopyRename(interp, argc, argv, copyFlag)
    Tcl_Interp *interp;		/* Used for error reporting. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
    int copyFlag;		/* If non-zero, copy source(s).  Otherwise,
				 * rename them. */

	if (result == TCL_ERROR) {
	    break;
	}
    }
    Tcl_DStringFree(&targetBuffer);
    return result;
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * TclFileMakeDirsCmd
 *
 *	This procedure implements the "mkdir" subcommand of the "file"
 *      command.  Filename arguments need to be translated to native
 *	format before being passed to platform-specific code that
 *	implements mkdir functionality.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclFileMakeDirsCmd(interp, argc, argv)
    Tcl_Interp *interp;		/* Used for error reporting. */
    int argc;			/* Number of arguments */
    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
{
    Tcl_DString nameBuffer, targetBuffer;

    Tcl_DStringFree(&nameBuffer);
    Tcl_DStringFree(&targetBuffer);
    if (pargv != NULL) {
	ckfree((char *) pargv);
    }
    return result;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclFileDeleteCmd
 *
 *	This procedure implements the "delete" subcommand of the "file"
 *      command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclFileDeleteCmd(interp, argc, argv)
    Tcl_Interp *interp;		/* Used for error reporting */
    int argc;			/* Number of arguments */
    char **argv;		/* Argument strings passed to Tcl_FileCmd. */
{
    Tcl_DString nameBuffer, errorBuffer;

		"\": ", Tcl_PosixError(interp), (char *) NULL);
    } 
    done:
    Tcl_DStringFree(&errorBuffer);
    Tcl_DStringFree(&nameBuffer);
    return result;
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * CopyRenameOneFile
 *
 *	Copies or renames specified source file or directory hierarchy
 *	to the specified target.  
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Target is overwritten if the force flag is set.  Attempting to
 *	copy/rename a file onto a directory or a directory onto a file
 *	will always result in an error.  
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static int
CopyRenameOneFile(interp, source, target, copyFlag, force) 
    Tcl_Interp *interp;		/* Used for error reporting. */
    char *source;		/* Pathname of file to copy.  May need to
				 * be translated. */
    char *target;		/* Pathname of file to create/overwrite.
				 * May need to be translated. */

		(char *) NULL);
    }
    Tcl_DStringFree(&errorBuffer);
    Tcl_DStringFree(&sourcePath);
    Tcl_DStringFree(&targetPath);
    return result;
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * FileForceOption --
 *
 *	Helps parse command line options for file commands that take

 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static int
FileForceOption(interp, argc, argv, forcePtr)
    Tcl_Interp *interp;		/* Interp, for error return. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings.  First command line
				 * option, if it exists, begins at 0. */
    int *forcePtr;		/* If the "-force" was specified, *forcePtr

		    "\": should be -force or --", (char *)NULL);
	    return -1;
	}
    }
    *forcePtr = force;
    return i;
}
#endif
/*
 *---------------------------------------------------------------------------
 *
 * FileBasename --
 *
 *	Given a path in either tcl format (with / separators), or in the
 *	platform-specific format for the current platform, return all the

 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static char *
FileBasename(interp, path, bufferPtr)
    Tcl_Interp *interp;		/* Interp, for error return. */
    char *path;			/* Path whose basename to extract. */
    Tcl_DString *bufferPtr;	/* Initialized DString that receives
				 * basename. */
{

		Tcl_DStringAppend(bufferPtr, argv[argc - 1], -1);
	    }
	}
    }
    ckfree((char *) argv);
    return Tcl_DStringValue(bufferPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclFileAttrsCmd --
 *
 *      Sets or gets the platform-specific attributes of a file. The objc-objv

 *
 * Side effects:
 *      May set file attributes for the file name.
 *      
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclFileAttrsCmd(interp, objc, objv)
    Tcl_Interp *interp;		/* The interpreter for error reporting. */
    int objc;			/* Number of command line arguments. */
    Tcl_Obj *CONST objv[];	/* The command line objects. */
{
    char *fileName;

    }
    result = TCL_OK;

    end:
    Tcl_DStringFree(&buffer);
    return result;
}
#endif

/* 
 * 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.13.2.2.2.1 2001/11/28 17:58:36 andreas_kupries Exp $
 */

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

#ifndef TCL_NO_FILESYSTEM
/*
 * The following regular expression matches the root portion of a Macintosh
 * absolute path.  It will match degenerate Unix-style paths, tilde paths,
 * Unix-style paths, and Mac paths.
 */

#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"

			    char *match));
static char *		SplitMacPath _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *bufPtr));
static char *		SplitWinPath _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *bufPtr));
static char *		SplitUnixPath _ANSI_ARGS_((CONST char *path,
			    Tcl_DString *bufPtr));
#endif

/*
 *----------------------------------------------------------------------
 *
 * FileNameInit --
 *
 *	This procedure initializes the patterns used by this module.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Compiles the regular expressions.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static void
FileNameInit()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    if (!tsdPtr->initialized) {
	tsdPtr->initialized = 1;
	tsdPtr->macRootPatternPtr = Tcl_NewStringObj(MAC_ROOT_PATTERN, -1);
	Tcl_CreateThreadExitHandler(FileNameCleanup, NULL);
    }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * FileNameCleanup --
 *
 *	This procedure is a Tcl_ExitProc used to clean up the static
 *	data structures used in this file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deallocates storage used by the procedures in this file.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static void
FileNameCleanup(clientData)
    ClientData clientData;	/* Not used. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_DecrRefCount(tsdPtr->macRootPatternPtr);
    tsdPtr->initialized = 0;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * ExtractWinRoot --
 *
 *	Matches the root portion of a Windows path and appends it

 *
 * Side effects:
 *	Modifies the specified Tcl_DString.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static CONST char *
ExtractWinRoot(path, resultPtr, offset, typePtr)
    CONST char *path;		/* Path to parse. */
    Tcl_DString *resultPtr;	/* Buffer to hold result. */
    int offset;			/* Offset in buffer where result should be
				 * stored. */
    Tcl_PathType *typePtr;	/* Where to store pathType result */

	    return tail;
	}
    } else {
	*typePtr = TCL_PATH_RELATIVE;
	return path;
    }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetPathType --
 *
 *	Determines whether a given path is relative to the current
 *	directory, relative to the current volume, or absolute.
 *
 * Results:
 *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
 *	TCL_PATH_VOLUME_RELATIVE.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
Tcl_PathType
Tcl_GetPathType(path)
    char *path;
{
    ThreadSpecificData *tsdPtr;
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    Tcl_RegExp re;

		(VOID)ExtractWinRoot(path, &ds, 0, &type);
		Tcl_DStringFree(&ds);
	    }
	    break;
    }
    return type;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SplitPath --
 *
 *	Split a path into a list of path components.  The first element

 *
 * Side effects:
 *	Allocates memory.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
void
Tcl_SplitPath(path, argcPtr, argvPtr)
    CONST char *path;		/* Pointer to string containing a path. */
    int *argcPtr;		/* Pointer to location to fill in with
				 * the number of elements in the path. */
    char ***argvPtr;		/* Pointer to place to store pointer to array
				 * of pointers to path elements. */

	(*argvPtr)[i] = p;
	while ((*p++) != '\0') {}
    }
    (*argvPtr)[i] = NULL;

    Tcl_DStringFree(&buffer);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SplitUnixPath --
 *
 *	This routine is used by Tcl_SplitPath to handle splitting
 *	Unix paths.
 *
 * Results:
 *	Stores a null separated array of strings in the specified
 *	Tcl_DString.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static char *
SplitUnixPath(path, bufPtr)
    CONST char *path;		/* Pointer to string containing a path. */
    Tcl_DString *bufPtr;	/* Pointer to DString to use for the result. */
{
    int length;
    CONST char *p, *elementStart;

	}
	if (*p++ == '\0') {
	    break;
	}
    }
    return Tcl_DStringValue(bufPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SplitWinPath --
 *
 *	This routine is used by Tcl_SplitPath to handle splitting
 *	Windows paths.
 *
 * Results:
 *	Stores a null separated array of strings in the specified
 *	Tcl_DString.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static char *
SplitWinPath(path, bufPtr)
    CONST char *path;		/* Pointer to string containing a path. */
    Tcl_DString *bufPtr;	/* Pointer to DString to use for the result. */
{
    int length;
    CONST char *p, *elementStart;

	    Tcl_DStringAppend(bufPtr, elementStart, length);
	    Tcl_DStringAppend(bufPtr, "", 1);
	}
    } while (*p++ != '\0');

    return Tcl_DStringValue(bufPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SplitMacPath --
 *
 *	This routine is used by Tcl_SplitPath to handle splitting
 *	Macintosh paths.
 *
 * Results:
 *	Returns a newly allocated argv array.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static char *
SplitMacPath(path, bufPtr)
    CONST char *path;		/* Pointer to string containing a path. */
    Tcl_DString *bufPtr;	/* Pointer to DString to use for the result. */
{
    int isMac = 0;		/* 1 if is Mac-style, 0 if Unix-style path. */
    int i, length;

	    if (*p++ == '\0') {
		break;
	    }
	}
    }
    return Tcl_DStringValue(bufPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_JoinPath --
 *
 *	Combine a list of paths in a platform specific manner.
 *
 * Results:
 *	Appends the joined path to the end of the specified
 *	returning a pointer to the resulting string.  Note that
 *	the Tcl_DString must already be initialized.
 *
 * Side effects:
 *	Modifies the Tcl_DString.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
char *
Tcl_JoinPath(argc, argv, resultPtr)
    int argc;
    char **argv;
    Tcl_DString *resultPtr;	/* Pointer to previously initialized DString. */
{
    int oldLength, length, i, needsSep;

	    }
	    break;
			       
    }
    Tcl_DStringFree(&buffer);
    return Tcl_DStringValue(resultPtr);
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_TranslateFileName --
 *
 *	Converts a file name into a form usable by the native system

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
char *
Tcl_TranslateFileName(interp, name, bufferPtr)
    Tcl_Interp *interp;		/* Interpreter in which to store error
				 * message (if necessary). */
    char *name;			/* File name, which may begin with "~" (to
				 * indicate current user's home directory) or
				 * "~<user>" (to indicate any user's home

	    if (*p == '/') {
		*p = '\\';
	    }
	}
    }
    return Tcl_DStringValue(bufferPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclGetExtension --
 *
 *	This function returns a pointer to the beginning of the
 *	extension part of a file name.
 *
 * Results:
 *	Returns a pointer into name which indicates where the extension
 *	starts.  If there is no extension, returns NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
char *
TclGetExtension(name)
    char *name;			/* File name to parse. */
{
    char *p, *lastSep;

    /*

     * so that "foo..o" would be split into "foo" and "..o".  This is a
     * confusing and usually incorrect behavior, so now we split at the last
     * period in the name.
     */

    return p;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * DoTildeSubst --
 *
 *	Given a string following a tilde, this routine returns the

 *
 * Side effects:
 *	Information may be left in resultPtr.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static char *
DoTildeSubst(interp, user, resultPtr)
    Tcl_Interp *interp;		/* Interpreter in which to store error
				 * message (if necessary). */
    CONST char *user;		/* Name of user whose home directory should be
				 * substituted, or "" for current user. */
    Tcl_DString *resultPtr;	/* Initialized DString filled with name

			(char *) NULL);
	    }
	    return NULL;
	}
    }
    return resultPtr->string;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GlobObjCmd --
 *
 *	This procedure is invoked to process the "glob" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
	/* ARGSUSED */
int
Tcl_GlobObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */

	if (globTypes->macCreator != NULL) {
	    Tcl_DecrRefCount(globTypes->macCreator);
	}
	ckfree((char *) globTypes);
    }
    return result;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclGlob --
 *
 *	This procedure prepares arguments for the TclDoGlob call.

 *
 * Side effects:
 *	The currentArgString is written to.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
	/* ARGSUSED */
int
TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
    Tcl_Interp *interp;		/* Interpreter for returning error message
				 * or appending list of matching file names. */
    char *pattern;		/* Glob pattern to match. Must not refer
				 * to a static string. */

	if (globFlags & GLOBMODE_NO_COMPLAIN) {
	    Tcl_ResetResult(interp);
	    return TCL_OK;
	}
    }
    return result;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SkipToChar --
 *
 *	This function traverses a glob pattern looking for the next

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static int
SkipToChar(stringPtr, match)
    char **stringPtr;			/* Pointer string to check. */
    char *match;			/* Pointer to character to find. */
{
    int quoted, level;
    register char *p;

	} else if (*p == '\\') {
	    quoted = 1;
	}
    }
    *stringPtr = p;
    return 0;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclDoGlob --
 *
 *	This recursive procedure forms the heart of the globbing

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclDoGlob(interp, separators, headPtr, tail, types)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting
				 * (e.g. unmatched brace). */
    char *separators;		/* String containing separator characters
				 * that should be used to identify globbing
				 * boundaries. */

	    }
	    break;
	}
    }

    return TCL_OK;
}
#endif

/* 
 * 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.20.2.12.2.1 2001/11/28 17:58:36 andreas_kupries Exp $
 */

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

#ifdef TCL_NO_NONSTDCHAN
static void		Tcl_RegisterChannelInternal _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Channel chan));

#define Tcl_RegisterChannel Tcl_RegisterChannelInternal
#endif


/*
 * All static variables used in this file are collected into a single
 * instance of the following structure.  For multi-threaded implementations,
 * there is one instance of this structure for each thread.
 *

static Tcl_ThreadDataKey dataKey;

/*
 * Static functions in this file:
 */

static ChannelBuffer *	AllocChannelBuffer _ANSI_ARGS_((int length));
#ifndef TCL_NO_FILEEVENTS
static void		ChannelTimerProc _ANSI_ARGS_((
				ClientData clientData));
#endif
static int		CheckChannelErrors _ANSI_ARGS_((ChannelState *statePtr,
				int direction));
static int		CheckFlush _ANSI_ARGS_((Channel *chanPtr,
				ChannelBuffer *bufPtr, int newlineFlag));
static int		CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
				ChannelState *statePtr));
static void		CheckForStdChannelsBeingClosed _ANSI_ARGS_((
				Tcl_Channel chan));
#ifndef TCL_NO_FILEEVENTS
static void		CleanupChannelHandlers _ANSI_ARGS_((
				Tcl_Interp *interp, Channel *chanPtr));
#endif
static int		CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
				Channel *chanPtr, int errorCode));
static void		CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
				Tcl_Encoding encoding));
static int		CopyAndTranslateBuffer _ANSI_ARGS_((
				ChannelState *statePtr, char *result,
				int space));
static int		CopyBuffer _ANSI_ARGS_((
				Channel *chanPtr, char *result,
				int space));
#ifndef TCL_NO_CHANNELCOPY
static int		CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
#ifndef TCL_NO_FILEEVENTS
static void		CopyEventProc _ANSI_ARGS_((ClientData clientData,
				int mask));
#endif
#endif
#ifndef TCL_NO_FILEEVENTS
static void		CreateScriptRecord _ANSI_ARGS_((
				Tcl_Interp *interp, Channel *chanPtr,
				int mask, Tcl_Obj *scriptPtr));
#endif
static void		DeleteChannelTable _ANSI_ARGS_((
				ClientData clientData, Tcl_Interp *interp));
#ifndef TCL_NO_FILEEVENTS
static void		DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
				Channel *chanPtr, int mask));
#endif
static void		DiscardInputQueued _ANSI_ARGS_((ChannelState *statePtr,
				int discardSavedBuffers));
static void		DiscardOutputQueued _ANSI_ARGS_((
				ChannelState *chanPtr));
static int		DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
				int slen));
static int		DoWrite _ANSI_ARGS_((Channel *chanPtr, char *src,
				int srcLen));
static int		FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
				GetsState *statePtr));
static int		FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
				Channel *chanPtr, int calledFromAsyncFlush));
static Tcl_HashTable *	GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
static int		GetInput _ANSI_ARGS_((Channel *chanPtr));
static void		PeekAhead _ANSI_ARGS_((Channel *chanPtr,
				char **dstEndPtr, GetsState *gsPtr));
#if !defined(TCL_NO_CHANNEL_READ) || !defined(TCL_NO_PIPES)
static int		ReadBytes _ANSI_ARGS_((ChannelState *statePtr,
				Tcl_Obj *objPtr, int charsLeft,
				int *offsetPtr));
static int		ReadChars _ANSI_ARGS_((ChannelState *statePtr,
				Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,
				int *factorPtr));
#endif
static void		RecycleBuffer _ANSI_ARGS_((ChannelState *statePtr,
				ChannelBuffer *bufPtr, int mustDiscard));
static int		StackSetBlockMode _ANSI_ARGS_((Channel *chanPtr,
				int mode));
static int		SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
				Channel *chanPtr, int mode));
#ifndef TCL_NO_CHANNELCOPY
static void		StopCopy _ANSI_ARGS_((CopyState *csPtr));
#endif
#if !defined(TCL_NO_CHANNEL_READ) || !defined(TCL_NO_PIPES)
static int		TranslateInputEOL _ANSI_ARGS_((ChannelState *statePtr,
				char *dst, CONST char *src, int *dstLenPtr,
				int *srcLenPtr));
#endif
static int		TranslateOutputEOL _ANSI_ARGS_((ChannelState *statePtr,
				char *dst, CONST char *src, int *dstLenPtr,
				int *srcLenPtr));
static void		UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
static int		WriteBytes _ANSI_ARGS_((Channel *chanPtr,
				CONST char *src, int srcLen));
static int		WriteChars _ANSI_ARGS_((Channel *chanPtr,

    Tcl_Interp *interp;		/* The interpreter being deleted. */
{
    Tcl_HashTable *hTblPtr;	/* The hash table. */
    Tcl_HashSearch hSearch;	/* Search variable. */
    Tcl_HashEntry *hPtr;	/* Search variable. */
    Channel *chanPtr;		/* Channel being deleted. */
    ChannelState *statePtr;	/* State of Channel being deleted. */
#ifndef TCL_NO_FILEEVENTS
    EventScriptRecord *sPtr, *prevPtr, *nextPtr;
    				/* Variables to loop over all channel events
                                 * registered, to delete the ones that refer
                                 * to the interpreter being deleted. */
#endif

    /*
     * Delete all the registered channels - this will close channels whose
     * refcount reaches zero.
     */
    
    hTblPtr = (Tcl_HashTable *) clientData;
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
	 hPtr != (Tcl_HashEntry *) NULL;
	 hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {

        chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
	statePtr = chanPtr->state;

#ifndef TCL_NO_FILEEVENTS
        /*
         * Remove any fileevents registered in this interpreter.
         */
        
        for (sPtr = statePtr->scriptRecordPtr,
                 prevPtr = (EventScriptRecord *) NULL;
	     sPtr != (EventScriptRecord *) NULL;

		Tcl_DecrRefCount(sPtr->scriptPtr);
                ckfree((char *) sPtr);
            } else {
                prevPtr = sPtr;
            }
        }
#endif

        /*
         * Cannot call Tcl_UnregisterChannel because that procedure calls
         * Tcl_GetAssocData to get the channel table, which might already
         * be inaccessible from the interpreter structure. Instead, we
         * emulate the behavior of Tcl_UnregisterChannel directly here.
         */

 *
 * Side effects:
 *	Deletes the hash entry for a channel associated with an interpreter.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_NO_NONSTDCHAN
/* IOS FIXME: Unregister is still required to make sub interpreters safe by
 * removing the std* channels from them.
 * This means that removal of sub interp functionality allows the removal of this
 * functionality too.
 */
#endif
int
Tcl_UnregisterChannel(interp, chan)
    Tcl_Interp *interp;		/* Interpreter in which channel is defined. */
    Tcl_Channel chan;		/* Channel to delete. */
{
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_HashEntry *hPtr;	/* Search variable. */

            return TCL_OK;
        }
        if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
            return TCL_OK;
        }
        Tcl_DeleteHashEntry(hPtr);

#ifndef TCL_NO_FILEEVENTS
        /*
         * Remove channel handlers that refer to this interpreter, so that they
         * will not be present if the actual close is delayed and more events
         * happen on the channel. This may occur if the channel is shared
         * between several interpreters, or if the channel has async
         * flushing active.
         */
    
        CleanupChannelHandlers(interp, chanPtr);
#endif
    }

    statePtr->refCount--;
    
    /*
     * Perform special handling for standard channels being closed. If the
     * refCount is now 1 it means that the last reference to the standard

 *	Tcl_Close removes the channel as far as the user is concerned.
 *	However, it may continue to exist for a while longer if it has
 *	a background flush scheduled. The device itself is eventually
 *	closed and the channel record removed, in CloseChannel, above.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_Close(interp, chan)
    Tcl_Interp *interp;			/* Interpreter for errors. */
    Tcl_Channel chan;			/* The channel being closed. Must
                                         * not be referenced in any
                                         * interpreter. */

    }
    statePtr->chPtr = (ChannelHandler *) NULL;

    /*
     * Cancel any pending copy operation.
     */

#ifndef TCL_NO_CHANNELCOPY
    StopCopy(statePtr->csPtr);
#endif

    /*
     * Must set the interest mask now to 0, otherwise infinite loops
     * will occur if Tcl_DoOneEvent is called before the channel is
     * finally deleted in FlushChannel. This can happen if the channel
     * has a background flush active.
     */

 *	to retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

#if !defined(TCL_NO_CHANNEL_READ) || !defined(TCL_NO_PIPES)
int
Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
    Tcl_Channel chan;		/* The channel to read. */
    Tcl_Obj *objPtr;		/* Input data is stored in this object. */
    int toRead;			/* Maximum number of characters to store,
				 * or -1 to read all available data (up to EOF
				 * or when channel blocks). */

     * Update the notifier state so we don't block while there is still
     * data in the buffers.
     */

    UpdateInterest(chanPtr);
    return copied;
}
#endif
/*
 *---------------------------------------------------------------------------
 *
 * ReadBytes --
 *
 *	Reads from the channel until the requested number of bytes have
 *	been seen, EOF is seen, or the channel would block.  Bytes from

 *	in the object).
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
#if !defined(TCL_NO_CHANNEL_READ) || !defined(TCL_NO_PIPES)
static int
ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
    ChannelState *statePtr;	/* State of the channel to read. */
    int bytesToRead;		/* Maximum number of characters to store,
				 * or < 0 to get all available characters.
				 * Characters are obtained from the first
				 * buffer in the queue -- even if this number

	statePtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
	return 1;
    }

    *srcLenPtr = srcLen;
    return 0;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Ungets --
 *
 *	Causes the supplied string to be added to the input queue of

 *	to retrieve the POSIX error code for the error that occurred.
 *
 * Side effects:
 *	May flush output on the channel. May discard queued input.
 *
 *----------------------------------------------------------------------
 */
#ifndef TCL_NO_NONSTDCHAN
int
Tcl_Seek(chan, offset, mode)
    Tcl_Channel chan;		/* The channel on which to seek. */
    int offset;			/* Offset to seek to. */
    int mode;			/* Relative to which location to seek? */
{
    Channel *chanPtr = (Channel *) chan;	/* The real IO channel. */

	if (result != 0) {
	    return -1;
	}
    }

    return curPos;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Tell --
 *
 *	Returns the position of the next character to be read/written on

 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CHANNEL_CONFIG
int
Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
    Tcl_Interp *interp;		/* For error reporting - can be NULL. */
    Tcl_Channel chan;		/* Channel on which to get option. */
    char *optionName;		/* Option to get. */
    Tcl_DString *dsPtr;		/* Where to store value(s). */
{

        if (len == 0) {
            return TCL_OK;
        }
	return Tcl_BadChannelOption(interp, optionName, NULL);
    }
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_SetChannelOption --
 *
 *	Sets an option on a channel.

 *
 * Side effects:
 *	Removes channel handlers.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
static void
CleanupChannelHandlers(interp, chanPtr)
    Tcl_Interp *interp;
    Channel *chanPtr;
{
    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
    EventScriptRecord *sPtr, *prevPtr, *nextPtr;

	    Tcl_DecrRefCount(sPtr->scriptPtr);
            ckfree((char *) sPtr);
        } else {
            prevPtr = sPtr;
        }
    }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NotifyChannel --
 *
 *	This procedure is called by a channel driver when a driver
 *	detects an event on a channel.  This procedure is responsible
 *	for actually handling the event by invoking any channel
 *	handler callbacks.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Whatever the channel handler callback procedure does.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
void
Tcl_NotifyChannel(channel, mask)
    Tcl_Channel channel;	/* Channel that detected an event. */
    int mask;			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which events were detected. */
{

    }

    Tcl_Release((ClientData) statePtr);
    Tcl_Release((ClientData) channel);

    tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * UpdateInterest --
 *
 *	Arrange for the notifier to call us back at appropriate times

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

static void
UpdateInterest(chanPtr)
    Channel *chanPtr;		/* Channel to update. */
{
#ifndef TCL_NO_FILEEVENTS
    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
    int mask = statePtr->interestMask;

    /*
     * If there are flushed buffers waiting to be written, then
     * we need to watch for the channel to become writable.
     */

	    if (!statePtr->timer) {
		statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
			(ClientData) chanPtr);
	    }
	}
    }
    (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * ChannelTimerProc --
 *
 *	Timer handler scheduled by UpdateInterest to monitor the
 *	channel buffers until they are empty.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May invoke channel handlers.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
static void
ChannelTimerProc(clientData)
    ClientData clientData;
{
    Channel *chanPtr = (Channel *) clientData;
    ChannelState *statePtr = chanPtr->state;	/* state info for channel */

	statePtr->flags &= ~CHANNEL_TIMER_FEV; 
	Tcl_Release((ClientData) statePtr);
    } else {
	statePtr->timer = NULL;
	UpdateInterest(chanPtr);
    }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChannelHandler --
 *
 *	Arrange for a given procedure to be invoked whenever the

 *	See the manual entry for details on the calling sequence
 *	to proc.  If there is already an event handler for chan, proc
 *	and clientData, then the mask will be updated.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
void
Tcl_CreateChannelHandler(chan, mask, proc, clientData)
    Tcl_Channel chan;		/* The channel to create the handler for. */
    int mask;			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION:
				 * indicates conditions under which
				 * proc should be called. Use 0 to

	 chPtr != (ChannelHandler *) NULL;
	 chPtr = chPtr->nextPtr) {
	statePtr->interestMask |= chPtr->mask;
    }

    UpdateInterest(statePtr->topChanPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteChannelHandler --
 *
 *	Cancel a previously arranged callback arrangement for an IO
 *	channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If a callback was previously registered for this chan, proc and
 *	 clientData , it is removed and the callback will no longer be called
 *	when the channel becomes ready for IO.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
void
Tcl_DeleteChannelHandler(chan, proc, clientData)
    Tcl_Channel chan;		/* The channel for which to remove the
                                 * callback. */
    Tcl_ChannelProc *proc;	/* The procedure in the callback to delete. */
    ClientData clientData;	/* The client data in the callback
                                 * to delete. */

	 chPtr != (ChannelHandler *) NULL;
	 chPtr = chPtr->nextPtr) {
        statePtr->interestMask |= chPtr->mask;
    }

    UpdateInterest(statePtr->topChanPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * DeleteScriptRecord --
 *
 *	Delete a script record for this combination of channel, interp
 *	and mask.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes a script record and cancels a channel event handler.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
static void
DeleteScriptRecord(interp, chanPtr, mask)
    Tcl_Interp *interp;		/* Interpreter in which script was to be
                                 * executed. */
    Channel *chanPtr;		/* The channel for which to delete the
                                 * script record (if any). */
    int mask;			/* Events in mask must exactly match mask

	    Tcl_DecrRefCount(esPtr->scriptPtr);
            ckfree((char *) esPtr);

            break;
        }
    }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * CreateScriptRecord --
 *
 *	Creates a record to store a script to be executed when a specific
 *	event fires on a specific channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Causes the script to be stored for later execution.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
static void
CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
    Tcl_Interp *interp;			/* Interpreter in which to execute
                                         * the stored script. */
    Channel *chanPtr;			/* Channel for which script is to
                                         * be stored. */
    int mask;				/* Set of events for which script

    }
    esPtr->chanPtr = chanPtr;
    esPtr->interp = interp;
    esPtr->mask = mask;
    Tcl_IncrRefCount(scriptPtr);
    esPtr->scriptPtr = scriptPtr;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclChannelEventScriptInvoker --
 *
 *	Invokes a script scheduled by "fileevent" for when the channel
 *	becomes ready for IO. This function is invoked by the channel
 *	handler which was created by the Tcl "fileevent" command.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Whatever the script does.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
void
TclChannelEventScriptInvoker(clientData, mask)
    ClientData clientData;	/* The script+interp record. */
    int mask;			/* Not used. */
{
    Tcl_Interp *interp;		/* Interpreter in which to eval the script. */
    Channel *chanPtr;		/* The channel for which this handler is

	if (chanPtr->typePtr != NULL) {
	    DeleteScriptRecord(interp, chanPtr, mask);
	}
        Tcl_BackgroundError(interp);
    }
    Tcl_Release((ClientData) interp);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FileEventObjCmd --
 *
 *	This procedure implements the "fileevent" Tcl command. See the
 *	user documentation for details on what it does. This command is
 *	based on the Tk command "fileevent" which in turn is based on work
 *	contributed by Mark Diekhans.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May create a channel handler for the specified channel.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
	/* ARGSUSED */
int
Tcl_FileEventObjCmd(clientData, interp, objc, objv)
    ClientData clientData;		/* Not used. */
    Tcl_Interp *interp;			/* Interpreter in which the channel
                                         * for which to create the handler
                                         * is found. */

     * will evaluate the script in the supplied interpreter.
     */

    CreateScriptRecord(interp, chanPtr, mask, objv[3]);
    
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclCopyChannel --
 *
 *	This routine copies data from one channel to another, either

 * Side effects:
 *	May schedule a background copy operation that causes both
 *	channels to be marked busy.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CHANNELCOPY
int
TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
    Tcl_Interp *interp;		/* Current interpreter. */
    Tcl_Channel inChan;		/* Channel to read from. */
    Tcl_Channel outChan;	/* Channel to write to. */
    int toRead;			/* Amount of data to copy, or -1 for all. */
    Tcl_Obj *cmdPtr;		/* Pointer to script to execute or NULL. */

	     * then the copying is done, otherwise set up a channel
	     * handler to detect when the channel becomes readable again.
	     */
	    
	    if (Tcl_Eof(inChan)) {
		break;
	    } else if (!(mask & TCL_READABLE)) {
#ifndef TCL_NO_FILEEVENTS
		if (mask & TCL_WRITABLE) {
		    Tcl_DeleteChannelHandler(outChan, CopyEventProc,
			    (ClientData) csPtr);
		}
		Tcl_CreateChannelHandler(inChan, TCL_READABLE,
			CopyEventProc, (ClientData) csPtr);
#endif
	    }
	    return TCL_OK;
	}

	/*
	 * Now write the buffer out.
	 */

	/*
	 * Check to see if the write is happening in the background.  If so,
	 * stop copying and wait for the channel to become writable again.
	 */

	if (outStatePtr->flags & BG_FLUSH_SCHEDULED) {
#ifndef TCL_NO_FILEEVENTS
	    if (!(mask & TCL_WRITABLE)) {
		if (mask & TCL_READABLE) {
		    Tcl_DeleteChannelHandler(inChan, CopyEventProc,
			    (ClientData) csPtr);
		}
		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
			CopyEventProc, (ClientData) csPtr);
	    }
#endif
	    return TCL_OK;
	}

#ifndef TCL_NO_FILEEVENTS
	/*
	 * For background copies, we only do one buffer per invocation so
	 * we don't starve the rest of the system.
	 */

	if (cmdPtr) {
	    /*
	     * The first time we enter this code, there won't be a
	     * channel handler established yet, so do it here.
	     */

	    if (mask == 0) {
		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
			CopyEventProc, (ClientData) csPtr);
	    }
	    return TCL_OK;
	}
#endif
    }

    /*
     * Make the callback or return the number of bytes transferred.
     * The local total is used because StopCopy frees csPtr.
     */

    total = csPtr->total;
#ifndef TCL_NO_FILEEVENTS
    if (cmdPtr) {
	/*
	 * Get a private copy of the command so we can mutate it
	 * by adding arguments.  Note that StopCopy frees our saved
	 * reference to the original command obj.
	 */

	if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
	    Tcl_BackgroundError(interp);
	    result = TCL_ERROR;
	}
	Tcl_DecrRefCount(cmdPtr);
	Tcl_Release((ClientData) interp);
    } else {
#endif
	StopCopy(csPtr);
	if (errObj) {
	    Tcl_SetObjResult(interp, errObj);
	    result = TCL_ERROR;
	} else {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
	}
#ifndef TCL_NO_FILEEVENTS
    }
#endif
    return result;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * DoRead --
 *
 *	Reads a given number of bytes from a channel.

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CHANNELCOPY
#ifndef TCL_NO_FILEEVENTS
static void
CopyEventProc(clientData, mask)
    ClientData clientData;
    int mask;
{
    (void) CopyData((CopyState *)clientData, mask);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * StopCopy --
 *
 *	This routine halts a copy that is in progress.

		    nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
	}
    }
    outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
    outStatePtr->flags |=
	csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);

#ifndef TCL_NO_FILEEVENTS
    if (csPtr->cmdPtr) {
	Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
		(ClientData)csPtr);
	if (csPtr->readPtr != csPtr->writePtr) {
	    Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
		    CopyEventProc, (ClientData)csPtr);
	}
        Tcl_DecrRefCount(csPtr->cmdPtr);
    }
#endif
    inStatePtr->csPtr  = NULL;
    outStatePtr->csPtr = NULL;
    ckfree((char*) csPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * StackSetBlockMode --
 *
 *	This function sets the blocking mode for a channel, iterating

/* 
 * tclIOCmd.c --
 *
 *	Contains the definitions of most of the Tcl commands relating to IO.
 *
 * 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: tclIOCmd.c,v 1.7.2.1.2.1 2001/11/28 17:58:36 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

#ifndef TCL_NO_SOCKETS
/*
 * Callback structure for accept callback in a TCP server.
 */

typedef struct AcceptCallback {
    char *script;			/* Script to invoke. */
    Tcl_Interp *interp;			/* Interpreter in which to run it. */
} AcceptCallback;

/*
 * Static functions for this file:
 */

#ifndef TCL_NO_FILEEVENTS
static void	AcceptCallbackProc _ANSI_ARGS_((ClientData callbackData,
	            Tcl_Channel chan, char *address, int port));
static void	RegisterTcpServerInterpCleanup _ANSI_ARGS_((Tcl_Interp *interp,
	            AcceptCallback *acceptCallbackPtr));
static void	TcpAcceptCallbacksDeleteProc _ANSI_ARGS_((
		    ClientData clientData, Tcl_Interp *interp));
static void	TcpServerCloseProc _ANSI_ARGS_((ClientData callbackData));
static void	UnregisterTcpServerInterpCleanupProc _ANSI_ARGS_((
		    Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr));
#endif /* TCL_NO_FILEEVENTS */
#endif /* TCL_NO_SOCKETS */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PutsObjCmd --
 *
 *	This procedure is invoked to process the "puts" Tcl command.

 *
 * Side effects:
 *	May consume input from channel.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CHANNEL_READ
	/* ARGSUSED */
int
Tcl_ReadObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */

	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    Tcl_DecrRefCount(resultPtr);
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SeekObjCmd --
 *
 *	This procedure is invoked to process the Tcl "seek" command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Moves the position of the access point on the specified channel.
 *	May flush queued output.
 *
 *----------------------------------------------------------------------
 */
#ifndef TCL_NO_NONSTDCHAN
	/* ARGSUSED */
int
Tcl_SeekObjCmd(clientData, interp, objc, objv)
    ClientData clientData;		/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */

    if (result == -1) {
        Tcl_AppendResult(interp, "error during seek on \"", 
		chanName, "\": ", Tcl_PosixError(interp), (char *) NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TellObjCmd --
 *
 *	This procedure is invoked to process the Tcl "tell" command.

 *	A standard Tcl result.
 *
 * Side effects:
 *	May discard queued input; may flush queued output.
 *
 *----------------------------------------------------------------------
 */
#ifndef TCL_NO_NONSTDCHAN
	/* ARGSUSED */
int
Tcl_CloseObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */

	    Tcl_SetObjLength(resultPtr, len - 1);
        }
        return TCL_ERROR;
    }

    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FconfigureObjCmd --
 *
 *	This procedure is invoked to process the Tcl "fconfigure" command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CHANNEL_CONFIG
	/* ARGSUSED */
int
Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
    ClientData clientData;		/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */

        if (Tcl_SetChannelOption(interp, chan, optionName, valueName)
		!= TCL_OK) {
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_EofObjCmd --
 *
 *	This procedure is invoked to process the Tcl "eof" command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Sets interp's result to boolean true or false depending on whether
 *	the specified channel has an EOF condition.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_CHANNEL_EOF
	/* ARGSUSED */
int
Tcl_EofObjCmd(unused, interp, objc, objv)
    ClientData unused;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */

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

    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_Eof(chan));
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ExecObjCmd --
 *
 *	This procedure is invoked to process the "exec" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_PIPES
	/* ARGSUSED */
int
Tcl_ExecObjCmd(dummy, interp, objc, objv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */

	}
    }
    Tcl_SetObjResult(interp, resultPtr);

    return result;
#endif /* !MAC_TCL */
}
#endif /* TCL_NO_PIPES */
#endif /* TCL_NO_FILESYSTEM */

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FblockedObjCmd --
 *
 *	This procedure is invoked to process the Tcl "fblocked" command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Sets interp's result to boolean true or false depending on whether
 *	the preceeding input operation on the channel would have blocked.
 *
 *---------------------------------------------------------------------------
 */

#ifndef TCL_NO_CHANNEL_BLOCKED
	/* ARGSUSED */
int
Tcl_FblockedObjCmd(unused, interp, objc, objv)
    ClientData unused;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */

		arg, "\" wasn't opened for reading", (char *) NULL);
        return TCL_ERROR;
    }
        
    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_InputBlocked(chan));
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenObjCmd --
 *
 *	This procedure is invoked to process the "open" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
	/* ARGSUSED */
int
Tcl_OpenObjCmd(notUsed, interp, objc, objv)
    ClientData notUsed;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */

        chan = Tcl_OpenFileChannel(interp, what, modeString, prot);
    } else {
#ifdef MAC_TCL
	Tcl_AppendResult(interp,
		"command pipelines not supported on Macintosh OS",
		(char *)NULL);
	return TCL_ERROR;
#else
#ifdef TCL_NO_PIPES
	Tcl_AppendResult(interp,
		"command pipelines not supported (TCL_NO_PIPES)",
		(char *)NULL);
	return TCL_ERROR;
#else
	int mode, seekFlag, cmdObjc;
	char **cmdArgv;

        if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
            return TCL_ERROR;
        }

		default:
		    panic("Tcl_OpenCmd: invalid mode value");
		    break;
	    }
	    chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
	}
        ckfree((char *) cmdArgv);
#endif /* TCL_NO_PIPES */
#endif /* MAC_TCL */
    }
    if (chan == (Tcl_Channel) NULL) {
        return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp, chan);
    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
    return TCL_OK;
}
#endif /* TCL_NO_NONSTDCHAN */
#endif /* TCL_NO_FILESYSTEM */

#ifndef TCL_NO_SOCKETS
/*
 *----------------------------------------------------------------------
 *
 * TcpAcceptCallbacksDeleteProc --
 *
 *	Assocdata cleanup routine called when an interpreter is being
 *	deleted to set the interp field of all the accept callback records

 *	Deallocates memory and sets the interp field of all the accept
 *	callback records to NULL to prevent this interpreter from being
 *	used subsequently to eval accept scripts.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
	/* ARGSUSED */
static void
TcpAcceptCallbacksDeleteProc(clientData, interp)
    ClientData clientData;	/* Data which was passed when the assocdata
                                 * was registered. */
    Tcl_Interp *interp;		/* Interpreter being deleted - not used. */
{

             hPtr = Tcl_NextHashEntry(&hSearch)) {
        acceptCallbackPtr = (AcceptCallback *) Tcl_GetHashValue(hPtr);
        acceptCallbackPtr->interp = (Tcl_Interp *) NULL;
    }
    Tcl_DeleteHashTable(hTblPtr);
    ckfree((char *) hTblPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * RegisterTcpServerInterpCleanup --
 *
 *	Registers an accept callback record to have its interp

 *	field of the accept callback data structure will be set to
 *	NULL. This will prevent attempts to eval the accept script
 *	in a deleted interpreter.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
static void
RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
    Tcl_Interp *interp;		/* Interpreter for which we want to be
                                 * informed of deletion. */
    AcceptCallback *acceptCallbackPtr;
    				/* The accept callback record whose
                                 * interp field we want set to NULL when

    }
    hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &new);
    if (!new) {
        panic("RegisterTcpServerCleanup: damaged accept record table");
    }
    Tcl_SetHashValue(hPtr, (ClientData) acceptCallbackPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * UnregisterTcpServerInterpCleanupProc --
 *
 *	Unregister a previously registered accept callback record. The
 *	interp field of this record will no longer be set to NULL in
 *	the future when the interpreter is deleted.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Prevents the interp field of the accept callback record from
 *	being set to NULL in the future when the interpreter is deleted.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
static void
UnregisterTcpServerInterpCleanupProc(interp, acceptCallbackPtr)
    Tcl_Interp *interp;		/* Interpreter in which the accept callback
                                 * record was registered. */
    AcceptCallback *acceptCallbackPtr;
    				/* The record for which to delete the
                                 * registration. */

    }
    hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
    if (hPtr == (Tcl_HashEntry *) NULL) {
        return;
    }
    Tcl_DeleteHashEntry(hPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * AcceptCallbackProc --
 *
 *	This callback is invoked by the TCP channel driver when it
 *	accepts a new connection from a client on a server socket.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Whatever the script does.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
static void
AcceptCallbackProc(callbackData, chan, address, port)
    ClientData callbackData;		/* The data stored when the callback
                                         * was created in the call to
                                         * Tcl_OpenTcpServer. */
    Tcl_Channel chan;			/* Channel for the newly accepted
                                         * connection. */

         * The interpreter has been deleted, so there is no useful
         * way to utilize the client socket - just close it.
         */

        Tcl_Close((Tcl_Interp *) NULL, chan);
    }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TcpServerCloseProc --
 *
 *	This callback is called when the TCP server channel for which it

 * Side effects:
 *	In the future, if the interpreter is deleted this channel will
 *	no longer be informed.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
static void
TcpServerCloseProc(callbackData)
    ClientData callbackData;	/* The data passed in the call to
                                 * Tcl_CreateCloseHandler. */
{
    AcceptCallback *acceptCallbackPtr;
    				/* The actual data. */

    acceptCallbackPtr = (AcceptCallback *) callbackData;
    if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
        UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
                acceptCallbackPtr);
    }
    Tcl_EventuallyFree((ClientData) acceptCallbackPtr->script, TCL_DYNAMIC);
    ckfree((char *) acceptCallbackPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SocketObjCmd --
 *
 *	This procedure is invoked to process the "socket" Tcl command.

    static char *socketOptions[] = {
	"-async", "-myaddr", "-myport","-server", (char *) NULL
    };
    enum socketOptions {
	SKT_ASYNC,      SKT_MYADDR,      SKT_MYPORT,      SKT_SERVER  
    };
    int optionIndex, a, server, port;
#ifndef TCL_NO_FILEEVENTS
    char *arg, *copyScript, *host, *script;
#else
    char *arg,              *host, *script;
#endif
    char *myaddr = NULL;
    int myport = 0;
    int async = 0;
    Tcl_Channel chan;
#ifndef TCL_NO_FILEEVENTS
    AcceptCallback *acceptCallbackPtr;
#endif
    
    server = 0;
    script = NULL;

    if (TclpHasSockets(interp) != TCL_OK) {
	return TCL_ERROR;
    }

	    return TCL_ERROR;
	}
    } else {
	goto wrongNumArgs;
    }

    if (server) {
#ifndef TCL_NO_FILEEVENTS
        acceptCallbackPtr = (AcceptCallback *) ckalloc((unsigned)
                sizeof(AcceptCallback));
        copyScript = ckalloc((unsigned) strlen(script) + 1);
        strcpy(copyScript, script);
        acceptCallbackPtr->script = copyScript;
        acceptCallbackPtr->interp = interp;
        chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,

         * Register a close callback. This callback will inform the
         * interpreter (if it still exists) that this channel does not
         * need to be informed when the interpreter is deleted.
         */
        
        Tcl_CreateCloseHandler(chan, TcpServerCloseProc,
                (ClientData) acceptCallbackPtr);
#else
	/* IOS FIXME: error message */
	return TCL_ERROR;
#endif
    } else {
        chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
        if (chan == (Tcl_Channel) NULL) {
            return TCL_ERROR;
        }
    }
    Tcl_RegisterChannel(interp, chan);            
    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
    
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FcopyObjCmd --
 *
 *	This procedure is invoked to process the "fcopy" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Moves data between two channels and possibly sets up a
 *	background copy handler.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CHANNELCOPY
int
Tcl_FcopyObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{

	switch (index) {
	    case FcopySize:
		if (Tcl_GetIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case FcopyCommand:
#ifndef TCL_NO_FILEEVENTS
		cmdPtr = objv[i+1];
#else
		return TCL_ERROR; /* IOS FIXME: need error message */
#endif
		break;
	}
    }

    return TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr);
}
#endif

/*
 * tclIOGT.c --
 *
 *	Implements a generic transformation exposing the underlying API
 *	at the script level.  Contributed by Andreas Kupries.
 *
 * Copyright (c) 2000 Ajuba Solutions
 * Copyright (c) 1999-2000 Andreas Kupries ([email protected])
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * CVS: $Id: tclIOGT.c,v 1.1.4.3.2.1 2001/11/28 17:58:36 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclIO.h"

#ifndef TCL_NO_CHANNEL_CONFIG

/*
 * Forward declarations of internal procedures.
 * First the driver procedures of the transformation.
 */

static int		TransformBlockModeProc _ANSI_ARGS_ ((

				ClientData instanceData, int mask));

/*
 * Forward declarations of internal procedures.
 * Secondly the procedures for handling and generating fileeevents.
 */

#ifndef TCL_NO_FILEEVENTS
static void		TransformChannelHandlerTimer _ANSI_ARGS_ ((
				ClientData clientData));
#endif

/*
 * Forward declarations of internal procedures.
 * Third, helper procedures encapsulating essential tasks.
 */

typedef struct TransformChannelData TransformChannelData;

 */
	/* ARGSUSED */
static void
TransformWatchProc (instanceData, mask)
    ClientData instanceData;	/* Channel to watch */
    int        mask;		/* Events of interest */
{
#ifndef TCL_NO_FILEEVENTS
    /* The caller expressed interest in events occuring for this
     * channel. We are forwarding the call to the underlying
     * channel now.
     */

    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
    Tcl_Channel     downChan;

	 * events and we actually have data waiting, so generate a timer
	 * to flush that.
	 */

	dataPtr->timer = Tcl_CreateTimerHandler (FLUSH_DELAY,
		TransformChannelHandlerTimer, (ClientData) dataPtr);
    }
#endif
}

/*
 *------------------------------------------------------*
 *
 *	TransformGetFileHandleProc --
 *

 *
 *	Result:
 *		None.
 *
 *------------------------------------------------------*
 */

#ifndef TCL_NO_FILEEVENTS
static void
TransformChannelHandlerTimer (clientData)
    ClientData clientData; /* Transformation to query */
{
    TransformChannelData* dataPtr = (TransformChannelData*) clientData;

    dataPtr->timer = (Tcl_TimerToken) NULL;

    if (!(dataPtr->watchMask & TCL_READABLE) ||
	    (ResultLength (&dataPtr->result) == 0)) {
	/* The timer fired, but either is there no (more)
	 * interest in the events it generates or nothing is available
	 * for reading, so ignore it and don't recreate it.
	 */

	return;
    }

    Tcl_NotifyChannel(dataPtr->self, TCL_READABLE);
}
#endif

/*
 *------------------------------------------------------*
 *
 *	ResultClear --
 *
 *	Deallocates any memory allocated by 'ResultAdd'.

	}
    }

    /* now copy data */
    memcpy(r->buf + r->used, buf, (size_t) toWrite);
    r->used += toWrite;
}

#else

int
TclChannelTransform(interp, chan, cmdObjPtr)
    Tcl_Interp	*interp;	/* Interpreter for result. */
    Tcl_Channel chan;		/* Channel to transform. */
    Tcl_Obj	*cmdObjPtr;	/* Script to use for transform. */
{
  return TCL_ERROR;
}
#endif

 *
 * 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: tclIOUtil.c,v 1.9.6.1 2001/11/28 17:58:37 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The following typedef declarations allow for hooking into the chain
 * of functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
 * 'Tcl_OpenFileChannel(...)'.  Basically for each hookable function
 * a linked list is defined.
 */

#ifndef TCL_NO_FILESYSTEM
typedef struct StatProc {
    TclStatProc_ *proc;		 /* Function to process a 'stat()' call */
    struct StatProc *nextPtr;    /* The next 'stat()' function to call */
} StatProc;

typedef struct AccessProc {
    TclAccessProc_ *proc;	 /* Function to process a 'access()' call */

static AccessProc defaultAccessProc = {
    &TclpAccess, NULL
};
static AccessProc *accessProcList = &defaultAccessProc;

static OpenFileChannelProc defaultOpenFileChannelProc = {
#ifndef TCL_NO_NONSTDCHAN
    &TclpOpenFileChannel, NULL
#else
    NULL
#endif
};
static OpenFileChannelProc *openFileChannelProcList =
	&defaultOpenFileChannelProc;

TCL_DECLARE_MUTEX(hookMutex)
#endif

/*
 *---------------------------------------------------------------------------
 *
 * TclGetOpenMode --
 *
 * Description:

 *
 * Side effects:
 *	Depends on the commands in the file.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
/* IOS FIXME : in the generic case this functionality can be made
 * available, it just has to read the file directly instead of using
 * the channel system. This makes the code platform dependent.
 */
int
Tcl_EvalFile(interp, fileName)
    Tcl_Interp *interp;		/* Interpreter in which to process file. */
    char *fileName;		/* Name of file to process.  Tilde-substitution
				 * will be performed on this name. */
{
    int result, length;

    }

    end:
    Tcl_DecrRefCount(objPtr);
    Tcl_DStringFree(&nameString);
    return result;
}
#endif /* TCL_NO_NONSTDCHAN */
#endif /* TCL_NO_FILESYSTEM */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetErrno --
 *
 *	Gets the current value of the Tcl error code variable. This is

 *
 * Side effects:
 *      See stat documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclStat(path, buf)
    CONST char *path;		/* Path of file to stat (in current CP). */
    struct stat *buf;		/* Filled with results of stat call. */
{
    StatProc *statProcPtr;
    int retVal = -1;

	retVal = (*statProcPtr->proc)(path, buf);
	statProcPtr = statProcPtr->nextPtr;
    }
    Tcl_MutexUnlock(&hookMutex);

    return (retVal);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclAccess --
 *
 *	This procedure replaces the library version of access.
 *	The chain of functions that have been "inserted" into the
 *	'accessProcList' will be called in succession until either
 *	a value of zero is returned, or the entire list is visited.
 *
 * Results:
 *      See access documentation.
 *
 * Side effects:
 *      See access documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclAccess(path, mode)
    CONST char *path;		/* Path of file to access (in current CP). */
    int mode;                   /* Permission setting. */
{
    AccessProc *accessProcPtr;
    int retVal = -1;

	retVal = (*accessProcPtr->proc)(path, mode);
	accessProcPtr = accessProcPtr->nextPtr;
    }
    Tcl_MutexUnlock(&hookMutex);

    return (retVal);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenFileChannel --
 *
 *	The chain of functions that have been "inserted" into the

 * Side effects:
 *	May open the channel and may cause creation of a file on the
 *	file system.
 *
 *----------------------------------------------------------------------
 */
 
#ifndef TCL_NO_FILESYSTEM
Tcl_Channel
Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
    Tcl_Interp *interp;                 /* Interpreter for error reporting;
                                         * can be NULL. */
    char *fileName;                     /* Name of file to open. */
    char *modeString;                   /* A list of POSIX open modes or
                                         * a string such as "rw". */

		modeString, permissions);
	openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
    }
    Tcl_MutexUnlock(&hookMutex);

    return (retVal);
}
#endif /* TCL_NO_FILESYSTEM */

/*
 *----------------------------------------------------------------------
 *
 * TclStatInsertProc --
 *
 *	Insert the passed procedure pointer at the head of the list of

 * Side effects:
 *      Memory allocataed and modifies the link list for 'TclStat'
 *	functions.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclStatInsertProc (proc)
    TclStatProc_ *proc;
{
    int retVal = TCL_ERROR;

    if (proc != NULL) {

	    retVal = TCL_OK;
	}
    }

    return (retVal);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclStatDeleteProc --
 *
 *	Removed the passed function pointer from the list of 'TclStat'
 *	functions.  Ensures that the built-in stat function is not
 *	removvable.
 *
 * Results:
 *      TCL_OK if the procedure pointer was successfully removed,
 *	TCL_ERROR otherwise.
 *
 * Side effects:
 *      Memory is deallocated and the respective list updated.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclStatDeleteProc (proc)
    TclStatProc_ *proc;
{
    int retVal = TCL_ERROR;
    StatProc *tmpStatProcPtr;
    StatProc *prevStatProcPtr = NULL;

	    tmpStatProcPtr = tmpStatProcPtr->nextPtr;
	}
    }

    Tcl_MutexUnlock(&hookMutex);
    return (retVal);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclAccessInsertProc --
 *
 *	Insert the passed procedure pointer at the head of the list of

 * Side effects:
 *      Memory allocataed and modifies the link list for 'TclAccess'
 *	functions.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclAccessInsertProc(proc)
    TclAccessProc_ *proc;
{
    int retVal = TCL_ERROR;

    if (proc != NULL) {

	    retVal = TCL_OK;
	}
    }

    return (retVal);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclAccessDeleteProc --
 *
 *	Removed the passed function pointer from the list of 'TclAccess'
 *	functions.  Ensures that the built-in access function is not
 *	removvable.
 *
 * Results:
 *      TCL_OK if the procedure pointer was successfully removed,
 *	TCL_ERROR otherwise.
 *
 * Side effects:
 *      Memory is deallocated and the respective list updated.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclAccessDeleteProc(proc)
    TclAccessProc_ *proc;
{
    int retVal = TCL_ERROR;
    AccessProc *tmpAccessProcPtr;
    AccessProc *prevAccessProcPtr = NULL;

	    tmpAccessProcPtr = tmpAccessProcPtr->nextPtr;
	}
    }
    Tcl_MutexUnlock(&hookMutex);

    return (retVal);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclOpenFileChannelInsertProc --
 *
 *	Insert the passed procedure pointer at the head of the list of

 * Side effects:
 *      Memory allocataed and modifies the link list for
 *	'Tcl_OpenFileChannel' functions.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclOpenFileChannelInsertProc(proc)
    TclOpenFileChannelProc_ *proc;
{
    int retVal = TCL_ERROR;

    if (proc != NULL) {

	    retVal = TCL_OK;
	}
    }

    return (retVal);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclOpenFileChannelDeleteProc --
 *
 *	Removed the passed function pointer from the list of
 *	'Tcl_OpenFileChannel' functions.  Ensures that the built-in
 *	open file channel function is not removvable.
 *
 * Results:
 *      TCL_OK if the procedure pointer was successfully removed,
 *	TCL_ERROR otherwise.
 *
 * Side effects:
 *      Memory is deallocated and the respective list updated.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclOpenFileChannelDeleteProc(proc)
    TclOpenFileChannelProc_ *proc;
{
    int retVal = TCL_ERROR;
    OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList;
    OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL;

	    tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr;
	}
    }
    Tcl_MutexUnlock(&hookMutex);

    return (retVal);
}
#endif

# tclInt.decls --
#
#	This file contains the declarations for all unsupported
#	functions that are exported by the Tcl library.  This file
#	is used to generate the tclIntDecls.h, tclIntPlatDecls.h,
#	tclIntStub.c, tclPlatStub.c, tclCompileDecls.h and tclCompileStub.c
#	files
#
# 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: tclInt.decls,v 1.20.2.6.2.1 2001/11/28 17:58:37 andreas_kupries Exp $

library tcl

# Define the unsupported generic interfaces.

interface tclInt

# Declare each of the functions in the unsupported internal Tcl
# interface.  These interfaces are allowed to changed between versions.
# Use at your own risk.  Note that the position of functions should not
# be changed between versions to avoid gratuitous incompatibilities.

declare 0 generic {TCL_NO_FILESYSTEM} {
    int TclAccess(CONST char *path, int mode)
}
declare 1 generic {TCL_NO_FILESYSTEM} {
    int TclAccessDeleteProc(TclAccessProc_ *proc)
}
declare 2 generic {TCL_NO_FILESYSTEM} {
    int TclAccessInsertProc(TclAccessProc_ *proc)
}
declare 3 generic {
    void TclAllocateFreeObjects(void)
}
# Replaced by TclpChdir in 8.1:
#  declare 4 generic {   
#      int TclChdir(Tcl_Interp *interp, char *dirName)
#  }
declare 5 {unix win} {TCL_NO_PIPES} {
    int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, \
	    Tcl_Channel errorChan)
}
declare 6 generic {
    void TclCleanupCommand(Command *cmdPtr)
}
declare 7 generic {
    int TclCopyAndCollapse(int count, CONST char *src, char *dst)
}
declare 8 generic {TCL_NO_CHANNELCOPY} {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, \
	    Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
}

# TclCreatePipeline unofficially exported for use by BLT.

declare 9 {unix win} {TCL_NO_FILESYSTEM TCL_NO_PIPES} {
    int TclCreatePipeline(Tcl_Interp *interp, int argc, char **argv, \
	    Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, \
	    TclFile *errFilePtr)
}
declare 10 generic {
    int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr, char *procName, \
	    Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr)
}
declare 11 generic {
    void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr)
}
declare 12 generic {
    void TclDeleteVars(Interp *iPtr, Tcl_HashTable *tablePtr)
}
declare 13 generic {TCL_NO_FILESYSTEM} {
    int TclDoGlob(Tcl_Interp *interp, char *separators, \
	    Tcl_DString *headPtr, char *tail, GlobTypeData *types)
}
declare 14 generic {
    void TclDumpMemoryInfo(FILE *outFile)
}
# Removed in 8.1:
#  declare 15 generic {
#      void TclExpandParseValue(ParseValue *pvPtr, int needed)
#  }
declare 16 generic {
    void TclExprFloatError(Tcl_Interp *interp, double value)
}
declare 17 generic {TCL_NO_FILESYSTEM} {
    int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
}
declare 18 generic {TCL_NO_FILESYSTEM} {
    int TclFileCopyCmd(Tcl_Interp *interp, int argc, char **argv)
}
declare 19 generic {TCL_NO_FILESYSTEM} {
    int TclFileDeleteCmd(Tcl_Interp *interp, int argc, char **argv)
}
declare 20 generic {TCL_NO_FILESYSTEM} {
    int TclFileMakeDirsCmd(Tcl_Interp *interp, int argc, char **argv)
}
declare 21 generic {TCL_NO_FILESYSTEM} {
    int TclFileRenameCmd(Tcl_Interp *interp, int argc, char **argv)
}
declare 22 generic {
    int TclFindElement(Tcl_Interp *interp, CONST char *listStr, \
	    int listLength, CONST char **elementPtr, CONST char **nextPtr, \
	    int *sizePtr, int *bracePtr)
}

    Tcl_Obj * TclGetElementOfIndexedArray(Tcl_Interp *interp, \
	    int localIndex, Tcl_Obj *elemPtr, int leaveErrorMsg)
}
# Replaced by char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr) in 8.1:
#  declare 30 generic {
#      char * TclGetEnv(CONST char *name)
#  }
declare 31 generic {TCL_NO_FILESYSTEM} {
    char * TclGetExtension(char *name)
}
declare 32 generic {
    int TclGetFrame(Tcl_Interp *interp, char *str, CallFrame **framePtrPtr)
}
declare 33 generic {
    TclCmdProcType TclGetInterpProc(void)

}
declare 40 generic {
    int TclGetOpenMode(Tcl_Interp *interp, char *str, int *seekFlagPtr)
}
declare 41 generic {
    Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 generic {TCL_NO_FILESYSTEM} {
    char * TclpGetUserHome(CONST char *name, Tcl_DString *bufferPtr)
}
declare 43 generic {
    int TclGlobalInvoke(Tcl_Interp *interp, int argc, char **argv, int flags)
}
declare 44 generic {
    int TclGuessPackageName(char *fileName, Tcl_DString *bufPtr)

    Tcl_Obj * TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, \
	    Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed)
}
declare 50 generic {
    void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, \
	    Namespace *nsPtr)
}
declare 51 generic {{TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES}} {
    int TclInterpInit(Tcl_Interp *interp)
}
declare 52 generic {
    int TclInvoke(Tcl_Interp *interp, int argc, char **argv, int flags)
}
declare 53 generic {
    int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, \

#      int TclLooksLikeInt(char *p)
#  }
declare 58 generic {
    Var * TclLookupVar(Tcl_Interp *interp, char *part1, char *part2, \
	    int flags, char *msg, int createPart1, int createPart2, \
	    Var **arrayPtrPtr)
}
declare 59 generic {TCL_NO_FILESYSTEM} {
    int TclpMatchFiles(Tcl_Interp *interp, char *separators, \
	    Tcl_DString *dirPtr, char *pattern, char *tail)
}
declare 60 generic {
    int TclNeedSpace(char *start, char *end)
}
declare 61 generic {

    int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], \
	    int flags)
}
declare 65 generic {
    int TclObjInvokeGlobal(Tcl_Interp *interp, int objc, \
	    Tcl_Obj *CONST objv[], int flags)
}
declare 66 generic {TCL_NO_FILESYSTEM} {
    int TclOpenFileChannelDeleteProc(TclOpenFileChannelProc_ *proc)
}
declare 67 generic {TCL_NO_FILESYSTEM} {
    int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
}
declare 68 generic {TCL_NO_FILESYSTEM} {
    int TclpAccess(CONST char *path, int mode)
}
declare 69 generic {
    char * TclpAlloc(unsigned int size)
}
declare 70 generic {TCL_NO_FILESYSTEM} {
    int TclpCopyFile(CONST char *source, CONST char *dest)
}
declare 71 generic {TCL_NO_FILESYSTEM} {
    int TclpCopyDirectory(CONST char *source, CONST char *dest, \
	    Tcl_DString *errorPtr)
}
declare 72 generic {TCL_NO_FILESYSTEM} {
    int TclpCreateDirectory(CONST char *path)
}
declare 73 generic {TCL_NO_FILESYSTEM} {
    int TclpDeleteFile(CONST char *path)
}
declare 74 generic {
    void TclpFree(char *ptr)
}
declare 75 generic {
    unsigned long TclpGetClicks(void)
}
declare 76 generic {
    unsigned long TclpGetSeconds(void)
}
declare 77 generic {
    void TclpGetTime(Tcl_Time *time)
}
declare 78 generic {
    int TclpGetTimeZone(unsigned long time)
}
declare 79 generic {TCL_NO_FILESYSTEM} {
    int TclpListVolumes(Tcl_Interp *interp)
}
declare 80 generic {TCL_NO_FILESYSTEM TCL_NO_NONSTDCHAN} {
    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName, \
	    char *modeString, int permissions)
}
declare 81 generic {
    char * TclpRealloc(char *ptr, unsigned int size)
}
declare 82 generic {TCL_NO_FILESYSTEM} {
    int TclpRemoveDirectory(CONST char *path, int recursive, \
	    Tcl_DString *errorPtr)
}
declare 83 generic {TCL_NO_FILESYSTEM} {
    int TclpRenameFile(CONST char *source, CONST char *dest)
}
# Removed in 8.1:
#  declare 84 generic {
#      int TclParseBraces(Tcl_Interp *interp, char *str, char **termPtr, \
#  	    ParseValue *pvPtr)
#  }

#  declare 87 generic {
#      void TclPlatformInit(Tcl_Interp *interp)
#  }
declare 88 generic {
    char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, \
	    char *name1, char *name2, int flags)
}
declare 89 generic {TCL_NO_CMDALIASES} {
    int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, \
	    Tcl_Command cmd)
}
# Removed in 8.1 (only available if compiled with TCL_COMPILE_DEBUG):
#  declare 90 generic {
#      void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#  }

declare 93 generic {
    void TclProcDeleteProc(ClientData clientData)
}
declare 94 generic {
    int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, \
	    int argc, char **argv)
}
declare 95 generic {TCL_NO_FILESYSTEM} {
    int TclpStat(CONST char *path, struct stat *buf)
}
declare 96 generic {
    int TclRenameCommand(Tcl_Interp *interp, char *oldName, char *newName)
}
declare 97 generic {
    void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr)

declare 103 generic {
    int TclSockGetPort(Tcl_Interp *interp, char *str, char *proto, \
	    int *portPtr)
}
declare 104 {unix win} {
    int TclSockMinimumBuffers(int sock, int size)
}
declare 105 generic {TCL_NO_FILESYSTEM} {
    int TclStat(CONST char *path, struct stat *buf)
}
declare 106 generic {TCL_NO_FILESYSTEM} {
    int TclStatDeleteProc(TclStatProc_ *proc)
}
declare 107 generic {TCL_NO_FILESYSTEM} {
    int TclStatInsertProc(TclStatProc_ *proc)
}
declare 108 generic {
    void TclTeardownNamespace(Namespace *nsPtr)
}
declare 109 generic {
    int TclUpdateReturnInfo(Interp *iPtr)

}
declare 135 generic {
    int TclpCheckStackSpace(void)
}

# Added in 8.1:

declare 137 generic {TCL_NO_FILESYSTEM} {
   int TclpChdir(CONST char *dirName)
}
declare 138 generic {
    char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr)
}
declare 139 generic {TCL_NO_FILESYSTEM TCL_NO_LOADCMD} {
    int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \
	    char *sym2, Tcl_PackageInitProc **proc1Ptr, \
	    Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr)
}
declare 140 generic {
    int TclLooksLikeInt(char *bytes, int length)
}
declare 141 generic {TCL_NO_FILESYSTEM} {
    char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 generic {
    int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, \
	    CompileHookProc *hookProc, ClientData clientData)
}
declare 143 generic {

    int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
}
declare 151 generic {
    void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, \
	    int *endPtr)
}

declare 152 generic {TCL_NO_FILESYSTEM} {
    void TclSetLibraryPath(Tcl_Obj *pathPtr)
}
declare 153 generic {TCL_NO_FILESYSTEM} {
    Tcl_Obj *TclGetLibraryPath(void)
}

# moved to tclTest.c in 8.3.2/8.4a2
#declare 154 generic {
#    int TclTestChannelCmd(ClientData clientData,
#    Tcl_Interp *interp, int argc, char **argv)

}
declare 158 generic {
    void TclSetStartupScriptFileName(char *filename)
}
declare 159 generic {
    char *TclGetStartupScriptFileName(void)
}
declare 160 generic {TCL_NO_FILESYSTEM} {
    int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, \
	    Tcl_DString *dirPtr, char *pattern, char *tail, GlobTypeData *types)
}

# new in 8.3.2/8.4a2
declare 161 generic {
    int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, \
	    Tcl_Obj *cmdObjPtr)
}
declare 162 generic {TCL_NO_FILEEVENTS} {
    void TclChannelEventScriptInvoker(ClientData clientData, int flags)
}

# New in 8.3.4, support for shared library version of tclcompiler.

# ALERT: The result of 'TclGetInstructionTable' is actually an
# InstructionDesc*" but we do not want to describe this structure in

# Removed in 8.3.1 (for Win32s only)
#declare 10 win {
#    int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
#}

# Pipe channel functions

declare 11 win {TCL_NO_PIPES} {
    void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 12 win {
    int TclpCloseFile(TclFile file)
}
declare 13 win {
    Tcl_Channel TclpCreateCommandChannel(TclFile readFile, \

}

#########################
# Unix specific internals

# Pipe channel functions

declare 0 unix {TCL_NO_PIPES} {
    void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 1 unix {TCL_NO_PIPES} {
    int TclpCloseFile(TclFile file)
}
declare 2 unix {TCL_NO_PIPES} {
    Tcl_Channel TclpCreateCommandChannel(TclFile readFile, \
	    TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
}
declare 3 unix {TCL_NO_PIPES} {
    int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
}
declare 4 unix {TCL_NO_PIPES} {
    int TclpCreateProcess(Tcl_Interp *interp, int argc, char **argv, \
	    TclFile inputFile, TclFile outputFile, TclFile errorFile, \
	    Tcl_Pid *pidPtr)
}
# Signature changed in 8.1:
#  declare 5 unix {
#      TclFile TclpCreateTempFile(char *contents, 
#      Tcl_DString *namePtr)
#  }
declare 6 unix {TCL_NO_PIPES} {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 7 unix {TCL_NO_PIPES} {
    TclFile TclpOpenFile(CONST char *fname, int mode)
}
declare 8 unix {
    int TclUnixWaitForFile(int fd, int mask, int timeout)
}

# Added in 8.1:

declare 9 unix {TCL_NO_PIPES} {
    TclFile TclpCreateTempFile(CONST char *contents)
}

/* 
 * tclInterp.c --
 *
 *	This file implements the "interp" command which allows creation
 *	and manipulation of Tcl interpreters from within Tcl scripts.
 *
 * 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: tclInterp.c,v 1.5.12.2.2.1 2001/11/28 17:58:37 andreas_kupries Exp $
 */

#include <stdio.h>
#include "tclInt.h"
#include "tclPort.h"

#ifndef TCL_NO_CMDALIASES
/*
 * Counter for how many aliases were created (global)
 */

static int aliasCounter = 0;
TCL_DECLARE_MUTEX(cntMutex)

				/* Entry for target command in master.
                                 * This is used in the master interpreter to
                                 * map back from the target command to aliases
                                 * redirecting to it. Random access to this
                                 * hash table is never required - we are using
                                 * a hash table only for convenience. */
} Alias;
#endif

#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
/*
 *
 * struct Slave:
 *
 * Used by the "interp" command to record and find information about slave
 * interpreters. Maps from a command name in the master to information about
 * a slave interpreter, e.g. what aliases are defined in it.

                                 * master's table. */
    Tcl_Interp	*slaveInterp;	/* The slave interpreter. */
    Tcl_Command interpCmd;	/* Interpreter object command. */
    Tcl_HashTable aliasTable;	/* Table which maps from names of commands
                                 * in slave interpreter to struct Alias
                                 * defined below. */
} Slave;
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */

#ifndef TCL_NO_CMDALIASES
/*
 * struct Target:
 *
 * Maps from master interpreter commands back to the source commands in slave
 * interpreters. This is needed because aliases can be created between sibling
 * interpreters and must be deleted when the target interpreter is deleted. In
 * case they would not be deleted the source interpreter would be left with a
 * "dangling pointer". One such record is stored in the Master record of the
 * master interpreter (in the targetTable hashtable, see below) with the
 * master for each alias which directs to a command in the master. These
 * records are used to remove the source command for an from a slave if/when
 * the master is deleted.
 */

typedef struct Target {
    Tcl_Command	slaveCmd;	/* Command for alias in slave interp. */
    Tcl_Interp *slaveInterp;	/* Slave Interpreter. */
} Target;
#endif

#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
/*
 * struct Master:
 *
 * This record is used for two purposes: First, slaveTable (a hashtable)
 * maps from names of commands to slave interpreters. This hashtable is
 * used to store information about slave interpreters of this interpreter,
 * to map over all slaves, etc. The second purpose is to store information
 * about all aliases in slaves (or siblings) which direct to target commands
 * in this interpreter (using the targetTable hashtable).
 * 
 * NB: the flags field in the interp structure, used with SAFE_INTERP
 * mask denotes whether the interpreter is safe or not. Safe
 * interpreters have restricted functionality, can only create safe slave
 * interpreters and can only load safe extensions.
 */

typedef struct Master {
    Tcl_HashTable slaveTable;	/* Hash table for slave interpreters.
                                 * Maps from command names to Slave records. */
#ifndef TCL_NO_CMDALIASES
    Tcl_HashTable targetTable;	/* Hash table for Target Records. Contains
                                 * all Target records which denote aliases
                                 * from slaves or sibling interpreters that
                                 * direct to commands in this interpreter. This
                                 * table is used to remove dangling pointers
                                 * from the slave (or sibling) interpreters
                                 * when this interpreter is deleted. */
#endif
} Master;

/*
 * The following structure keeps track of all the Master and Slave information
 * on a per-interp basis.
 */

typedef struct InterpInfo {
    Master master;		/* Keeps track of all interps for which this
				 * interp is the Master. */
    Slave slave;		/* Information necessary for this interp to
				 * function as a slave. */
} InterpInfo;
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */

/*
 * Prototypes for local static procedures:
 */

#ifndef TCL_NO_CMDALIASES
static int		AliasCreate _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
			    Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,
			    Tcl_Obj *CONST objv[]));
static int		AliasDelete _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, Tcl_Obj *namePtr));
static int		AliasDescribe _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, Tcl_Obj *objPtr));
static int		AliasList _ANSI_ARGS_((Tcl_Interp *interp,
		            Tcl_Interp *slaveInterp));
static int		AliasObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *currentInterp, int objc,
		            Tcl_Obj *CONST objv[]));
static void		AliasObjCmdDeleteProc _ANSI_ARGS_((
			    ClientData clientData));
#endif

#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
static Tcl_Interp *	GetInterp _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *pathPtr));
static Tcl_Interp *	GetInterp2 _ANSI_ARGS_((Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static void		InterpInfoDeleteProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp));
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */
#ifndef TCL_NO_SLAVEINTERP
static Tcl_Interp *	SlaveCreate _ANSI_ARGS_((Tcl_Interp *interp,
		            Tcl_Obj *pathPtr, int safe));
static int		SlaveEval _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int objc,
			    Tcl_Obj *CONST objv[]));
static int		SlaveExpose _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int objc,

static int		SlaveMarkTrusted _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp));
static int		SlaveObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static void		SlaveObjCmdDeleteProc _ANSI_ARGS_((
			    ClientData clientData));
#endif

/*
 *---------------------------------------------------------------------------
 *
 * TclInterpInit --
 *
 *	Initializes the invoking interpreter for using the master, slave
 *	and safe interp facilities.  This is called from inside
 *	Tcl_CreateInterp().
 *
 * Results:
 *	Always returns TCL_OK for backwards compatibility.
 *
 * Side effects:
 *	Adds the "interp" command to an interpreter and initializes the
 *	interpInfoPtr field of the invoking interpreter.
 *
 *---------------------------------------------------------------------------
 */

#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
int
TclInterpInit(interp)
    Tcl_Interp *interp;			/* Interpreter to initialize. */
{
    InterpInfo *interpInfoPtr;
    Master *masterPtr;
    Slave *slavePtr;	

    interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));
    ((Interp *) interp)->interpInfo = (ClientData) interpInfoPtr;

    masterPtr = &interpInfoPtr->master;
    Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);
#ifndef TCL_NO_CMDALIASES
    Tcl_InitHashTable(&masterPtr->targetTable, TCL_ONE_WORD_KEYS);
#endif

    slavePtr = &interpInfoPtr->slave;
    slavePtr->masterInterp	= NULL;
    slavePtr->slaveEntryPtr	= NULL;
    slavePtr->slaveInterp	= interp;
    slavePtr->interpCmd		= NULL;
    Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);

    Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL);

    Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
    return TCL_OK;
}
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */

/*
 *---------------------------------------------------------------------------
 *
 * InterpInfoDeleteProc --
 *
 *	Invoked when an interpreter is being deleted.  It releases all
 *	storage used by the master/slave/safe interpreter facilities.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Cleans up storage.  Sets the interpInfoPtr field of the interp
 *	to NULL.
 *
 *---------------------------------------------------------------------------
 */

#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
static void
InterpInfoDeleteProc(clientData, interp)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* Interp being deleted.  All commands for
				 * slave interps should already be deleted. */
{
    InterpInfo *interpInfoPtr;
    Slave *slavePtr;
    Master *masterPtr;
#ifndef TCL_NO_CMDALIASES
    Tcl_HashSearch hSearch;
    Tcl_HashEntry *hPtr;
    Target *targetPtr;
#endif

    interpInfoPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;

    /*
     * There shouldn't be any commands left.
     */

    masterPtr = &interpInfoPtr->master;
    if (masterPtr->slaveTable.numEntries != 0) {
	panic("InterpInfoDeleteProc: still exist commands");
    }
    Tcl_DeleteHashTable(&masterPtr->slaveTable);

#ifndef TCL_NO_CMDALIASES
    /*
     * Tell any interps that have aliases to this interp that they should
     * delete those aliases.  If the other interp was already dead, it
     * would have removed the target record already. 
     */

    hPtr = Tcl_FirstHashEntry(&masterPtr->targetTable, &hSearch);
    while (hPtr != NULL) {
	targetPtr = (Target *) Tcl_GetHashValue(hPtr);
	Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
		targetPtr->slaveCmd);
	hPtr = Tcl_NextHashEntry(&hSearch);
    }
    Tcl_DeleteHashTable(&masterPtr->targetTable);
#endif

    slavePtr = &interpInfoPtr->slave;
    if (slavePtr->interpCmd != NULL) {
	/*
	 * Tcl_DeleteInterp() was called on this interpreter, rather
	 * "interp delete" or the equivalent deletion of the command in the
	 * master.  First ensure that the cleanup callback doesn't try to

    if (slavePtr->aliasTable.numEntries != 0) {
	panic("InterpInfoDeleteProc: still exist aliases");
    }
    Tcl_DeleteHashTable(&slavePtr->aliasTable);

    ckfree((char *) interpInfoPtr);    
}
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InterpObjCmd --
 *
 *	This procedure is invoked to process the "interp" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
	/* ARGSUSED */
int
Tcl_InterpObjCmd(clientData, interp, objc, objv)
    ClientData clientData;		/* Unused. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    int index;
    static char *options[] = {
#ifndef TCL_NO_CMDALIASES
        "alias",	"aliases",
#endif
#ifndef TCL_NO_SLAVEINTERP
	"create",	"delete", 
	"eval",		"exists",	"expose",	"hide", 
	"hidden",	"issafe",	"invokehidden",	"marktrusted", 
	"slaves",
#endif
#ifndef TCL_NO_SLAVEINTERP
#ifndef TCL_NO_NONSTDCHAN
	"share",
#endif
#endif
#ifndef TCL_NO_CMDALIASES
	"target",
#endif
#ifndef TCL_NO_SLAVEINTERP
#ifndef TCL_NO_NONSTDCHAN
	"transfer",
#endif
#endif
        NULL
    };
    enum option {
#ifndef TCL_NO_CMDALIASES
	OPT_ALIAS
	,OPT_ALIASES
#endif
#ifndef TCL_NO_SLAVEINTERP
#ifndef TCL_NO_CMDALIASES
	,
#endif
	OPT_CREATE
	,OPT_DELETE
	,OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,	OPT_HIDE
	,OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,	OPT_MARKTRUSTED
	,OPT_SLAVES
#endif
#ifndef TCL_NO_SLAVEINTERP
#ifndef TCL_NO_NONSTDCHAN
	,OPT_SHARE
#endif
#endif
#ifndef TCL_NO_CMDALIASES
	,OPT_TARGET
#endif
#ifndef TCL_NO_SLAVEINTERP
#ifndef TCL_NO_NONSTDCHAN
	,OPT_TRANSFER
#endif
#endif
    };


    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, 
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum option) index) {
#ifndef TCL_NO_CMDALIASES
	case OPT_ALIAS: {
	    Tcl_Interp *slaveInterp, *masterInterp;

	    if (objc < 4) {
		aliasArgs:
		Tcl_WrongNumArgs(interp, 2, objv,
			"slavePath slaveCmd ?masterPath masterCmd? ?args ..?");

	    slaveInterp = GetInterp2(interp, objc, objv);
	    if (slaveInterp == NULL) {
		return TCL_ERROR;
	    }
	    return AliasList(interp, slaveInterp);
	}
#endif
#ifndef TCL_NO_SLAVEINTERP
	case OPT_CREATE: {
	    int i, last, safe;
	    Tcl_Obj *slavePtr;
	    char buf[16 + TCL_INTEGER_SPACE];
	    static char *options[] = {
		"-safe",	"--",		NULL
	    };

	    for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
		string = Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr);
		Tcl_ListObjAppendElement(NULL, resultPtr,
			Tcl_NewStringObj(string, -1));
	    }
	    return TCL_OK;
	}
#endif
#ifndef TCL_NO_NONSTDCHAN
#ifndef TCL_NO_SLAVEINTERP
	case OPT_SHARE: {
	    Tcl_Interp *slaveInterp;		/* A slave. */
	    Tcl_Interp *masterInterp;		/* Its master. */
	    Tcl_Channel chan;

	    if (objc != 5) {
		Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");

	    slaveInterp = GetInterp(interp, objv[4]);
	    if (slaveInterp == NULL) {
		return TCL_ERROR;
	    }
	    Tcl_RegisterChannel(slaveInterp, chan);
	    return TCL_OK;
	}
#endif
#endif
#ifndef TCL_NO_CMDALIASES
	case OPT_TARGET: {
	    Tcl_Interp *slaveInterp;
	    InterpInfo *iiPtr;
	    Tcl_HashEntry *hPtr;	
	    Alias *aliasPtr;		
	    char *aliasName;

			"target interpreter for alias \"", aliasName,
			"\" in path \"", Tcl_GetString(objv[2]),
			"\" is not my descendant", (char *) NULL);
		return TCL_ERROR;
	    }
	    return TCL_OK;
	}
#endif
#ifndef TCL_NO_NONSTDCHAN
#ifndef TCL_NO_SLAVEINTERP
	case OPT_TRANSFER: {
	    Tcl_Interp *slaveInterp;		/* A slave. */
	    Tcl_Interp *masterInterp;		/* Its master. */
	    Tcl_Channel chan;
		    
	    if (objc != 5) {
		Tcl_WrongNumArgs(interp, 2, objv,

	    Tcl_RegisterChannel(slaveInterp, chan);
	    if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
		TclTransferResult(masterInterp, TCL_OK, interp);
		return TCL_ERROR;
	    }
	    return TCL_OK;
	}
#endif
#endif
    }
    return TCL_OK;
}
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */

/*
 *---------------------------------------------------------------------------
 *
 * GetInterp2 --
 *
 *	Helper function for Tcl_InterpObjCmd() to convert the interp name

 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 
#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
static Tcl_Interp *
GetInterp2(interp, objc, objv)
    Tcl_Interp *interp;		/* Default interp if no interp was specified
				 * on the command line. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    if (objc == 2) {
	return interp;
    } else if (objc == 3) {
	return GetInterp(interp, objv[2]);
    } else {
	Tcl_WrongNumArgs(interp, 2, objv, "?path?");
	return NULL;
    }
}
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateAlias --
 *
 *	Creates an alias between two interpreters.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates a new alias, manipulates the result field of slaveInterp.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CMDALIASES
int
Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
    Tcl_Interp *slaveInterp;	/* Interpreter for source command. */
    char *slaveCmd;		/* Command to install in slave. */
    Tcl_Interp *targetInterp;	/* Interpreter for target command. */
    char *targetCmd;		/* Name of target command. */
    int argc;			/* How many additional arguments? */

    }
    ckfree((char *) objv);
    Tcl_DecrRefCount(targetObjPtr);
    Tcl_DecrRefCount(slaveObjPtr);

    return result;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateAliasObj --
 *
 *	Object version: Creates an alias between two interpreters.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates a new alias.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CMDALIASES
int
Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
    Tcl_Interp *slaveInterp;	/* Interpreter for source command. */
    char *slaveCmd;		/* Command to install in slave. */
    Tcl_Interp *targetInterp;	/* Interpreter for target command. */
    char *targetCmd;		/* Name of target command. */
    int objc;			/* How many additional arguments? */

    result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr,
	    targetObjPtr, objc, objv);

    Tcl_DecrRefCount(slaveObjPtr);
    Tcl_DecrRefCount(targetObjPtr);
    return result;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAlias --
 *
 *	Gets information about an alias.
 *
 * Results:
 *	A standard Tcl result. 
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CMDALIASES
int
Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
        argvPtr)
    Tcl_Interp *interp;			/* Interp to start search from. */
    char *aliasName;			/* Name of alias to find. */
    Tcl_Interp **targetInterpPtr;	/* (Return) target interpreter. */
    char **targetNamePtr;		/* (Return) name of target command. */

        *argvPtr = (char **) ckalloc((unsigned) sizeof(char *) * (objc - 1));
        for (i = 1; i < objc; i++) {
            *argvPtr[i - 1] = Tcl_GetString(objv[i]);
        }
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAliasObj --
 *
 *	Object version: Gets information about an alias.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CMDALIASES
int
Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
        objvPtr)
    Tcl_Interp *interp;			/* Interp to start search from. */
    char *aliasName;			/* Name of alias to find. */
    Tcl_Interp **targetInterpPtr;	/* (Return) target interpreter. */
    char **targetNamePtr;		/* (Return) name of target command. */

        *objcPtr = objc - 1;
    }
    if (objvPtr != (Tcl_Obj ***) NULL) {
        *objvPtr = objv + 1;
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclPreventAliasLoop --
 *
 *	When defining an alias or renaming a command, prevent an alias

 * NOTE:
 *	This function is public internal (instead of being static to
 *	this file) because it is also used from TclRenameCommand.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CMDALIASES
int
TclPreventAliasLoop(interp, cmdInterp, cmd)
    Tcl_Interp *interp;			/* Interp in which to report errors. */
    Tcl_Interp *cmdInterp;		/* Interp in which the command is
                                         * being defined. */
    Tcl_Command cmd;                    /* Tcl command we are attempting
                                         * to define. */

            return TCL_OK;
        }
        nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
    }

    /* NOTREACHED */
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * AliasCreate --
 *
 *	Helper function to do the work to actually create an alias.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	An alias command is created and entered into the alias table
 *	for the slave interpreter.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CMDALIASES
static int
AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
	objc, objv)
    Tcl_Interp *interp;		/* Interp for error reporting. */
    Tcl_Interp *slaveInterp;	/* Interp where alias cmd will live or from
				 * which alias will be deleted. */
    Tcl_Interp *masterInterp;	/* Interp in which target command will be

    Tcl_SetHashValue(hPtr, (ClientData) targetPtr);
    aliasPtr->targetEntryPtr = hPtr;

    Tcl_SetObjResult(interp, namePtr);
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * AliasDelete --
 *
 *	Deletes the given alias from the slave interpreter given.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Deletes the alias from the slave interpreter.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CMDALIASES
static int
AliasDelete(interp, slaveInterp, namePtr)
    Tcl_Interp *interp;		/* Interpreter for result & errors. */
    Tcl_Interp *slaveInterp;	/* Interpreter containing alias. */
    Tcl_Obj *namePtr;		/* Name of alias to describe. */
{
    Slave *slavePtr;

		Tcl_GetString(namePtr), "\" not found", NULL);
        return TCL_ERROR;
    }
    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
    Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * AliasDescribe --
 *
 *	Sets the interpreter's result object to a Tcl list describing
 *	the given alias in the given interpreter: its target command
 *	and the additional arguments to prepend to any invocation
 *	of the alias.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CMDALIASES
static int
AliasDescribe(interp, slaveInterp, namePtr)
    Tcl_Interp *interp;		/* Interpreter for result & errors. */
    Tcl_Interp *slaveInterp;	/* Interpreter containing alias. */
    Tcl_Obj *namePtr;		/* Name of alias to describe. */
{
    Slave *slavePtr;

    if (hPtr == NULL) {
        return TCL_OK;
    }
    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
    Tcl_SetObjResult(interp, aliasPtr->prefixPtr);
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * AliasList --
 *
 *	Computes a list of aliases defined in a slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CMDALIASES
static int
AliasList(interp, slaveInterp)
    Tcl_Interp *interp;		/* Interp for data return. */
    Tcl_Interp *slaveInterp;	/* Interp whose aliases to compute. */
{
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch hashSearch;

    entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch);
    for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) {
        aliasPtr = (Alias *) Tcl_GetHashValue(entryPtr);
        Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->namePtr);
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * AliasObjCmd --
 *
 *	This is the procedure that services invocations of aliases in a

 *	Causes forwarding of the invocation; all possible side effects
 *	may occur as a result of invoking the command to which the
 *	invocation is forwarded.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CMDALIASES
static int
AliasObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Alias record. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument vector. */	
{

    ((Interp *) targetInterp)->numLevels--;
    
    TclTransferResult(targetInterp, result, interp);

    Tcl_Release((ClientData) targetInterp);
    return result;        
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * AliasObjCmdDeleteProc --
 *
 *	Is invoked when an alias command is deleted in a slave. Cleans up
 *	all storage associated with this alias.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the alias record and its entry in the alias table for
 *	the interpreter.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_CMDALIASES
static void
AliasObjCmdDeleteProc(clientData)
    ClientData clientData;	/* The alias record for this alias. */
{
    Alias *aliasPtr;		
    Target *targetPtr;		

    aliasPtr = (Alias *) clientData;
    
    Tcl_DecrRefCount(aliasPtr->namePtr);
    Tcl_DecrRefCount(aliasPtr->prefixPtr);
    Tcl_DeleteHashEntry(aliasPtr->aliasEntryPtr);

    targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntryPtr);
    ckfree((char *) targetPtr);
    Tcl_DeleteHashEntry(aliasPtr->targetEntryPtr);

    ckfree((char *) aliasPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateSlave --
 *
 *	Creates a slave interpreter. The slavePath argument denotes the

 * Side effects:
 *	Creates a new interpreter and a new interpreter object command in
 *	the interpreter indicated by the slavePath argument.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_SLAVEINTERP
Tcl_Interp *
Tcl_CreateSlave(interp, slavePath, isSafe)
    Tcl_Interp *interp;		/* Interpreter to start search at. */
    char *slavePath;		/* Name of slave to create. */
    int isSafe;			/* Should new slave be "safe" ? */
{
    Tcl_Obj *pathPtr;
    Tcl_Interp *slaveInterp;

    pathPtr = Tcl_NewStringObj(slavePath, -1);
    slaveInterp = SlaveCreate(interp, pathPtr, isSafe);
    Tcl_DecrRefCount(pathPtr);

    return slaveInterp;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetSlave --
 *
 *	Finds a slave interpreter by its path name.
 *
 * Results:
 *	Returns a Tcl_Interp * for the named interpreter or NULL if not
 *	found.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
Tcl_Interp *
Tcl_GetSlave(interp, slavePath)
    Tcl_Interp *interp;		/* Interpreter to start search from. */
    char *slavePath;		/* Path of slave to find. */
{
    Tcl_Obj *pathPtr;
    Tcl_Interp *slaveInterp;

    pathPtr = Tcl_NewStringObj(slavePath, -1);
    slaveInterp = GetInterp(interp, pathPtr);
    Tcl_DecrRefCount(pathPtr);

    return slaveInterp;
}
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetMaster --
 *
 *	Finds the master interpreter of a slave interpreter.
 *
 * Results:
 *	Returns a Tcl_Interp * for the master interpreter or NULL if none.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
Tcl_Interp *
Tcl_GetMaster(interp)
    Tcl_Interp *interp;		/* Get the master of this interpreter. */
{
    Slave *slavePtr;		/* Slave record of this interpreter. */

    if (interp == (Tcl_Interp *) NULL) {
        return NULL;
    }
    slavePtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->slave;
    return slavePtr->masterInterp;
}
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetInterpPath --
 *
 *	Sets the result of the asking interpreter to a proper Tcl list

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
int
Tcl_GetInterpPath(askingInterp, targetInterp)
    Tcl_Interp *askingInterp;	/* Interpreter to start search from. */
    Tcl_Interp *targetInterp;	/* Interpreter to find. */
{
    InterpInfo *iiPtr;
    

        return TCL_ERROR;
    }
    Tcl_AppendElement(askingInterp,
	    Tcl_GetHashKey(&iiPtr->master.slaveTable,
		    iiPtr->slave.slaveEntryPtr));
    return TCL_OK;
}
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */

/*
 *----------------------------------------------------------------------
 *
 * GetInterp --
 *
 *	Helper function to find a slave interpreter given a pathname.
 *
 * Results:
 *	Returns the slave interpreter known by that name in the calling
 *	interpreter, or NULL if no interpreter known by that name exists. 
 *
 * Side effects:
 *	Assigns to the pointer variable passed in, if not NULL.
 *
 *----------------------------------------------------------------------
 */

#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
static Tcl_Interp *
GetInterp(interp, pathPtr)
    Tcl_Interp *interp;		/* Interp. to start search from. */
    Tcl_Obj *pathPtr;		/* List object containing name of interp. to 
				 * be found. */
{
    Tcl_HashEntry *hPtr;	/* Search element. */

    if (searchInterp == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"could not find interpreter \"",
                Tcl_GetString(pathPtr), "\"", (char *) NULL);
    }
    return searchInterp;
}
#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */

/*
 *----------------------------------------------------------------------
 *
 * SlaveCreate --
 *
 *	Helper function to do the actual work of creating a slave interp
 *	and new object command. Also optionally makes the new slave
 *	interpreter "safe".
 *
 * Results:
 *	Returns the new Tcl_Interp * if successful or NULL if not. If failed,
 *	the result of the invoking interpreter contains an error message.
 *
 * Side effects:
 *	Creates a new slave interpreter and a new object command.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_SLAVEINTERP
static Tcl_Interp *
SlaveCreate(interp, pathPtr, safe)
    Tcl_Interp *interp;		/* Interp. to start search from. */
    Tcl_Obj *pathPtr;		/* Path (name) of slave to create. */
    int safe;			/* Should we make it "safe"? */
{
    Tcl_Interp *masterInterp, *slaveInterp;

    error:
    TclTransferResult(slaveInterp, TCL_ERROR, interp);
    Tcl_DeleteInterp(slaveInterp);

    return NULL;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SlaveObjCmd --
 *
 *	Command to manipulate an interpreter, e.g. to send commands to it
 *	to be evaluated. One such command exists for each slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_SLAVEINTERP
static int
SlaveObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Slave interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Tcl_Interp *slaveInterp;
    int index;
    static char *options[] = {
#ifndef TCL_NO_CMDALIASES
        "alias",	"aliases",
#endif
	"eval",		"expose",
        "hide",		"hidden",	"issafe",	"invokehidden",
        "marktrusted",	NULL
    };
    enum options {
#ifndef TCL_NO_CMDALIASES
	OPT_ALIAS,	OPT_ALIASES,
#endif
	OPT_EVAL,	OPT_EXPOSE,
	OPT_HIDE,	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHIDDEN,
	OPT_MARKTRUSTED
    };
    
    slaveInterp = (Tcl_Interp *) clientData;
    if (slaveInterp == NULL) {
	panic("SlaveObjCmd: interpreter has been deleted");
    }

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum options) index) {
#ifndef TCL_NO_CMDALIASES
	case OPT_ALIAS: {
	    if (objc == 3) {
		return AliasDescribe(interp, slaveInterp, objv[2]);
	    }
	    if (Tcl_GetString(objv[3])[0] == '\0') {
		if (objc == 4) {
		    return AliasDelete(interp, slaveInterp, objv[2]);
		}
	    } else {
		return AliasCreate(interp, slaveInterp, interp, objv[2],
			objv[3], objc - 4, objv + 4);
	    }
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "aliasName ?targetName? ?args..?");
            return TCL_ERROR;
	}
	case OPT_ALIASES: {
	    return AliasList(interp, slaveInterp);
	}
#endif
	case OPT_EVAL: {
	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
		return TCL_ERROR;
	    }
	    return SlaveEval(interp, slaveInterp, objc - 2, objv + 2);
	}

	    }
            return SlaveMarkTrusted(interp, slaveInterp);
	}
    }

    return TCL_ERROR;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SlaveObjCmdDeleteProc --
 *
 *	Invoked when an object command for a slave interpreter is deleted;
 *	cleans up all state associated with the slave interpreter and destroys
 *	the slave interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Cleans up all state associated with the slave interpreter and
 *	destroys the slave interpreter.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_SLAVEINTERP
static void
SlaveObjCmdDeleteProc(clientData)
    ClientData clientData;		/* The SlaveRecord for the command. */
{
    Slave *slavePtr;			/* Interim storage for Slave record. */
    Tcl_Interp *slaveInterp;		/* And for a slave interp. */

    slavePtr->interpCmd = NULL;

    if (slavePtr->slaveInterp != NULL) {
	Tcl_DeleteInterp(slavePtr->slaveInterp);
    }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SlaveEval --
 *
 *	Helper function to evaluate a command in a slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Whatever the command does.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_SLAVEINTERP
static int
SlaveEval(interp, slaveInterp, objc, objv)
    Tcl_Interp *interp;		/* Interp for error return. */
    Tcl_Interp *slaveInterp;	/* The slave interpreter in which command
				 * will be evaluated. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */

	Tcl_DecrRefCount(objPtr);
    }
    TclTransferResult(slaveInterp, result, interp);

    Tcl_Release((ClientData) slaveInterp);
    return result;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SlaveExpose --
 *
 *	Helper function to expose a command in a slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	After this call scripts in the slave will be able to invoke
 *	the newly exposed command.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_SLAVEINTERP
static int
SlaveExpose(interp, slaveInterp, objc, objv)
    Tcl_Interp *interp;		/* Interp for error return. */
    Tcl_Interp	*slaveInterp;	/* Interp in which command will be exposed. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument strings. */
{

    if (Tcl_ExposeCommand(slaveInterp, Tcl_GetString(objv[0]),
	    name) != TCL_OK) {
	TclTransferResult(slaveInterp, TCL_ERROR, interp);
	return TCL_ERROR;
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SlaveHide --
 *
 *	Helper function to hide a command in a slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	After this call scripts in the slave will no longer be able
 *	to invoke the named command.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_SLAVEINTERP
static int
SlaveHide(interp, slaveInterp, objc, objv)
    Tcl_Interp *interp;		/* Interp for error return. */
    Tcl_Interp	*slaveInterp;	/* Interp in which command will be exposed. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument strings. */
{

    if (Tcl_HideCommand(slaveInterp, Tcl_GetString(objv[0]),
	    name) != TCL_OK) {
	TclTransferResult(slaveInterp, TCL_ERROR, interp);
	return TCL_ERROR;
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SlaveHidden --
 *
 *	Helper function to compute list of hidden commands in a slave
 *	interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_SLAVEINTERP
static int
SlaveHidden(interp, slaveInterp)
    Tcl_Interp *interp;		/* Interp for data return. */
    Tcl_Interp *slaveInterp;	/* Interp whose hidden commands to query. */
{
    Tcl_Obj *listObjPtr;		/* Local object pointer. */
    Tcl_HashTable *hTblPtr;		/* For local searches. */

	    Tcl_ListObjAppendElement(NULL, listObjPtr,
		    Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
	}
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SlaveInvokeHidden --
 *
 *	Helper function to invoke a hidden command in a slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Whatever the hidden command does.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_SLAVEINTERP
static int
SlaveInvokeHidden(interp, slaveInterp, global, objc, objv)
    Tcl_Interp *interp;		/* Interp for error return. */
    Tcl_Interp *slaveInterp;	/* The slave interpreter in which command
				 * will be invoked. */
    int global;			/* Non-zero to invoke in global namespace. */
    int objc;			/* Number of arguments. */

    }

    TclTransferResult(slaveInterp, result, interp);

    Tcl_Release((ClientData) slaveInterp);
    return result;        
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * SlaveMarkTrusted --
 *
 *	Helper function to mark a slave interpreter as trusted (unsafe).
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	After this call the hard-wired security checks in the core no
 *	longer prevent the slave from performing certain operations.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_SLAVEINTERP
static int
SlaveMarkTrusted(interp, slaveInterp)
    Tcl_Interp *interp;		/* Interp for error return. */
    Tcl_Interp *slaveInterp;	/* The slave interpreter which will be
				 * marked trusted. */
{
    if (Tcl_IsSafe(interp)) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"permission denied: safe interpreter cannot mark trusted",
		(char *) NULL);
	return TCL_ERROR;
    }
    ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP;
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsSafe --
 *
 *	Determines whether an interpreter is safe

     * (the only one remaining is [info nameofexecutable])
     */

    Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY);
    
#ifdef TCL_NO_NONSTDCHAN
    /* IOS FIXME: Unregister is still required to make sub interpreters safe by
     * removing the std* channels from them.
     * This means that removal of sub interp fucntionality allows the removal of this
     * functionality too.
     */
#endif
    /*
     * Remove the standard channels from the interpreter; safe interpreters
     * do not ordinarily have access to stdin, stdout and stderr.
     *
     * NOTE: These channels are not added to the interpreter by the
     * Tcl_CreateInterp call, but may be added later, by another I/O
     * operation. We want to ensure that the interpreter does not have

/* 
 * tclLoad.c --
 *
 *	This file provides the generic portion (those that are the same
 *	on all platforms) of Tcl's dynamic loading facilities.
 *
 * 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: tclLoad.c,v 1.4.12.1 2001/11/28 17:58:37 andreas_kupries Exp $
 */

#include "tclInt.h"

/*
 * The following structure describes a package that has been loaded
 * either dynamically (with the "load" command) or statically (as

 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_LOADCMD
int
Tcl_LoadObjCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{

    }

    /*
     * Figure out which interpreter we're going to load the package into.
     */

    target = interp;
#ifndef TCL_NO_SLAVEINTERP
    if (objc == 4) {
	char *slaveIntName;
	slaveIntName = Tcl_GetString(objv[3]);
	target = Tcl_GetSlave(interp, slaveIntName);
	if (target == NULL) {
	    return TCL_ERROR;
	}
    }
#endif

    /*
     * Scan through the packages that are currently loaded to see if the
     * package we want is already loaded.  We'll use a loaded package if
     * it meets any of the following conditions:
     *  - Its name and file match the once we're looking for.
     *  - Its file matches, and we weren't given a name.

    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&initName);
    Tcl_DStringFree(&safeInitName);
    Tcl_DStringFree(&fileName);
    Tcl_DStringFree(&tmp);
    return code;
}
#endif
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StaticPackage --
 *
 *	This procedure is invoked to indicate that a particular

    Tcl_Interp *interp;		/* Interpreter in which to return
				 * information or error message. */
    char *targetName;		/* Name of target interpreter or NULL.
				 * If NULL, return info about all interps;
				 * otherwise, just return info about this
				 * interpreter. */
{

    LoadedPackage *pkgPtr;
#ifndef TCL_NO_SLAVEINTERP
    Tcl_Interp *target;
    InterpPackage *ipPtr;
#endif
    char *prefix;

    if (targetName == NULL) {
	/* 
	 * Return information about all of the available packages.
	 */

	    Tcl_AppendResult(interp, "}", (char *) NULL);
	    prefix = " {";
	}
	Tcl_MutexUnlock(&packageMutex);
	return TCL_OK;
    }

#ifndef TCL_NO_SLAVEINTERP
    /*
     * Return information about only the packages that are loaded in
     * a given interpreter.
     */

    target = Tcl_GetSlave(interp, targetName);
    if (target == NULL) {
#endif
	return TCL_ERROR;
#ifndef TCL_NO_SLAVEINTERP
    }
    ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
	    (Tcl_InterpDeleteProc **) NULL);
    prefix = "{";
    for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	pkgPtr = ipPtr->pkgPtr;
	Tcl_AppendResult(interp, prefix, (char *) NULL);
	Tcl_AppendElement(interp, pkgPtr->fileName);
	Tcl_AppendElement(interp, pkgPtr->packageName);
	Tcl_AppendResult(interp, "}", (char *) NULL);
	prefix = " {";
    }
    return TCL_OK;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * LoadCleanupProc --
 *

/* 
 * tclLoadNone.c --
 *
 *	This procedure provides a version of the TclLoadFile for use
 *	in systems that don't support dynamic loading; it just returns
 *	an error.
 *
 * 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: tclLoadNone.c,v 1.4.22.1 2001/11/28 17:58:37 andreas_kupries Exp $
 */

#include "tclInt.h"

/*
 *----------------------------------------------------------------------
 *

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_LOADCMD
int
TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    char *fileName;		/* Name of the file containing the desired
				 * code. */
    char *sym1, *sym2;		/* Names of two procedures to look up in
				 * the file's symbol table. */
    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
				/* Where to return the addresses corresponding
				 * to sym1 and sym2. */
    ClientData *clientDataPtr;	/* Filled with token for dynamically loaded
				 * file which will be passed back to 
				 * TclpUnloadFile() to unload the file. */
{
    Tcl_SetResult(interp,
	    "dynamic loading is not currently available on this system",
	    TCL_STATIC);
    return TCL_ERROR;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package

 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_LOADCMD
void
TclpUnloadFile(clientData)
    ClientData clientData;    /* ClientData returned by a previous call
			       * to TclpLoadFile().  The clientData is 
			       * a token that represents the loaded 
			       * file. */
{
}
#endif

/* 
 * tclMain.c --
 *
 *	Main program for Tcl shells and other Tcl-based applications.
 *
 * Copyright (c) 1988-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 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: tclMain.c,v 1.7.2.2.2.1 2001/11/28 17:58:37 andreas_kupries Exp $
 */

#include "tcl.h"
#include "tclInt.h"

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT

Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations for procedures defined later in this file.
 */

static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
#ifndef TCL_NO_FILEEVENTS
static void		StdinProc _ANSI_ARGS_((ClientData clientData,
			    int mask));
#endif


/*
 *----------------------------------------------------------------------
 *
 * TclSetStartupScriptFileName --
 *

	    Tcl_WriteChars(errChannel,
		    "application-specific initialization failed: ", -1);
	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
	    Tcl_WriteChars(errChannel, "\n", 1);
	}
    }

#ifndef TCL_NO_FILESYSTEM
#ifndef TCL_NO_NONSTDCHAN
    /* IOS FIXME : See Tcl_EvalFile */
    /*
     * If a script file was specified then just source that file
     * and quit.
     */

    if (tclStartupScriptFileName != NULL) {
	code = Tcl_EvalFile(interp, tclStartupScriptFileName);

			NULL, TCL_GLOBAL_ONLY));
		Tcl_WriteChars(errChannel, "\n", 1);
	    }
	    exitCode = 1;
	}
	goto done;
    }
#endif
#endif
    Tcl_DStringFree(&argString);

    /*
     * We're running interactively.  Source a user-specific startup
     * file if the application specified one and if the file exists.
     */

	if (mainLoopProc != NULL) {
	    /*
	     * If a main loop has been defined while running interactively,
	     * we want to start a fileevent based prompt by establishing a
	     * channel handler for stdin.
	     */

#ifndef TCL_NO_FILEEVENTS
	    if (inChannel) {
		Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
			(ClientData) inChannel);
	    }
#endif
	    if (tsdPtr->tty) {
		Prompt(interp, 0);
	    }
	    Tcl_DStringInit(&tsdPtr->command);
	    Tcl_DStringInit(&tsdPtr->line);

	    (*mainLoopProc)();

 * Side effects:
 *	Could be almost arbitrary, depending on the command that's
 *	typed.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILEEVENTS
    /* ARGSUSED */
static void
StdinProc(clientData, mask)
    ClientData clientData;		/* Not used. */
    int mask;				/* Not used. */
{
    static int gotPartial = 0;

    prompt:
    if (tsdPtr->tty) {
	Prompt(interp, gotPartial);
    }
    Tcl_ResetResult(interp);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Prompt --
 *
 *	Issue a prompt on standard output, or invoke a script

/* 
 * tclPipe.c --
 *
 *	This file contains the generic portion of the command channel
 *	driver as well as various utility routines used in managing
 *	subprocesses.
 *
 * 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: tclPipe.c,v 1.3.30.1 2001/11/28 17:58:37 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

#ifndef TCL_NO_PIPES
/*
 * A linked list of the following structures is used to keep track
 * of child processes that have been detached but haven't exited
 * yet, so we can make sure that they're properly "reaped" (officially
 * waited for) and don't lie around as zombies cluttering the
 * system.
 */

static Detached *detList = NULL;	/* List of all detached proceses. */
TCL_DECLARE_MUTEX(pipeMutex)		/* Guard access to detList. */

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

#ifndef TCL_NO_FILESYSTEM
static TclFile	FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
	            char *spec, int atOk, char *arg, char *nextArg, 
		    int flags, int *skipPtr, int *closePtr, int *releasePtr));
#endif

/*
 *----------------------------------------------------------------------
 *
 * FileForRedirect --
 *
 *	This procedure does much of the work of parsing redirection

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
static TclFile
FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
	releasePtr)
    Tcl_Interp *interp;		/* Intepreter to use for error reporting. */
    char *spec;			/* Points to character just after
				 * redirection character. */
    char *arg;			/* Pointer to entire argument containing 

    return file;

    badLastArg:
    Tcl_AppendResult(interp, "can't specify \"", arg,
	    "\" as last word in command", (char *) NULL);
    return NULL;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DetachPids --
 *
 *	This procedure is called to indicate that one or more child

    for (i = 0; i < numPids; i++) {
	detPtr = (Detached *) ckalloc(sizeof(Detached));
	detPtr->pid = pidPtr[i];
	detPtr->nextPtr = detList;
	detList = detPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);

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

 *
 * Side effects:
 *	Processes and pipes are created.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
	outPipePtr, errFilePtr)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    int argc;			/* Number of entries in argv. */
    char **argv;		/* Array of strings describing commands in
				 * pipeline plus I/O redirection with <,

	    }
	}
	ckfree((char *) pidPtr);
    }
    numPids = -1;
    goto cleanup;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenCommandChannel --
 *
 *	Opens an I/O channel to one or more subprocesses specified

 *
 * Side effects:
 *	Creates processes, opens pipes.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
Tcl_Channel
Tcl_OpenCommandChannel(interp, argc, argv, flags)
    Tcl_Interp *interp;		/* Interpreter for error reporting. Can
                                 * NOT be NULL. */
    int argc;			/* How many arguments. */
    char **argv;		/* Array of arguments for command pipe. */
    int flags;			/* Or'ed combination of TCL_STDIN, TCL_STDOUT,

	TclpCloseFile(outPipe);
    }
    if (errFile != NULL) {
	TclpCloseFile(errFile);
    }
    return NULL;
}
#endif /* TCL_NO_FILESYSTEM */
#endif /* TCL_NO_PIPES */

/* 
 * 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.35.2.7.2.1 2001/11/28 17:58:37 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

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

 */

/* !BEGIN!: Do not edit below this line. */

TclIntStubs tclIntStubs = {
    TCL_STUB_MAGIC,
    NULL,
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 0*/
#else  /* TCL_NO_FILESYSTEM */
    TclAccess, /* 0 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 1*/
#else  /* TCL_NO_FILESYSTEM */
    TclAccessDeleteProc, /* 1 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 2*/
#else  /* TCL_NO_FILESYSTEM */
    TclAccessInsertProc, /* 2 */
#endif /* TCL_NO_FILESYSTEM */
    TclAllocateFreeObjects, /* 3 */
    NULL, /* 4 */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#if defined(TCL_NO_PIPES)
    NULL, /* 5*/
#else  /* TCL_NO_PIPES */
    TclCleanupChildren, /* 5 */
#endif /* TCL_NO_PIPES */
#endif /* UNIX */
#ifdef __WIN32__
#if defined(TCL_NO_PIPES)
    NULL, /* 5*/
#else  /* TCL_NO_PIPES */
    TclCleanupChildren, /* 5 */
#endif /* TCL_NO_PIPES */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    NULL, /* 5 */
#endif /* MAC_TCL */
    TclCleanupCommand, /* 6 */
    TclCopyAndCollapse, /* 7 */
#if defined(TCL_NO_CHANNELCOPY)
    NULL, /* 8*/
#else  /* TCL_NO_CHANNELCOPY */
    TclCopyChannel, /* 8 */
#endif /* TCL_NO_CHANNELCOPY */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#if defined(TCL_NO_FILESYSTEM) || defined(TCL_NO_PIPES)
    NULL, /* 9*/
#else  /* TCL_NO_FILESYSTEM TCL_NO_PIPES */
    TclCreatePipeline, /* 9 */
#endif /* TCL_NO_FILESYSTEM TCL_NO_PIPES */
#endif /* UNIX */
#ifdef __WIN32__
#if defined(TCL_NO_FILESYSTEM) || defined(TCL_NO_PIPES)
    NULL, /* 9*/
#else  /* TCL_NO_FILESYSTEM TCL_NO_PIPES */
    TclCreatePipeline, /* 9 */
#endif /* TCL_NO_FILESYSTEM TCL_NO_PIPES */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    NULL, /* 9 */
#endif /* MAC_TCL */
    TclCreateProc, /* 10 */
    TclDeleteCompiledLocalVars, /* 11 */
    TclDeleteVars, /* 12 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 13*/
#else  /* TCL_NO_FILESYSTEM */
    TclDoGlob, /* 13 */
#endif /* TCL_NO_FILESYSTEM */
    TclDumpMemoryInfo, /* 14 */
    NULL, /* 15 */
    TclExprFloatError, /* 16 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 17*/
#else  /* TCL_NO_FILESYSTEM */
    TclFileAttrsCmd, /* 17 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 18*/
#else  /* TCL_NO_FILESYSTEM */
    TclFileCopyCmd, /* 18 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 19*/
#else  /* TCL_NO_FILESYSTEM */
    TclFileDeleteCmd, /* 19 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 20*/
#else  /* TCL_NO_FILESYSTEM */
    TclFileMakeDirsCmd, /* 20 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 21*/
#else  /* TCL_NO_FILESYSTEM */
    TclFileRenameCmd, /* 21 */
#endif /* TCL_NO_FILESYSTEM */
    TclFindElement, /* 22 */
    TclFindProc, /* 23 */
    TclFormatInt, /* 24 */
    TclFreePackageInfo, /* 25 */
    NULL, /* 26 */
    TclGetDate, /* 27 */
    TclpGetDefaultStdChannel, /* 28 */
    TclGetElementOfIndexedArray, /* 29 */
    NULL, /* 30 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 31*/
#else  /* TCL_NO_FILESYSTEM */
    TclGetExtension, /* 31 */
#endif /* TCL_NO_FILESYSTEM */
    TclGetFrame, /* 32 */
    TclGetInterpProc, /* 33 */
    TclGetIntForIndex, /* 34 */
    TclGetIndexedScalar, /* 35 */
    TclGetLong, /* 36 */
    TclGetLoadedPackages, /* 37 */
    TclGetNamespaceForQualName, /* 38 */
    TclGetObjInterpProc, /* 39 */
    TclGetOpenMode, /* 40 */
    TclGetOriginalCommand, /* 41 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 42*/
#else  /* TCL_NO_FILESYSTEM */
    TclpGetUserHome, /* 42 */
#endif /* TCL_NO_FILESYSTEM */
    TclGlobalInvoke, /* 43 */
    TclGuessPackageName, /* 44 */
    TclHideUnsafeCommands, /* 45 */
    TclInExit, /* 46 */
    TclIncrElementOfIndexedArray, /* 47 */
    TclIncrIndexedScalar, /* 48 */
    TclIncrVar2, /* 49 */
    TclInitCompiledLocals, /* 50 */
#if defined(TCL_NO_SLAVEINTERP) && defined (TCL_NO_CMDALIASES)
    NULL, /* 51*/
#else  /* TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES */
    TclInterpInit, /* 51 */
#endif /* TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES */
    TclInvoke, /* 52 */
    TclInvokeObjectCommand, /* 53 */
    TclInvokeStringCommand, /* 54 */
    TclIsProc, /* 55 */
    NULL, /* 56 */
    NULL, /* 57 */
    TclLookupVar, /* 58 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 59*/
#else  /* TCL_NO_FILESYSTEM */
    TclpMatchFiles, /* 59 */
#endif /* TCL_NO_FILESYSTEM */
    TclNeedSpace, /* 60 */
    TclNewProcBodyObj, /* 61 */
    TclObjCommandComplete, /* 62 */
    TclObjInterpProc, /* 63 */
    TclObjInvoke, /* 64 */
    TclObjInvokeGlobal, /* 65 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 66*/
#else  /* TCL_NO_FILESYSTEM */
    TclOpenFileChannelDeleteProc, /* 66 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 67*/
#else  /* TCL_NO_FILESYSTEM */
    TclOpenFileChannelInsertProc, /* 67 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 68*/
#else  /* TCL_NO_FILESYSTEM */
    TclpAccess, /* 68 */
#endif /* TCL_NO_FILESYSTEM */
    TclpAlloc, /* 69 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 70*/
#else  /* TCL_NO_FILESYSTEM */
    TclpCopyFile, /* 70 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 71*/
#else  /* TCL_NO_FILESYSTEM */
    TclpCopyDirectory, /* 71 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 72*/
#else  /* TCL_NO_FILESYSTEM */
    TclpCreateDirectory, /* 72 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 73*/
#else  /* TCL_NO_FILESYSTEM */
    TclpDeleteFile, /* 73 */
#endif /* TCL_NO_FILESYSTEM */
    TclpFree, /* 74 */
    TclpGetClicks, /* 75 */
    TclpGetSeconds, /* 76 */
    TclpGetTime, /* 77 */
    TclpGetTimeZone, /* 78 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 79*/
#else  /* TCL_NO_FILESYSTEM */
    TclpListVolumes, /* 79 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM) || defined(TCL_NO_NONSTDCHAN)
    NULL, /* 80*/
#else  /* TCL_NO_FILESYSTEM TCL_NO_NONSTDCHAN */
    TclpOpenFileChannel, /* 80 */
#endif /* TCL_NO_FILESYSTEM TCL_NO_NONSTDCHAN */
    TclpRealloc, /* 81 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 82*/
#else  /* TCL_NO_FILESYSTEM */
    TclpRemoveDirectory, /* 82 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 83*/
#else  /* TCL_NO_FILESYSTEM */
    TclpRenameFile, /* 83 */
#endif /* TCL_NO_FILESYSTEM */
    NULL, /* 84 */
    NULL, /* 85 */
    NULL, /* 86 */
    NULL, /* 87 */
    TclPrecTraceProc, /* 88 */
#if defined(TCL_NO_CMDALIASES)
    NULL, /* 89*/
#else  /* TCL_NO_CMDALIASES */
    TclPreventAliasLoop, /* 89 */
#endif /* TCL_NO_CMDALIASES */
    NULL, /* 90 */
    TclProcCleanupProc, /* 91 */
    TclProcCompileProc, /* 92 */
    TclProcDeleteProc, /* 93 */
    TclProcInterpProc, /* 94 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 95*/
#else  /* TCL_NO_FILESYSTEM */
    TclpStat, /* 95 */
#endif /* TCL_NO_FILESYSTEM */
    TclRenameCommand, /* 96 */
    TclResetShadowedCmdRefs, /* 97 */
    TclServiceIdle, /* 98 */
    TclSetElementOfIndexedArray, /* 99 */
    TclSetIndexedScalar, /* 100 */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
    TclSetPreInitScript, /* 101 */

#endif /* UNIX */
#ifdef __WIN32__
    TclSockMinimumBuffers, /* 104 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    NULL, /* 104 */
#endif /* MAC_TCL */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 105*/
#else  /* TCL_NO_FILESYSTEM */
    TclStat, /* 105 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 106*/
#else  /* TCL_NO_FILESYSTEM */
    TclStatDeleteProc, /* 106 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 107*/
#else  /* TCL_NO_FILESYSTEM */
    TclStatInsertProc, /* 107 */
#endif /* TCL_NO_FILESYSTEM */
    TclTeardownNamespace, /* 108 */
    TclUpdateReturnInfo, /* 109 */
    NULL, /* 110 */
    Tcl_AddInterpResolvers, /* 111 */
    Tcl_AppendExportList, /* 112 */
    Tcl_CreateNamespace, /* 113 */
    Tcl_DeleteNamespace, /* 114 */

    Tcl_RemoveInterpResolvers, /* 130 */
    Tcl_SetNamespaceResolvers, /* 131 */
    TclpHasSockets, /* 132 */
    TclpGetDate, /* 133 */
    TclpStrftime, /* 134 */
    TclpCheckStackSpace, /* 135 */
    NULL, /* 136 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 137*/
#else  /* TCL_NO_FILESYSTEM */
    TclpChdir, /* 137 */
#endif /* TCL_NO_FILESYSTEM */
    TclGetEnv, /* 138 */
#if defined(TCL_NO_FILESYSTEM) || defined(TCL_NO_LOADCMD)
    NULL, /* 139*/
#else  /* TCL_NO_FILESYSTEM TCL_NO_LOADCMD */
    TclpLoadFile, /* 139 */
#endif /* TCL_NO_FILESYSTEM TCL_NO_LOADCMD */
    TclLooksLikeInt, /* 140 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 141*/
#else  /* TCL_NO_FILESYSTEM */
    TclpGetCwd, /* 141 */
#endif /* TCL_NO_FILESYSTEM */
    TclSetByteCodeFromAny, /* 142 */
    TclAddLiteralObj, /* 143 */
    TclHideLiteral, /* 144 */
    TclGetAuxDataType, /* 145 */
    TclHandleCreate, /* 146 */
    TclHandleFree, /* 147 */
    TclHandlePreserve, /* 148 */
    TclHandleRelease, /* 149 */
    TclRegAbout, /* 150 */
    TclRegExpRangeUniChar, /* 151 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 152*/
#else  /* TCL_NO_FILESYSTEM */
    TclSetLibraryPath, /* 152 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 153*/
#else  /* TCL_NO_FILESYSTEM */
    TclGetLibraryPath, /* 153 */
#endif /* TCL_NO_FILESYSTEM */
    NULL, /* 154 */
    NULL, /* 155 */
    TclRegError, /* 156 */
    TclVarTraceExists, /* 157 */
    TclSetStartupScriptFileName, /* 158 */
    TclGetStartupScriptFileName, /* 159 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 160*/
#else  /* TCL_NO_FILESYSTEM */
    TclpMatchFilesTypes, /* 160 */
#endif /* TCL_NO_FILESYSTEM */
    TclChannelTransform, /* 161 */
#if defined(TCL_NO_FILEEVENTS)
    NULL, /* 162*/
#else  /* TCL_NO_FILEEVENTS */
    TclChannelEventScriptInvoker, /* 162 */
#endif /* TCL_NO_FILEEVENTS */
    TclGetInstructionTable, /* 163 */
    TclExpandCodeArray, /* 164 */
};

TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    NULL,
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#if defined(TCL_NO_PIPES)
    NULL, /* 0*/
#else  /* TCL_NO_PIPES */
    TclGetAndDetachPids, /* 0 */
#endif /* TCL_NO_PIPES */
#if defined(TCL_NO_PIPES)
    NULL, /* 1*/
#else  /* TCL_NO_PIPES */
    TclpCloseFile, /* 1 */
#endif /* TCL_NO_PIPES */
#if defined(TCL_NO_PIPES)
    NULL, /* 2*/
#else  /* TCL_NO_PIPES */
    TclpCreateCommandChannel, /* 2 */
#endif /* TCL_NO_PIPES */
#if defined(TCL_NO_PIPES)
    NULL, /* 3*/
#else  /* TCL_NO_PIPES */
    TclpCreatePipe, /* 3 */
#endif /* TCL_NO_PIPES */
#if defined(TCL_NO_PIPES)
    NULL, /* 4*/
#else  /* TCL_NO_PIPES */
    TclpCreateProcess, /* 4 */
#endif /* TCL_NO_PIPES */
    NULL, /* 5 */
#if defined(TCL_NO_PIPES)
    NULL, /* 6*/
#else  /* TCL_NO_PIPES */
    TclpMakeFile, /* 6 */
#endif /* TCL_NO_PIPES */
#if defined(TCL_NO_PIPES)
    NULL, /* 7*/
#else  /* TCL_NO_PIPES */
    TclpOpenFile, /* 7 */
#endif /* TCL_NO_PIPES */
    TclUnixWaitForFile, /* 8 */
#if defined(TCL_NO_PIPES)
    NULL, /* 9*/
#else  /* TCL_NO_PIPES */
    TclpCreateTempFile, /* 9 */
#endif /* TCL_NO_PIPES */
#endif /* UNIX */
#ifdef __WIN32__
    TclWinConvertError, /* 0 */
    TclWinConvertWSAError, /* 1 */
    TclWinGetServByName, /* 2 */
    TclWinGetSockOpt, /* 3 */
    TclWinGetTclInstance, /* 4 */
    NULL, /* 5 */
    TclWinNToHS, /* 6 */
    TclWinSetSockOpt, /* 7 */
    TclpGetPid, /* 8 */
    TclWinGetPlatformId, /* 9 */
    NULL, /* 10 */
#if defined(TCL_NO_PIPES)
    NULL, /* 11*/
#else  /* TCL_NO_PIPES */
    TclGetAndDetachPids, /* 11 */
#endif /* TCL_NO_PIPES */
    TclpCloseFile, /* 12 */
    TclpCreateCommandChannel, /* 13 */
    TclpCreatePipe, /* 14 */
    TclpCreateProcess, /* 15 */
    NULL, /* 16 */
    NULL, /* 17 */
    TclpMakeFile, /* 18 */

    Tcl_Alloc, /* 3 */
    Tcl_Free, /* 4 */
    Tcl_Realloc, /* 5 */
    Tcl_DbCkalloc, /* 6 */
    Tcl_DbCkfree, /* 7 */
    Tcl_DbCkrealloc, /* 8 */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#if defined(TCL_NO_FILEEVENTS)
    NULL, /* 9*/
#else  /* TCL_NO_FILEEVENTS */
    Tcl_CreateFileHandler, /* 9 */
#endif /* TCL_NO_FILEEVENTS */
#endif /* UNIX */
#ifdef __WIN32__
    NULL, /* 9 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    NULL, /* 9 */
#endif /* MAC_TCL */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#if defined(TCL_NO_FILEEVENTS)
    NULL, /* 10*/
#else  /* TCL_NO_FILEEVENTS */
    Tcl_DeleteFileHandler, /* 10 */
#endif /* TCL_NO_FILEEVENTS */
#endif /* UNIX */
#ifdef __WIN32__
    NULL, /* 10 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    NULL, /* 10 */
#endif /* MAC_TCL */

    Tcl_CallWhenDeleted, /* 79 */
    Tcl_CancelIdleCall, /* 80 */
    Tcl_Close, /* 81 */
    Tcl_CommandComplete, /* 82 */
    Tcl_Concat, /* 83 */
    Tcl_ConvertElement, /* 84 */
    Tcl_ConvertCountedElement, /* 85 */
#if defined(TCL_NO_CMDALIASES)
    NULL, /* 86*/
#else  /* TCL_NO_CMDALIASES */
    Tcl_CreateAlias, /* 86 */
#endif /* TCL_NO_CMDALIASES */
#if defined(TCL_NO_CMDALIASES)
    NULL, /* 87*/
#else  /* TCL_NO_CMDALIASES */
    Tcl_CreateAliasObj, /* 87 */
#endif /* TCL_NO_CMDALIASES */
    Tcl_CreateChannel, /* 88 */
#if defined(TCL_NO_FILEEVENTS)
    NULL, /* 89*/
#else  /* TCL_NO_FILEEVENTS */
    Tcl_CreateChannelHandler, /* 89 */
#endif /* TCL_NO_FILEEVENTS */
    Tcl_CreateCloseHandler, /* 90 */
    Tcl_CreateCommand, /* 91 */
    Tcl_CreateEventSource, /* 92 */
    Tcl_CreateExitHandler, /* 93 */
    Tcl_CreateInterp, /* 94 */
    Tcl_CreateMathFunc, /* 95 */
    Tcl_CreateObjCommand, /* 96 */
#if defined(TCL_NO_SLAVEINTERP)
    NULL, /* 97*/
#else  /* TCL_NO_SLAVEINTERP */
    Tcl_CreateSlave, /* 97 */
#endif /* TCL_NO_SLAVEINTERP */
    Tcl_CreateTimerHandler, /* 98 */
    Tcl_CreateTrace, /* 99 */
    Tcl_DeleteAssocData, /* 100 */
#if defined(TCL_NO_FILEEVENTS)
    NULL, /* 101*/
#else  /* TCL_NO_FILEEVENTS */
    Tcl_DeleteChannelHandler, /* 101 */
#endif /* TCL_NO_FILEEVENTS */
    Tcl_DeleteCloseHandler, /* 102 */
    Tcl_DeleteCommand, /* 103 */
    Tcl_DeleteCommandFromToken, /* 104 */
    Tcl_DeleteEvents, /* 105 */
    Tcl_DeleteEventSource, /* 106 */
    Tcl_DeleteExitHandler, /* 107 */
    Tcl_DeleteHashEntry, /* 108 */
    Tcl_DeleteHashTable, /* 109 */
    Tcl_DeleteInterp, /* 110 */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#if defined(TCL_NO_PIPES)
    NULL, /* 111*/
#else  /* TCL_NO_PIPES */
    Tcl_DetachPids, /* 111 */
#endif /* TCL_NO_PIPES */
#endif /* UNIX */
#ifdef __WIN32__
#if defined(TCL_NO_PIPES)
    NULL, /* 111*/
#else  /* TCL_NO_PIPES */
    Tcl_DetachPids, /* 111 */
#endif /* TCL_NO_PIPES */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    NULL, /* 111 */
#endif /* MAC_TCL */
    Tcl_DeleteTimerHandler, /* 112 */
    Tcl_DeleteTrace, /* 113 */
    Tcl_DontCallWhenDeleted, /* 114 */

    Tcl_DStringResult, /* 123 */
    Tcl_DStringSetLength, /* 124 */
    Tcl_DStringStartSublist, /* 125 */
    Tcl_Eof, /* 126 */
    Tcl_ErrnoId, /* 127 */
    Tcl_ErrnoMsg, /* 128 */
    Tcl_Eval, /* 129 */
#if defined(TCL_NO_FILESYSTEM) || defined(TCL_NO_NONSTDCHAN)
    NULL, /* 130*/
#else  /* TCL_NO_FILESYSTEM TCL_NO_NONSTDCHAN */
    Tcl_EvalFile, /* 130 */
#endif /* TCL_NO_FILESYSTEM TCL_NO_NONSTDCHAN */
    Tcl_EvalObj, /* 131 */
    Tcl_EventuallyFree, /* 132 */
    Tcl_Exit, /* 133 */
    Tcl_ExposeCommand, /* 134 */
    Tcl_ExprBoolean, /* 135 */
    Tcl_ExprBooleanObj, /* 136 */
    Tcl_ExprDouble, /* 137 */
    Tcl_ExprDoubleObj, /* 138 */
    Tcl_ExprLong, /* 139 */
    Tcl_ExprLongObj, /* 140 */
    Tcl_ExprObj, /* 141 */
    Tcl_ExprString, /* 142 */
    Tcl_Finalize, /* 143 */
    Tcl_FindExecutable, /* 144 */
    Tcl_FirstHashEntry, /* 145 */
    Tcl_Flush, /* 146 */
    Tcl_FreeResult, /* 147 */
#if defined(TCL_NO_CMDALIASES)
    NULL, /* 148*/
#else  /* TCL_NO_CMDALIASES */
    Tcl_GetAlias, /* 148 */
#endif /* TCL_NO_CMDALIASES */
#if defined(TCL_NO_CMDALIASES)
    NULL, /* 149*/
#else  /* TCL_NO_CMDALIASES */
    Tcl_GetAliasObj, /* 149 */
#endif /* TCL_NO_CMDALIASES */
    Tcl_GetAssocData, /* 150 */
    Tcl_GetChannel, /* 151 */
    Tcl_GetChannelBufferSize, /* 152 */
    Tcl_GetChannelHandle, /* 153 */
    Tcl_GetChannelInstanceData, /* 154 */
    Tcl_GetChannelMode, /* 155 */
    Tcl_GetChannelName, /* 156 */
#if defined(TCL_NO_CHANNEL_CONFIG)
    NULL, /* 157*/
#else  /* TCL_NO_CHANNEL_CONFIG */
    Tcl_GetChannelOption, /* 157 */
#endif /* TCL_NO_CHANNEL_CONFIG */
    Tcl_GetChannelType, /* 158 */
    Tcl_GetCommandInfo, /* 159 */
    Tcl_GetCommandName, /* 160 */
    Tcl_GetErrno, /* 161 */
    Tcl_GetHostName, /* 162 */
#if defined(TCL_NO_SLAVEINTERP) && defined (TCL_NO_CMDALIASES)
    NULL, /* 163*/
#else  /* TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES */
    Tcl_GetInterpPath, /* 163 */
#endif /* TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES */
#if defined(TCL_NO_SLAVEINTERP) && defined (TCL_NO_CMDALIASES)
    NULL, /* 164*/
#else  /* TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES */
    Tcl_GetMaster, /* 164 */
#endif /* TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES */
    Tcl_GetNameOfExecutable, /* 165 */
    Tcl_GetObjResult, /* 166 */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
    Tcl_GetOpenFile, /* 167 */
#endif /* UNIX */
#ifdef __WIN32__
    NULL, /* 167 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    NULL, /* 167 */
#endif /* MAC_TCL */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 168*/
#else  /* TCL_NO_FILESYSTEM */
    Tcl_GetPathType, /* 168 */
#endif /* TCL_NO_FILESYSTEM */
    Tcl_Gets, /* 169 */
    Tcl_GetsObj, /* 170 */
    Tcl_GetServiceMode, /* 171 */
#if defined(TCL_NO_SLAVEINTERP) && defined (TCL_NO_CMDALIASES)
    NULL, /* 172*/
#else  /* TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES */
    Tcl_GetSlave, /* 172 */
#endif /* TCL_NO_SLAVEINTERP TCL_NO_CMDALIASES */
    Tcl_GetStdChannel, /* 173 */
    Tcl_GetStringResult, /* 174 */
    Tcl_GetVar, /* 175 */
    Tcl_GetVar2, /* 176 */
    Tcl_GlobalEval, /* 177 */
    Tcl_GlobalEvalObj, /* 178 */
    Tcl_HideCommand, /* 179 */
    Tcl_Init, /* 180 */
    Tcl_InitHashTable, /* 181 */
    Tcl_InputBlocked, /* 182 */
    Tcl_InputBuffered, /* 183 */
    Tcl_InterpDeleted, /* 184 */
    Tcl_IsSafe, /* 185 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 186*/
#else  /* TCL_NO_FILESYSTEM */
    Tcl_JoinPath, /* 186 */
#endif /* TCL_NO_FILESYSTEM */
    Tcl_LinkVar, /* 187 */
    NULL, /* 188 */
    Tcl_MakeFileChannel, /* 189 */
    Tcl_MakeSafe, /* 190 */
#if defined(TCL_NO_SOCKETS)
    NULL, /* 191*/
#else  /* TCL_NO_SOCKETS */
    Tcl_MakeTcpClientChannel, /* 191 */
#endif /* TCL_NO_SOCKETS */
    Tcl_Merge, /* 192 */
    Tcl_NextHashEntry, /* 193 */
#if defined(TCL_NO_FILEEVENTS)
    NULL, /* 194*/
#else  /* TCL_NO_FILEEVENTS */
    Tcl_NotifyChannel, /* 194 */
#endif /* TCL_NO_FILEEVENTS */
    Tcl_ObjGetVar2, /* 195 */
    Tcl_ObjSetVar2, /* 196 */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#if defined(TCL_NO_FILESYSTEM) || defined(TCL_NO_PIPES)
    NULL, /* 197*/
#else  /* TCL_NO_FILESYSTEM TCL_NO_PIPES */
    Tcl_OpenCommandChannel, /* 197 */
#endif /* TCL_NO_FILESYSTEM TCL_NO_PIPES */
#endif /* UNIX */
#ifdef __WIN32__
#if defined(TCL_NO_FILESYSTEM) || defined(TCL_NO_PIPES)
    NULL, /* 197*/
#else  /* TCL_NO_FILESYSTEM TCL_NO_PIPES */
    Tcl_OpenCommandChannel, /* 197 */
#endif /* TCL_NO_FILESYSTEM TCL_NO_PIPES */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    NULL, /* 197 */
#endif /* MAC_TCL */
#if defined(TCL_NO_FILESYSTEM) || defined(TCL_NO_FILEEVENTS)
    NULL, /* 198*/
#else  /* TCL_NO_FILESYSTEM TCL_NO_FILEEVENTS */
    Tcl_OpenFileChannel, /* 198 */
#endif /* TCL_NO_FILESYSTEM TCL_NO_FILEEVENTS */
#if defined(TCL_NO_SOCKETS)
    NULL, /* 199*/
#else  /* TCL_NO_SOCKETS */
    Tcl_OpenTcpClient, /* 199 */
#endif /* TCL_NO_SOCKETS */
#if defined(TCL_NO_SOCKETS) || defined(TCL_NO_FILEEVENTS)
    NULL, /* 200*/
#else  /* TCL_NO_SOCKETS TCL_NO_FILEEVENTS */
    Tcl_OpenTcpServer, /* 200 */
#endif /* TCL_NO_SOCKETS TCL_NO_FILEEVENTS */
    Tcl_Preserve, /* 201 */
    Tcl_PrintDouble, /* 202 */
    Tcl_PutEnv, /* 203 */
    Tcl_PosixError, /* 204 */
    Tcl_QueueEvent, /* 205 */
    Tcl_Read, /* 206 */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#if defined(TCL_NO_PIPES)
    NULL, /* 207*/
#else  /* TCL_NO_PIPES */
    Tcl_ReapDetachedProcs, /* 207 */
#endif /* TCL_NO_PIPES */
#endif /* UNIX */
#ifdef __WIN32__
#if defined(TCL_NO_PIPES)
    NULL, /* 207*/
#else  /* TCL_NO_PIPES */
    Tcl_ReapDetachedProcs, /* 207 */
#endif /* TCL_NO_PIPES */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    NULL, /* 207 */
#endif /* MAC_TCL */
    Tcl_RecordAndEval, /* 208 */
    Tcl_RecordAndEvalObj, /* 209 */
#if defined(TCL_NO_NONSTDCHAN)
    NULL, /* 210*/
#else  /* TCL_NO_NONSTDCHAN */
    Tcl_RegisterChannel, /* 210 */
#endif /* TCL_NO_NONSTDCHAN */
    Tcl_RegisterObjType, /* 211 */
    Tcl_RegExpCompile, /* 212 */
    Tcl_RegExpExec, /* 213 */
    Tcl_RegExpMatch, /* 214 */
    Tcl_RegExpRange, /* 215 */
    Tcl_Release, /* 216 */
    Tcl_ResetResult, /* 217 */
    Tcl_ScanElement, /* 218 */
    Tcl_ScanCountedElement, /* 219 */
#if defined(TCL_NO_NONSTDCHAN)
    NULL, /* 220*/
#else  /* TCL_NO_NONSTDCHAN */
    Tcl_Seek, /* 220 */
#endif /* TCL_NO_NONSTDCHAN */
    Tcl_ServiceAll, /* 221 */
    Tcl_ServiceEvent, /* 222 */
    Tcl_SetAssocData, /* 223 */
    Tcl_SetChannelBufferSize, /* 224 */
    Tcl_SetChannelOption, /* 225 */
    Tcl_SetCommandInfo, /* 226 */
    Tcl_SetErrno, /* 227 */

    Tcl_SetStdChannel, /* 236 */
    Tcl_SetVar, /* 237 */
    Tcl_SetVar2, /* 238 */
    Tcl_SignalId, /* 239 */
    Tcl_SignalMsg, /* 240 */
    Tcl_SourceRCFile, /* 241 */
    Tcl_SplitList, /* 242 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 243*/
#else  /* TCL_NO_FILESYSTEM */
    Tcl_SplitPath, /* 243 */
#endif /* TCL_NO_FILESYSTEM */
    Tcl_StaticPackage, /* 244 */
    Tcl_StringMatch, /* 245 */
    Tcl_Tell, /* 246 */
    Tcl_TraceVar, /* 247 */
    Tcl_TraceVar2, /* 248 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 249*/
#else  /* TCL_NO_FILESYSTEM */
    Tcl_TranslateFileName, /* 249 */
#endif /* TCL_NO_FILESYSTEM */
    Tcl_Ungets, /* 250 */
    Tcl_UnlinkVar, /* 251 */
    Tcl_UnregisterChannel, /* 252 */
    Tcl_UnsetVar, /* 253 */
    Tcl_UnsetVar2, /* 254 */
    Tcl_UntraceVar, /* 255 */
    Tcl_UntraceVar2, /* 256 */

    Tcl_ParseVar, /* 270 */
    Tcl_PkgPresent, /* 271 */
    Tcl_PkgPresentEx, /* 272 */
    Tcl_PkgProvide, /* 273 */
    Tcl_PkgRequire, /* 274 */
    Tcl_SetErrorCodeVA, /* 275 */
    Tcl_VarEvalVA, /* 276 */
#if defined(TCL_NO_PIPES)
    NULL, /* 277*/
#else  /* TCL_NO_PIPES */
    Tcl_WaitPid, /* 277 */
#endif /* TCL_NO_PIPES */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
    Tcl_PanicVA, /* 278 */
#endif /* UNIX */
#ifdef __WIN32__
    Tcl_PanicVA, /* 278 */
#endif /* __WIN32__ */
#ifdef MAC_TCL

    Tcl_GetVar2Ex, /* 306 */
    Tcl_InitNotifier, /* 307 */
    Tcl_MutexLock, /* 308 */
    Tcl_MutexUnlock, /* 309 */
    Tcl_ConditionNotify, /* 310 */
    Tcl_ConditionWait, /* 311 */
    Tcl_NumUtfChars, /* 312 */
#if defined(TCL_NO_CHANNEL_READ) && defined (TCL_NO_PIPES)
    NULL, /* 313*/
#else  /* TCL_NO_CHANNEL_READ TCL_NO_PIPES */
    Tcl_ReadChars, /* 313 */
#endif /* TCL_NO_CHANNEL_READ TCL_NO_PIPES */
    Tcl_RestoreResult, /* 314 */
    Tcl_SaveResult, /* 315 */
    Tcl_SetSystemEncoding, /* 316 */
    Tcl_SetVar2Ex, /* 317 */
    Tcl_ThreadAlert, /* 318 */
    Tcl_ThreadQueueEvent, /* 319 */
    Tcl_UniCharAtIndex, /* 320 */

    Tcl_UtfToLower, /* 334 */
    Tcl_UtfToTitle, /* 335 */
    Tcl_UtfToUniChar, /* 336 */
    Tcl_UtfToUpper, /* 337 */
    Tcl_WriteChars, /* 338 */
    Tcl_WriteObj, /* 339 */
    Tcl_GetString, /* 340 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 341*/
#else  /* TCL_NO_FILESYSTEM */
    Tcl_GetDefaultEncodingDir, /* 341 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 342*/
#else  /* TCL_NO_FILESYSTEM */
    Tcl_SetDefaultEncodingDir, /* 342 */
#endif /* TCL_NO_FILESYSTEM */
    Tcl_AlertNotifier, /* 343 */
    Tcl_ServiceModeHook, /* 344 */
    Tcl_UniCharIsAlnum, /* 345 */
    Tcl_UniCharIsAlpha, /* 346 */
    Tcl_UniCharIsDigit, /* 347 */
    Tcl_UniCharIsLower, /* 348 */
    Tcl_UniCharIsSpace, /* 349 */

    Tcl_FreeParse, /* 358 */
    Tcl_LogCommandInfo, /* 359 */
    Tcl_ParseBraces, /* 360 */
    Tcl_ParseCommand, /* 361 */
    Tcl_ParseExpr, /* 362 */
    Tcl_ParseQuotedString, /* 363 */
    Tcl_ParseVarName, /* 364 */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 365*/
#else  /* TCL_NO_FILESYSTEM */
    Tcl_GetCwd, /* 365 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 366*/
#else  /* TCL_NO_FILESYSTEM */
    Tcl_Chdir, /* 366 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 367*/
#else  /* TCL_NO_FILESYSTEM */
    Tcl_Access, /* 367 */
#endif /* TCL_NO_FILESYSTEM */
#if defined(TCL_NO_FILESYSTEM)
    NULL, /* 368*/
#else  /* TCL_NO_FILESYSTEM */
    Tcl_Stat, /* 368 */
#endif /* TCL_NO_FILESYSTEM */
    Tcl_UtfNcmp, /* 369 */
    Tcl_UtfNcasecmp, /* 370 */
    Tcl_StringCaseMatch, /* 371 */
    Tcl_UniCharIsControl, /* 372 */
    Tcl_UniCharIsGraph, /* 373 */
    Tcl_UniCharIsPrint, /* 374 */
    Tcl_UniCharIsPunct, /* 375 */

/* 
 * tclUtil.c --
 *
 *	This file contains utility procedures that are used by many Tcl
 *	commands.
 *
 * Copyright (c) 1987-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.
 *
 *  RCS: @(#) $Id: tclUtil.c,v 1.17.2.1.2.1 2001/11/28 17:58:37 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The following variable holds the full path name of the binary

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
char *
Tcl_GetCwd(interp, cwdPtr)
    Tcl_Interp *interp;
    Tcl_DString *cwdPtr;
{
    return TclpGetCwd(interp, cwdPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Chdir --
 *
 *	This function replaces the library version of chdir().
 *
 * Results:
 *	See chdir() documentation.
 *
 * Side effects:
 *	See chdir() documentation.  
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
Tcl_Chdir(dirName)
    CONST char *dirName;
{
    return TclpChdir(dirName);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Access --
 *
 *	This function replaces the library version of access().
 *
 * Results:
 *	See access() documentation.
 *
 * Side effects:
 *	See access() documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
Tcl_Access(path, mode)
    CONST char *path;		/* Path of file to access (UTF-8). */
    int mode;			/* Permission setting. */
{
    return TclAccess(path, mode);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Stat --
 *
 *	This function replaces the library version of stat().
 *
 * Results:
 *	See stat() documentation.
 *
 * Side effects:
 *	See stat() documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_FILESYSTEM
int
Tcl_Stat(path, bufPtr)
    CONST char *path;		/* Path of file to stat (in UTF-8). */
    struct stat *bufPtr;	/* Filled with results of stat call. */
{
    return TclStat(path, bufPtr);
}
#endif

<html><head><title>Static sizes</title></head><body>
<h1>Library sizes</h1>
<p><table border=1>
<tr><td>              </td> <td>lib/libtcl8.3.a</td> <td>lib/libtcl8.3.a %</td> <td></td> <td>lib/libtcl8.3.a d%</td> <td>ENV_FLAGS                               </td></tr>
<tr><td>baseline      </td> <td>490124         </td> <td>100.00           </td> <td></td> <td>0.00              </td> <td>                                        </td></tr>
<tr><td>cut_eof       </td> <td>489964         </td> <td>99.97            </td> <td></td> <td>0.03              </td> <td>-DTCL_NO_CHANNEL_EOF                    </td></tr>
<tr><td>cut_blocked   </td> <td>489940         </td> <td>99.96            </td> <td></td> <td>0.04              </td> <td>-DTCL_NO_CHANNEL_BLOCKED                </td></tr>
<tr><td>cut_pid       </td> <td>489824         </td> <td>99.94            </td> <td></td> <td>0.06              </td> <td>-DTCL_NO_PIDCMD                         </td></tr>
<tr><td>cut_read      </td> <td>489420         </td> <td>99.86            </td> <td></td> <td>0.14              </td> <td>-DTCL_NO_CHANNEL_READ                   </td></tr>
<tr><td>cut_tty       </td> <td>488268         </td> <td>99.62            </td> <td></td> <td>0.38              </td> <td>-DTCL_NO_TTY                            </td></tr>
<tr><td>cut_copy      </td> <td>488032         </td> <td>99.57            </td> <td></td> <td>0.43              </td> <td>-DTCL_NO_CHANNELCOPY                    </td></tr>
<tr><td>cut_load      </td> <td>487264         </td> <td>99.42            </td> <td></td> <td>0.58              </td> <td>-DTCL_NO_LOADCMD                        </td></tr>
<tr><td>cut_alias     </td> <td>486576         </td> <td>99.28            </td> <td></td> <td>0.72              </td> <td>-DTCL_NO_CMDALIASES                     </td></tr>
<tr><td>cut_slave     </td> <td>485080         </td> <td>98.97            </td> <td></td> <td>1.03              </td> <td>-DTCL_NO_SLAVEINTERP                    </td></tr>
<tr><td>cut_config    </td> <td>484932         </td> <td>98.94            </td> <td></td> <td>1.06              </td> <td>-DTCL_NO_CHANNEL_CONFIG                 </td></tr>
<tr><td>cut_sock      </td> <td>484428         </td> <td>98.84            </td> <td></td> <td>1.16              </td> <td>-DTCL_NO_SOCKETS                        </td></tr>
<tr><td>cut_fev       </td> <td>484376         </td> <td>98.83            </td> <td></td> <td>1.17              </td> <td>-DTCL_NO_FILEEVENTS                     </td></tr>
<tr><td>cut_interp    </td> <td>480624         </td> <td>98.06            </td> <td></td> <td>1.94              </td> <td>-DTCL_NO_SLAVEINTERP -DTCL_NO_CMDALIASES</td></tr>
<tr><td>cut_pipes     </td> <td>480136         </td> <td>97.96            </td> <td></td> <td>2.04              </td> <td>-DTCL_NO_PIPES                          </td></tr>
<tr><td>cut_nonstdchan</td> <td>463544         </td> <td>94.58            </td> <td></td> <td>5.42              </td> <td>-DTCL_NO_NONSTDCHAN                     </td></tr>
<tr><td>cut_fs        </td> <td>440940         </td> <td>89.96            </td> <td></td> <td>10.04             </td> <td>-DTCL_NO_FILESYSTEM                     </td></tr>
<tr><td>cut           </td> <td>403228         </td> <td>82.27            </td> <td></td> <td>17.73             </td> <td>-DMODULAR_TCL                           </td></tr>
</table></p>
<h1>Object file sizes</h1>
<p><table border=1>
<tr><td>              </td> <td>baseline</td> <td>cut  </td> <td>cut_alias</td> <td>cut_blocked</td> <td>cut_config</td> <td>cut_copy</td> <td>cut_eof</td> <td>cut_fev</td> <td>cut_fs</td> <td>cut_interp</td> <td>cut_load</td> <td>cut_nonstdchan</td> <td>cut_pid</td> <td>cut_pipes</td> <td>cut_read</td> <td>cut_slave</td> <td>cut_sock</td> <td>cut_tty</td></tr>
<tr><td>tclBasic.o    </td> <td>16656   </td> <td>16144</td> <td>16592    </td> <td>16624      </td> <td>16624     </td> <td>16624   </td> <td>16624  </td> <td>16624  </td> <td>16464 </td> <td>16592     </td> <td>16624   </td> <td>16496         </td> <td>16624  </td> <td>16624    </td> <td>16624   </td> <td>16656    </td> <td>16624   </td> <td>16656  </td></tr>
<tr><td>tclCmdAH.o    </td> <td>14228   </td> <td>9108 </td> <td>14228    </td> <td>14228      </td> <td>14228     </td> <td>14228   </td> <td>14228  </td> <td>14228  </td> <td>9108  </td> <td>14228     </td> <td>14228   </td> <td>14228         </td> <td>14228  </td> <td>14228    </td> <td>14228   </td> <td>14228    </td> <td>14228   </td> <td>14228  </td></tr>
<tr><td>tclCmdMZ.o    </td> <td>17160   </td> <td>17000</td> <td>17160    </td> <td>17160      </td> <td>17160     </td> <td>17160   </td> <td>17160  </td> <td>17160  </td> <td>17000 </td> <td>17160     </td> <td>17160   </td> <td>17096         </td> <td>17160  </td> <td>17160    </td> <td>17160   </td> <td>17160    </td> <td>17160   </td> <td>17160  </td></tr>
<tr><td>tclEncoding.o </td> <td>10008   </td> <td>3488 </td> <td>10008    </td> <td>10008      </td> <td>10008     </td> <td>10008   </td> <td>10008  </td> <td>10008  </td> <td>3488  </td> <td>10008     </td> <td>10008   </td> <td>4364          </td> <td>10008  </td> <td>10008    </td> <td>10008   </td> <td>10008    </td> <td>10008   </td> <td>10008  </td></tr>
<tr><td>tclEvent.o    </td> <td>4036    </td> <td>3844 </td> <td>4036     </td> <td>4036       </td> <td>4036      </td> <td>4036    </td> <td>4036   </td> <td>4036   </td> <td>3844  </td> <td>4036      </td> <td>4036    </td> <td>4036          </td> <td>4036   </td> <td>4036     </td> <td>4036    </td> <td>4036     </td> <td>4036    </td> <td>4036   </td></tr>
<tr><td>tclFCmd.o     </td> <td>5272    </td> <td>472  </td> <td>5272     </td> <td>5272       </td> <td>5272      </td> <td>5272    </td> <td>5272   </td> <td>5272   </td> <td>472   </td> <td>5272      </td> <td>5272    </td> <td>5272          </td> <td>5272   </td> <td>5272     </td> <td>5272    </td> <td>5272     </td> <td>5272    </td> <td>5272   </td></tr>
<tr><td>tclFileName.o </td> <td>12020   </td> <td>472  </td> <td>12020    </td> <td>12020      </td> <td>12020     </td> <td>12020   </td> <td>12020  </td> <td>12020  </td> <td>472   </td> <td>12020     </td> <td>12020   </td> <td>12020         </td> <td>12020  </td> <td>12020    </td> <td>12020   </td> <td>12020    </td> <td>12020   </td> <td>12020  </td></tr>
<tr><td>tclIO.o       </td> <td>25296   </td> <td>17724</td> <td>25296    </td> <td>25296      </td> <td>23824     </td> <td>23728   </td> <td>25296  </td> <td>22748  </td> <td>25296 </td> <td>25296     </td> <td>25296   </td> <td>24848         </td> <td>25296  </td> <td>25296    </td> <td>25296   </td> <td>25296    </td> <td>25296   </td> <td>25296  </td></tr>
<tr><td>tclIOCmd.o    </td> <td>7860    </td> <td>2020 </td> <td>7860     </td> <td>7668       </td> <td>7412      </td> <td>7368    </td> <td>7732   </td> <td>6996   </td> <td>6588  </td> <td>7860      </td> <td>7860    </td> <td>3932          </td> <td>7860   </td> <td>6940     </td> <td>7188    </td> <td>7860     </td> <td>5716    </td> <td>7860   </td></tr>
<tr><td>tclIOGT.o     </td> <td>3760    </td> <td>484  </td> <td>3760     </td> <td>3760       </td> <td>484       </td> <td>3760    </td> <td>3760   </td> <td>3536   </td> <td>3760  </td> <td>3760      </td> <td>3760    </td> <td>3760          </td> <td>3760   </td> <td>3760     </td> <td>3760    </td> <td>3760     </td> <td>3760    </td> <td>3760   </td></tr>
<tr><td>tclIOUtil.o   </td> <td>3300    </td> <td>1976 </td> <td>3300     </td> <td>3300       </td> <td>3300      </td> <td>3300    </td> <td>3300   </td> <td>3300   </td> <td>1976  </td> <td>3300      </td> <td>3300    </td> <td>2764          </td> <td>3300   </td> <td>3300     </td> <td>3300    </td> <td>3300     </td> <td>3300    </td> <td>3300   </td></tr>
<tr><td>tclInterp.o   </td> <td>10196   </td> <td>948  </td> <td>6676     </td> <td>10196      </td> <td>10196     </td> <td>10196   </td> <td>10196  </td> <td>10196  </td> <td>10196 </td> <td>948       </td> <td>10196   </td> <td>9876          </td> <td>10196  </td> <td>10196    </td> <td>10196   </td> <td>5340     </td> <td>10196   </td> <td>10196  </td></tr>
<tr><td>tclLoad.o     </td> <td>3556    </td> <td>1140 </td> <td>3556     </td> <td>3556       </td> <td>3556      </td> <td>3556    </td> <td>3556   </td> <td>3556   </td> <td>1292  </td> <td>3332      </td> <td>1292    </td> <td>3556          </td> <td>3556   </td> <td>3556     </td> <td>3556    </td> <td>3332     </td> <td>3556    </td> <td>3556   </td></tr>
<tr><td>tclLoadDl.o   </td> <td>1044    </td> <td>480  </td> <td>1044     </td> <td>1044       </td> <td>1044      </td> <td>1044    </td> <td>1044   </td> <td>1044   </td> <td>1044  </td> <td>1044      </td> <td>480     </td> <td>1044          </td> <td>1044   </td> <td>1044     </td> <td>1044    </td> <td>1044     </td> <td>1044    </td> <td>1044   </td></tr>
<tr><td>tclMain.o     </td> <td>3296    </td> <td>2656 </td> <td>3296     </td> <td>3296       </td> <td>3296      </td> <td>3296    </td> <td>3296   </td> <td>2816   </td> <td>3136  </td> <td>3296      </td> <td>3296    </td> <td>3136          </td> <td>3296   </td> <td>3296     </td> <td>3296    </td> <td>3296     </td> <td>3296    </td> <td>3296   </td></tr>
<tr><td>tclPipe.o     </td> <td>6040    </td> <td>472  </td> <td>6040     </td> <td>6040       </td> <td>6040      </td> <td>6040    </td> <td>6040   </td> <td>6040   </td> <td>1940  </td> <td>6040      </td> <td>6040    </td> <td>472           </td> <td>6040   </td> <td>472      </td> <td>6040    </td> <td>6040     </td> <td>6040    </td> <td>6040   </td></tr>
<tr><td>tclUnixChan.o </td> <td>9036    </td> <td>3084 </td> <td>9036     </td> <td>9036       </td> <td>9036      </td> <td>9036    </td> <td>9036   </td> <td>8524   </td> <td>8300  </td> <td>9036      </td> <td>9036    </td> <td>3148          </td> <td>9036   </td> <td>9036     </td> <td>9036    </td> <td>9036     </td> <td>5708    </td> <td>7180   </td></tr>
<tr><td>tclUnixFCmd.o </td> <td>6604    </td> <td>472  </td> <td>6604     </td> <td>6604       </td> <td>6604      </td> <td>6604    </td> <td>6604   </td> <td>6604   </td> <td>472   </td> <td>6604      </td> <td>6604    </td> <td>6604          </td> <td>6604   </td> <td>6604     </td> <td>6604    </td> <td>6604     </td> <td>6604    </td> <td>6604   </td></tr>
<tr><td>tclUnixFile.o </td> <td>3324    </td> <td>472  </td> <td>3324     </td> <td>3324       </td> <td>3324      </td> <td>3324    </td> <td>3324   </td> <td>3324   </td> <td>472   </td> <td>3324      </td> <td>3324    </td> <td>3324          </td> <td>3324   </td> <td>3324     </td> <td>3324    </td> <td>3324     </td> <td>3324    </td> <td>3324   </td></tr>
<tr><td>tclUnixInit.o </td> <td>6000    </td> <td>4312 </td> <td>6036     </td> <td>6040       </td> <td>6036      </td> <td>6000    </td> <td>6000   </td> <td>6000   </td> <td>4316  </td> <td>6036      </td> <td>6000    </td> <td>5832          </td> <td>6000   </td> <td>6036     </td> <td>6000    </td> <td>6036     </td> <td>6000    </td> <td>6000   </td></tr>
<tr><td>tclUnixNotfy.o</td> <td>1784    </td> <td>856  </td> <td>1784     </td> <td>1784       </td> <td>1784      </td> <td>1784    </td> <td>1784   </td> <td>856    </td> <td>1784  </td> <td>1784      </td> <td>1784    </td> <td>1784          </td> <td>1784   </td> <td>1784     </td> <td>1784    </td> <td>1784     </td> <td>1784    </td> <td>1784   </td></tr>
<tr><td>tclUnixPipe.o </td> <td>4196    </td> <td>472  </td> <td>4196     </td> <td>4196       </td> <td>4196      </td> <td>4196    </td> <td>4196   </td> <td>4036   </td> <td>4196  </td> <td>4196      </td> <td>4196    </td> <td>692           </td> <td>3928   </td> <td>692      </td> <td>4196    </td> <td>4196     </td> <td>4196    </td> <td>4196   </td></tr>
<tr><td>tclUnixSock.o </td> <td>760     </td> <td>568  </td> <td>760      </td> <td>760        </td> <td>760       </td> <td>760     </td> <td>760    </td> <td>760    </td> <td>760   </td> <td>760       </td> <td>760     </td> <td>568           </td> <td>760    </td> <td>760      </td> <td>760     </td> <td>760      </td> <td>568     </td> <td>760    </td></tr>
<tr><td>tclUtil.o     </td> <td>8600    </td> <td>8472 </td> <td>8600     </td> <td>8600       </td> <td>8600      </td> <td>8600    </td> <td>8600   </td> <td>8600   </td> <td>8472  </td> <td>8600      </td> <td>8600    </td> <td>8600          </td> <td>8600   </td> <td>8600     </td> <td>8600    </td> <td>8600     </td> <td>8600    </td> <td>8600   </td></tr>
<tr><td>Sigma         </td> <td>184032  </td> <td>97136</td> <td>180484   </td> <td>183848     </td> <td>178840    </td> <td>181940  </td> <td>183872 </td> <td>178284 </td> <td>134848</td> <td>174532    </td> <td>181172  </td> <td>157452        </td> <td>183732 </td> <td>174044   </td> <td>183328  </td> <td>178988   </td> <td>178336  </td> <td>182176 </td></tr>
<tr><td>%             </td> <td>100.00  </td> <td>52.78</td> <td>98.07    </td> <td>99.90      </td> <td>97.18     </td> <td>98.86   </td> <td>99.91  </td> <td>96.88  </td> <td>73.27 </td> <td>94.84     </td> <td>98.45   </td> <td>85.56         </td> <td>99.84  </td> <td>94.57    </td> <td>99.62   </td> <td>97.26    </td> <td>96.90   </td> <td>98.99  </td></tr>
</table></p>
</body></html>

# genStubs.tcl --
#
#	This script generates a set of stub files for a given
#	interface.  
#	
#
# 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: genStubs.tcl,v 1.7.10.1.2.1 2001/11/28 17:58:37 andreas_kupries Exp $

package require Tcl 8

namespace eval genStubs {
    # libraryName --
    #
    #	The name of the entire library.  This value is used to compute

# Results:
#	None.

proc genStubs::declare {args} {
    variable stubs
    variable curName

    if {[llength $args] != 3 && [llength $args] != 4} {
	puts stderr "wrong # args: declare $args"
    }
    if {[llength $args] == 3} {
	lassign $args index platformList decl
	set supressorList {}
    } else {
	lassign $args index platformList supressorList decl
    }

    # Check for duplicate declarations, then add the declaration and
    # bump the lastNum counter if necessary.

    foreach platform $platformList {
	if {[info exists stubs($curName,$platform,$index)]} {
	    puts stderr "Duplicate entry: declare $args"
	}
    }
    regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
    set decl [parseDecl $decl]

    foreach platform $platformList {
	if {$decl != ""} {
	    set stubs($curName,$platform,$index) [list $decl $supressorList]
	    if {![info exists stubs($curName,$platform,lastNum)] \
		    || ($index > $stubs($curName,$platform,lastNum))} {
		set stubs($curName,$platform,lastNum) $index
	    }
	}
    }
    return